diff options
Diffstat (limited to 'sucl/history.icl')
-rw-r--r-- | sucl/history.icl | 97 |
1 files changed, 97 insertions, 0 deletions
diff --git a/sucl/history.icl b/sucl/history.icl new file mode 100644 index 0000000..c79accd --- /dev/null +++ b/sucl/history.icl @@ -0,0 +1,97 @@ +implementation module history + +import spine +import rule +import graph +import basic +import StdEnv + +:: History sym var + :== [(var,[Rgraph sym var])] + +/* + +> history * ** == [(**,[rgraph * **])] + +> showhistory :: (*->[char]) -> (**->[char]) -> history * ** -> [char] +> showhistory showa showb = showlist (showpair showb (showlist (showrgraph showa showb))) + +> printhistory :: (*->[char]) -> (**->[char]) -> history * ** -> [[char]] +> printhistory showa showb +> = concat.map print +> where print (node,rgraphs) +> = showb node:map2 (++) ("<= ":repeat " ") (map (printrgraph showa showb) rgraphs) + +*/ + +extendhistory + :: (Graph sym var) + (var -> var) + (Spine sym var pvar) + (History sym var) + -> History sym var + +extendhistory sgraph redirection spine history += snd (foldspine (extendpair sgraph redirection) d d id d (const d) (extendpartial sgraph) (const d) (extendredex sgraph history) d spine) + where d = (emptygraph,history) + +/* + +> extendpair :: graph * ** -> (**->**) -> ** -> (graph * **,history * **) -> (graph * **,history * **) +> extendpair sgraph redirect snode (hgraph,history) +> = (hgraph',remap (redirect snode) (mkrgraph snode hgraph':foldmap id [] history snode) (forget snode history)) +> where hgraph' = cond sdef (updategraph snode scont hgraph) hgraph +> (sdef,scont) = dnc (const "in extendpair") sgraph snode + +*/ + +extendpair + :: (Graph sym var) + (var->var) + var + (Graph sym var,History sym var) + -> (Graph sym var,History sym var) + +extendpair _ _ _ _ = undef + +/* + +> extendpartial :: graph * ** -> rule * *** -> pfun *** ** -> (graph * **,history * **) -> (graph * **,history * **) +> extendpartial sgraph rule matching (hgraph,history) +> = (extgraph' sgraph rule matching hgraph,history) + +*/ + +extendpartial + :: (Graph sym var) + (Rule sym pvar) + (Pfun pvar var) + (Graph sym var,History sym var) + -> (Graph sym var,History sym var) + +extendpartial _ _ _ _ = undef + +/* + +> extendredex :: graph * ** -> history * ** -> rule * *** -> pfun *** ** -> (graph * **,history * **) +> extendredex sgraph history rule matching +> = (extgraph' sgraph rule matching emptygraph,history) + +*/ + +extendredex + :: (Graph sym var) + (History sym var) + (Rule sym pvar) + (Pfun pvar var) + -> (Graph sym var,History sym var) + +extendredex _ _ _ _ = undef + +/* + +> extgraph' sgraph rule +> = extgraph sgraph rgraph (nodelist rgraph (lhs rule)) +> where rgraph = rulegraph rule + +*/ |