Hello!
Hal Daume III wrote: [description of a parsing problem that involves forward references] Forward references is the problem. To properly solve it, you have to find a fixpoint. The best way to avoid hitting the bottom is to make sure that the fixpoint combinator is applied to a function. Hence the solution: type TreeDictLate = [(String,DecisionTreeLate)] -- lookup for subtrees newtype DecisionTreeLate = DTL (TreeDictLate -> DecisionTree) ft (DTL late_tree) st = late_tree st readDecisionTree :: String -> DecisionTree readDecisionTree s = let (_, wholeTreeLate, subTrees) = readDecisionTree' False [] (filter (/=[]) (lines s)) in ft wholeTreeLate subTrees The function readDecisionTree' will return a delayed decision tree: a function that _will_ yield the decision tree when it is applied to the forest dictionary. The forest dictionary is itself an assoc list of tree labels and _late_ decision trees. Now the test "readDecisionTree $ unlines simpleDT3" passes as well, and gives the reasonable result: simpleDT3 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f :[S1]", "| isArgument1 = t:", "| | isRecursive1 = t: s (945.0/39.8)", "| | isRecursive1 = f: u (2.0/1.0)", "", "Subtree [S1]", "", "localDefCount <= 15 : u (281.0/1.4)", "localDefCount > 15 : s (139.0/11.8)"] DecisionTree> readDecisionTree $ unlines simpleDT3 Test "isArgument0" "=" "t" (Value "u" 33.0 1.4) (Test "isArgument0" "=" "f" (Test "isArgument1" "=" "f" (Test "localDefCount" "<=" "15" (Value "u" 281.0 1.4) (Value "s" 139.0 11.8)) (Test "isArgument1" "=" "t" (Test "isRecursive1" "=" "t" (Value "s" 945.0 39.8) (Value "u" 2.0 1.0)) (Value "" 0.0 0.0))) (Value "" 0.0 0.0)) which seems reasonable. And even the following passes: simpleDT4 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f :[S1]", "| isArgument1 = t :[S2]", "", "Subtree [S1]", "", "localDefCount <= 15 : [S2]", "localDefCount > 15 : s (139.0/11.8)", "", "Subtree [S2]", "", "ll <= 15 : u (2.0/1.4)", "ll > 15 : s (1.0/11.8)"] readDecisionTree $ unlines simpleDT4 [skipped] The code enclosed. BTW, it seemed the original code had a few bugs. module DecisionTree where import IO import List data DecisionTree = Test String String String DecisionTree DecisionTree | Value String Double Double deriving (Show, Eq, Ord, Read) type TreeDictLate = [(String,DecisionTreeLate)] -- lookup for subtrees newtype DecisionTreeLate = DTL (TreeDictLate -> DecisionTree) ft (DTL late_tree) st = late_tree st readDecisionTree :: String -> DecisionTree readDecisionTree s = let (_, wholeTreeLate, subTrees) = readDecisionTree' False [] (filter (/=[]) (lines s)) in ft wholeTreeLate subTrees readDecisionTree' :: Bool -> TreeDictLate -> [String] -> ([String], DecisionTreeLate, TreeDictLate) readDecisionTree' _ subTrees [] = ([], DTL $ \st -> Value "" 0 0, subTrees) readDecisionTree' areValue subTrees (x:xs) = let (lineDepth, lineType, values') = readLine x (subTreesX,xs1) = if xs /= [] && "Subtree" `isPrefixOf` head xs then readSubTrees subTrees xs else (subTrees,xs) (xs', lhs, subTrees') = readDecisionTree' False subTreesX xs1 (xs'' , rhs, subTrees'') = readDecisionTree' False subTrees' xs' (xs''', other, subTrees''') = readDecisionTree' True subTreesX xs1 values = values' ++ ["0.0"] in if lineType -- are we a value then if areValue then (xs1, DTL $ \st->Value (values !! 3) (read (values !! 4)) (read (values !! 5)), subTreesX) else (xs''', DTL $ \st->Test (values !! 0) (values !! 1) (values !! 2) (Value (values !! 3) (read (values !! 4)) (read (values !! 5))) (ft other st), subTrees''') else if '[' == head (last values') -- are we a subtree? then (xs'', DTL $ \st-> let (Just dt) = lookup (last values') st in Test (values !! 0) (values !! 1) (values !!2) (ft dt st) (ft lhs st), subTrees') else (xs'', DTL $ \st->Test (values !! 0) (values !! 1) (values !! 2) (ft lhs st) (ft rhs st), subTrees'') readSubTrees subTrees [] = (subTrees,[]) readSubTrees subTrees (x:xs) | "Subtree" `isPrefixOf` x = let name = (words x) !! 1 treeDef = takeWhile (\x -> not ("Subtree" `isPrefixOf` x)) xs rest = dropWhile (\x -> not ("Subtree" `isPrefixOf` x)) xs (_, thisDT, _) = readDecisionTree' False subTrees treeDef in readSubTrees ((name,thisDT):subTrees) rest | otherwise = (subTrees,(x:xs)) readLine :: String -> (Int,Bool,[String]) -- True = Value, False = Test readLine s = (length (elemIndices '|' s), ')' `elem` s, vals) where vals = words $ map (\x -> if x `elem` ":()/" then ' ' else x) $ dropWhile (`elem` "| ") s simpleDT = ["localDefCountSum <= 4 : p (101.0/6.0)", "localDefCountSum > 4 : u (7.0)"] simpleDT2 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f: u (9.0/1.3)", "| isArgument1 = t:", "| | isRecursive1 = t: s (945.0/39.8)", "| | isRecursive1 = f: u (2.0/1.0)"] {- Test "isArgument0" "=" "t" (Value "u" 33.0 1.4) (Test "isArgument0" "=" "f" (Test "isArgument1" "=" "f" (Value "u" 9.0 1.3) (Test "isArgument1" "=" "t" (Test "isRecursive1" "=" "t" (Value "s" 945.0 39.8) (Value "u" 2.0 1.0)) (Value "" 0.0 0.0))) (Value "" 0.0 0.0)) -} simpleDT3 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f :[S1]", "| isArgument1 = t:", "| | isRecursive1 = t: s (945.0/39.8)", "| | isRecursive1 = f: u (2.0/1.0)", "", "Subtree [S1]", "", "localDefCount <= 15 : u (281.0/1.4)", "localDefCount > 15 : s (139.0/11.8)"] simpleDT4 = [ "isArgument0 = t: u (33.0/1.4)", "isArgument0 = f:", "| isArgument1 = f :[S1]", "| isArgument1 = t :[S2]", "", "Subtree [S1]", "", "localDefCount <= 15 : [S2]", "localDefCount > 15 : s (139.0/11.8)", "", "Subtree [S2]", "", "ll <= 15 : u (2.0/1.4)", "ll > 15 : s (1.0/11.8)"] --readDecisionTree $ unlines simpleDT _______________________________________________ Haskell mailing list [EMAIL PROTECTED] http://www.haskell.org/mailman/listinfo/haskell