diff options
| -rw-r--r-- | sucl/canon.icl | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/sucl/canon.icl b/sucl/canon.icl index b2d0f98..515404f 100644 --- a/sucl/canon.icl +++ b/sucl/canon.icl @@ -61,7 +61,7 @@ steps: canonise :: (sym -> Int) [var2] (Rgraph sym var1) -> Rgraph sym var2 | == var1 canonise arity heap rg - = ((relabel heap o etaexpand arity o splitrg o relabel localheap) rg <--- "canon.canonise ends") ---> "canon.canonise begins" + = (relabel heap o etaexpand arity o splitrg o relabel localheap) rg /* @@ -75,14 +75,14 @@ canonise arity heap rg splitrg :: (Rgraph sym Int) -> Rgraph sym Int splitrg rgraph = foldsingleton single rgraph rgraph - where single root sym args = mkrgraph root (updategraph root (sym,fst ((claim--->"basic.claim begins from canon.splitrg") args (localheap--[root]))) emptygraph) + where single root sym args = mkrgraph root (updategraph root (sym,fst (claim args (localheap--[root]))) emptygraph) /* > uncurry :: (*->rule **** *****) -> rgraph * num -> rgraph * num > uncurry typerule rgraph > = f (nc root) > where f (True,(sym,args)) -> = mkrgraph root (updategraph root (sym,fst ((claim--->"basic.claim begins from canon.uncurry") targs (args++localheap--nodelist graph [root]))) graph) +> = mkrgraph root (updategraph root (sym,fst (claim targs (args++localheap--nodelist graph [root]))) graph) > where targs = lhs (typerule sym) > f cont = rgraph > nc = nodecontents graph @@ -113,10 +113,10 @@ localheap =: [0..] foldarea :: ((Rgraph sym var) -> sym) (Rgraph sym var) -> Node sym var | == var foldarea label rgraph - = (((labelrgraph<---"canon.foldarea.labelrgraph begins")--->"canon.foldarea.labelrgraph ends",(foldsingleton single nosingle rgraph<---"canon.foldarea.foldsingleton ends")--->"canon.foldarea.foldsingleton begins") <--- "canon.foldarea ends") ---> "canon.foldarea begins" - where single root sym args = map (\arg->(arg<---"canon.foldarea.single.arg ends")--->"canon.foldarea.single.arg begins") args - nosingle = map (\arg->(arg<---"newfold.foldarea.nosingle.arg ends")--->"newfold.foldarea.nosingle.arg begins") (snd (graphvars (rgraphgraph rgraph) [rgraphroot rgraph])) - labelrgraph = (label rgraph <--- "canon.foldarea.labelrgraph ends") ---> "canon.foldarea.labelrgraph begins" + = (labelrgraph,foldsingleton single nosingle rgraph) + where single root sym = id + nosingle = snd (graphvars (rgraphgraph rgraph) [rgraphroot rgraph]) + labelrgraph = label rgraph /* ------------------------------------------------------------------------ @@ -140,13 +140,13 @@ foldarea label rgraph labelarea :: (sym->Bool) [Rgraph sym var] [sym] (Rgraph sym var) -> sym | == sym & == var labelarea reusable areas labels rg - = ((foldmap--->"canon.labelarea uses foldmap") id nolabel ((maketable--->"canon.maketable begins from canon.labelarea") reusable ((areas<---"canon.labelarea.areas ends")--->"canon.labelarea.areas begins") ((labels<---"canon.labelarea.labels ends")--->"canon.labelarea.labels begins")) ((rg<---"canon.labelarea.rg ends")--->"canon.labelarea.rg begins") <--- "canon.labelarea ends") ---> "canon.labelarea begins" + = foldmap id nolabel (maketable reusable areas labels) rg where nolabel = abort "canon: labelarea: no label assigned to area" maketable :: (sym->Bool) [Rgraph sym var] [sym] -> [(Rgraph sym var,sym)] | == var -maketable _ [] _ = [] <--- "canon.maketable ends empty" +maketable _ [] _ = [] maketable reusable [area:areas] labels - = [(((area<---"canon.maketable.area ends")--->"canon.maketable.area begins",(label<---"canon.maketable.label ends")--->"canon.maketable.label begins") <--- "canon.maketable.head ends") ---> "canon.maketable.head begins":(maketable--->"canon.maketable begins from maketable") reusable areas labels`] <--- "canon.maketable ends nonempty" + = [(area,label):maketable reusable areas labels`] where (label,labels`) = getlabel (nc aroot) labels getlabel (True,(asym,aargs)) labels | reusable asym && not (or (map (fst o nc) aargs)) |