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
+
+*/