aboutsummaryrefslogtreecommitdiff
path: root/sucl/history.icl
diff options
context:
space:
mode:
Diffstat (limited to 'sucl/history.icl')
-rw-r--r--sucl/history.icl97
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
+
+*/