# trying to tie the knot

```
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

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)"]

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)"]
[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

type TreeDictLate = [(String,DecisionTreeLate)] -- lookup for subtrees
newtype DecisionTreeLate = DTL (TreeDictLate -> DecisionTree)

ft (DTL late_tree) st = late_tree st

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)

let (lineDepth, lineType, values') = readLine x
(subTreesX,xs1) = if xs /= [] && "Subtree" `isPrefixOf` head 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'')

| "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
| 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)"]