diff options
Diffstat (limited to 'sucl/rule.icl')
| -rw-r--r-- | sucl/rule.icl | 265 |
1 files changed, 0 insertions, 265 deletions
diff --git a/sucl/rule.icl b/sucl/rule.icl deleted file mode 100644 index 21b7c06..0000000 --- a/sucl/rule.icl +++ /dev/null @@ -1,265 +0,0 @@ -implementation module rule - -// $Id$ - -import graph -import basic -import StdEnv - -:: Rule sym var - = RuleAlias [var] var (Graph sym var) - -:: Rgraph sym var - = RgraphAlias var (Graph sym var) - -/* - -rule.lit - Rooted graphs and rules -================================== - -Description ------------ - -This module implements abstract types for rooted graphs and rules, -together with some useful functions on them. Though very simple -definitions, it greatly helps the readability of error messages if -rooted graphs or rules occur in them. - -A rooted graph is a tuple consisting of a root and an unrooted graph -(how obvious). - -The implementation of a rule is less obvious. Instead of simply using a -graph with two roots, the root of the pattern and its associated -function symbol have been taken out. Hence the pattern is only -accessibly by its arguments. The root of the replacement is still -accessible. The reason for this is twofold: the root must be defined -anyway, and if the rule is a type rule, we are now able to use two -different domains for (normal) symbols and type symbols. - ------------------------------------------------------------- - -Interface ---------- - -Exported identifiers: - -> %export -> compilerule || Compile a rule from all loose parts -> emptyrgraph || Creates an empty rooted graph -> lhs || Determines the left root of a rule -> mkrgraph || Composes a rooted graph from a root and a graph -> mkrule || Composes a rule from left and right roots and a graph -> printrgraph || Makes a readable representation of a rooted graph -> printrule || Makes a readable representation of a rule -> prunergraph || Undefines the contents of a node of a rooted graph -> rgraph || Type of rooted graph over functorspace * and nodespace ** -> rgraphgraph || Determines the (unrooted) graph of a rooted graph -> rgraphroot || Determines the root of a rooted graph -> rhs || Determines the right root of a rule -> rule || Type of rules over functorspace * and nodespace ** -> rulegraph || Determines the graph of a rule -> showrgraph || Make a representation of a rooted graph -> showrule || Make a representation of a rule -> updatergraph || Updates the contents of a node of a rooted graph - -Required types: - - mkrgraph - graph@graph.lit - mkrule - graph@graph.lit - rgraphgraph - graph@graph.lit - rulegraph - graph@graph.lit - ------------------------------------------------------------- - -Includes --------- - -> %include "basic.lit" -> %include "graph.lit" -extgraph - ------------------------------------------------------------- - -Implementation --------------- - -> abstype rgraph * ** -> with emptyrgraph :: ** -> rgraph * ** -> updatergraph :: ** -> (*,[**]) -> rgraph * ** -> rgraph * ** -> prunergraph :: ** -> rgraph * ** -> rgraph * ** -> rgraphroot :: rgraph * ** -> ** -> rgraphgraph :: rgraph * ** -> graph * ** -> mkrgraph :: ** -> graph * ** -> rgraph * ** -> showrgraph :: (*->[char]) -> (**->[char]) -> rgraph * ** -> [char] -> printrgraph :: (*->[char]) -> (**->[char]) -> rgraph * ** -> [char] - -> abstype rule * ** -> with mkrule :: [**] -> ** -> graph * ** -> rule * ** -> lhs :: rule * ** -> [**] -> rhs :: rule * ** -> ** -> rulegraph :: rule * ** -> graph * ** -> showrule :: (*->[char]) -> (**->[char]) -> rule * ** -> [char] -> printrule :: (*->[char]) -> (**->[char]) -> rule * ** -> [char] - - -Rooted graphs - -> emptyrgraph root = (root,emptygraph) -> updatergraph node contents (root,graph) = (root,updategraph node contents graph) -> prunergraph node (root,graph) = (root,prunegraph node graph) -> rgraphroot (root,graph) = root -> rgraphgraph (root,graph) = graph -> mkrgraph root graph = (root,graph) -*/ - -emptyrgraph :: var -> .Rgraph sym var -emptyrgraph root = RgraphAlias root emptygraph - -updatergraph :: var .(Node sym var) !.(Rgraph sym var) -> .Rgraph sym var -updatergraph var node rgraph = maprgraph (mapsnd (updategraph var node)) rgraph - -prunergraph :: var !.(Rgraph sym var) -> .Rgraph sym var -prunergraph var rgraph = maprgraph (mapsnd (prunegraph var)) rgraph - -rgraphroot :: !.(Rgraph sym var) -> var -rgraphroot (RgraphAlias root _) = root - -rgraphgraph :: !.(Rgraph sym var) -> Graph sym var -rgraphgraph (RgraphAlias _ graph) = graph - -mkrgraph :: var (Graph sym var) -> .Rgraph sym var -mkrgraph root graph = RgraphAlias root graph - -maprgraph :: (.(var1,Graph sym1 var1) -> .(var2,Graph sym2 var2)) !.(Rgraph sym1 var1) -> .Rgraph sym2 var2 -maprgraph f (RgraphAlias root1 graph1) = RgraphAlias root2 graph2 - where (root2,graph2) = f (root1,graph1) - -instance toString (Rgraph sym var) | toString sym & toString var & Eq var -where toString rgraph = showrgraph toString toString rgraph - -showrgraph :: - (sym->String) - (var->String) - (Rgraph sym var) - -> String - | == var - -showrgraph showsym showvar (RgraphAlias root graph) -= "("+++snd (showsubgraph root ([],"emptyrgraph) "))+++showvar root - where showsubgraph node (seen,repr) - | not def || isMember node seen - = (seen,repr) - = (seen``,repr``) - where (def,(f,args)) = varcontents graph node - (seen``,repr`) = foldlr showsubgraph (seen`,repr) args - seen` = [node:seen] - repr`` = "updatergraph "+++showvar node+++" ("+++showsym f+++","+++showlist showvar args+++") o "+++repr` - -/* -> printrgraph showfunc shownode (root,graph) -> = hd (printgraph showfunc shownode graph [root]) -*/ - -instance <<< (Rgraph sym var) | toString sym & toString var & == var -where (<<<) file (RgraphAlias root graph) - = file <<< hd (printgraph graph [root]) - -/* -Rules - -> mkrule lroots rroot graph = (lroots,rroot,graph) -> lhs (lroots,rroot,graph) = lroots -> rhs (lroots,rroot,graph) = rroot -> rulegraph (lroots,rroot,graph) = graph -*/ - -mkrule :: .[var] var (Graph sym var) -> .Rule sym var -mkrule args root graph = RuleAlias args root graph - -arguments :: !.(Rule sym var) -> [var] -arguments (RuleAlias args _ _) = args - -ruleroot :: !.(Rule sym var) -> var -ruleroot (RuleAlias _ root _) = root - -rulegraph :: !.(Rule sym var) -> Graph sym var -rulegraph (RuleAlias _ _ graph) = graph - -/* -> printrule showfunc shownode (lroots,rroot,graph) -> = (concat.map (++" ").init) reprs++"-> "++last reprs -> where reprs = printgraph showfunc shownode graph (lroots++[rroot]) - -> compilerule :: [**] -> ** -> [(**,(*,[**]))] -> rule * ** -> compilerule args root = mkrule args root.compilegraph - -*/ - -instance == (Rgraph sym var) | == sym & == var -where (==) (RgraphAlias root1 graph1) (RgraphAlias root2 graph2) - = root1==root2 && graph1==graph2 - -instance toString (Rule sym var) | toString sym & toString var & == var -where toString rule = showrule toString toString rule - -showrule :: - (sym->String) - (var->String) - (Rule sym var) - -> String - | == var - -showrule showsym showvar (RuleAlias lroots rroot graph) -= "((mkrule "+++showlist showvar lroots+++" "+++showvar rroot+++repr`+++") emptygraph)" - where (seen,repr`) = foldlr showsubgraph ([],repr) lroots - (seen`,repr) = showsubgraph rroot (seen,"") - showsubgraph node (seen,repr) - | not def || isMember node seen - = (seen,repr) - = (seen``,repr``) - where (def,(f,args)) = varcontents graph node - (seen``,repr`) = foldlr showsubgraph (seen`,repr) args - seen` = [node:seen] - repr`` = " o updategraph "+++showvar node+++" ("+++showsym f+++","+++showlist showvar args+++")"+++repr` - -ruleToString :: (sym->.String) .(Rule sym var) -> String | Eq,toString var -ruleToString symToString (RuleAlias lroots rroot graph) -/* -= if def ("<rule with root "+++symToString sym+++">") "<rule with no root>" - where (def,(sym,args)) = varcontents graph rroot -*/ -= "((mkrule "+++showlist toString lroots+++" "+++toString rroot+++repr`+++") emptygraph)" - where (seen,repr`) = foldlr showsubgraph ([],repr) lroots - (seen`,repr) = showsubgraph rroot (seen,"") - showsubgraph node (seen,repr) - | not def || isMember node seen - = (seen,repr) - = (seen``,repr``) - where (def,(f,args)) = varcontents graph node - (seen``,repr`) = foldlr showsubgraph (seen`,repr) args - seen` = [node:seen] - repr`` = " o updategraph "+++toString node+++" ("+++symToString f+++","+++showlist toString args+++")"+++repr` - -instance <<< (Rule sym var) | toString sym & toString,== var -where (<<<) file rule = file <<< toString rule - -(writergraph) infixl :: *File .(Rgraph sym var) -> .File | toString sym & ==,toString var -(writergraph) file rgraph = file <<< rgraph - -(writerule) infixl :: *File .(Rule sym var) -> .File | toString sym & ==,toString var -(writerule) file rule = file <<< rule - -showruleanch :: - (sym->String) - (var->String) - [Bool] - (Rule sym var) - [var] - -> String - | == var - -showruleanch showsym showvar stricts rule anchors -= foldr (+++) "" (map2 annot stricts argreprs)+++"-> "+++rootrepr - where graph = rulegraph rule; args = arguments rule; root = ruleroot rule - (argreprs,[rootrepr:anchorreprs]) = claim args reprs - reprs = printgraphBy showsym showvar graph (args++[root:anchors]) - annot strict repr = (if strict ((+++) "!") id) (repr+++" ") |