1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
implementation module rule
// $Id$
import graph
import basic
:: Rule sym var
:== ([var],var,Graph sym var)
:: Rgraph sym var
:== (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 = (root,emptygraph)
updatergraph :: .var (Node .sym .var) !(Rgraph .sym .var) -> Rgraph .sym .var
updatergraph var node rgraph = mapsnd (updategraph var node) rgraph
prunergraph :: .var !(Rgraph .sym .var) -> Rgraph .sym .var
prunergraph var rgraph = mapsnd (prunegraph var) rgraph
rgraphroot :: !(Rgraph .sym .var) -> .var
rgraphroot (root,_) = root
rgraphgraph :: !(Rgraph .sym .var) -> Graph .sym .var
rgraphgraph (_,graph) = graph
mkrgraph :: .var (Graph .sym .var) -> Rgraph .sym .var
mkrgraph root graph = (root,graph)
/*
> showrgraph showfunc shownode (root,graph)
> = '(':snd (showsubgraph root ([],"emptyrgraph) "))++shownode root
> where showsubgraph node (seen,repr)
> = (seen,repr), if ~def \/ member seen node
> = (seen'',repr''), otherwise
> where (def,(f,args)) = nodecontents graph node
> (seen'',repr') = foldlr showsubgraph (seen',repr) args
> seen' = node:seen
> repr''
> = "updatergraph "++shownode node++" ("++
> showfunc f++',':showlist shownode args++")."++
> repr'
> printrgraph showfunc shownode (root,graph)
> = hd (printgraph showfunc shownode 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 = (args,root,graph)
arguments :: !(Rule .sym .var) -> [.var]
arguments (args,_,_) = args
ruleroot :: !(Rule .sym .var) -> .var
ruleroot (_,root,_) = root
rulegraph :: !(Rule .sym .var) -> Graph .sym .var
rulegraph (_,_,graph) = graph
/*
> showrule showfunc shownode (lroots,rroot,graph)
> = "((mkrule "++showlist shownode lroots++' ':shownode rroot++repr'++") emptygraph)"
> where (seen,repr') = showsubgraph rroot ([],repr)
> (seen',repr) = foldlr showsubgraph (seen,"") lroots
> showsubgraph node (seen,repr)
> = (seen,repr), if ~def \/ member seen node
> = (seen'',repr''), otherwise
> where (def,(f,args)) = nodecontents graph node
> (seen'',repr') = foldlr showsubgraph (seen',repr) args
> seen' = node:seen
> repr''
> = ".updategraph "++shownode node++" ("++
> showfunc f++',':showlist shownode args++')':repr'
> 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
*/
|
