1(*
2    Copyright (c) 2013-2016 David C.J. Matthews
3
4    This library is free software; you can redistribute it and/or
5    modify it under the terms of the GNU Lesser General Public
6    License version 2.1 as published by the Free Software Foundation.
7    
8    This library is distributed in the hope that it will be useful,
9    but WITHOUT ANY WARRANTY; without even the implied warranty of
10    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11    Lesser General Public License for more details.
12    
13    You should have received a copy of the GNU Lesser General Public
14    License along with this library; if not, write to the Free Software
15    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
16*)
17
18(*
19    Derived from the original parse-tree
20
21    Copyright (c) 2000
22        Cambridge University Technical Services Limited
23
24    Further development:
25    Copyright (c) 2000-13 David C.J. Matthews
26
27    Title:      Parse Tree Structure and Operations.
28    Author:     Dave Matthews, Cambridge University Computer Laboratory
29    Copyright   Cambridge University 1985
30
31*)
32
33functor BASE_PARSE_TREE (
34    structure STRUCTVALS : STRUCTVALSIG
35    structure TYPETREE : TYPETREESIG
36    structure DEBUGGER : DEBUGGER
37    
38    sharing STRUCTVALS.Sharing = TYPETREE.Sharing = DEBUGGER.Sharing
39): BaseParseTreeSig =
40
41struct
42    open STRUCTVALS
43    open TYPETREE
44    
45    type breakPoint = DEBUGGER.breakPoint
46
47    datatype parsetree = 
48        Ident               of
49      (* An identifier is just a name. In the second pass it is associated
50         with a particular declaration and the type is assigned into the
51         type field. The type of this identifier is needed to deal with
52         overloaded operators. If we have an occurence of ``='', say, the
53         type of the value will be 'a * 'a -> bool but the type of a particular
54         occurence, i.e. the type of the identifier must be int * int -> bool,
55         say, after all the unification has been done. *)
56        {
57            name: string,
58            expType: types ref,
59            value: values ref,
60            location: location,
61            possible: (unit -> string list) ref (* Used with the IDE. *)
62        }
63
64    |   Literal             of
65           (* Literal constants may be overloaded on more than one type. The
66              types are specified by installing appropriate conversion functions:
67              convInt, convReal, convChar, convString and convWord. *)
68            { converter: values, expType: types ref, literal: string, location: location }
69
70    |   Applic              of
71            (* Function application *)
72            { f: parsetree, arg: parsetree, location: location, isInfix: bool, expType: types ref }
73
74    |   Cond                of
75            (* Conditional *)
76        {
77            test: parsetree,
78            thenpt: parsetree,
79            elsept: parsetree,
80            location: location,
81            thenBreak: breakPoint option ref,
82            elseBreak: breakPoint option ref
83        } 
84
85    |   TupleTree           of { fields: parsetree list, location: location, expType: types ref }
86
87    |   ValDeclaration      of
88        {
89            dec:    valbind list,
90            explicit: {lookup: string -> typeVarForm option,
91                       apply: (string * typeVarForm -> unit) -> unit },
92            implicit: {lookup: string -> typeVarForm option,
93                       apply: (string * typeVarForm -> unit) -> unit },
94            location: location
95        }
96
97    |   FunDeclaration      of
98        {
99            dec:    fvalbind list,
100            explicit: {lookup: string -> typeVarForm option,
101                       apply: (string * typeVarForm -> unit) -> unit },
102            implicit: {lookup: string -> typeVarForm option,
103                       apply: (string * typeVarForm -> unit) -> unit },
104            location: location
105        } 
106
107    |   OpenDec             of
108            (* Open a structure.  The variables, structures and types are just needed if
109               debugging information is being generated. *)
110        {
111            decs: structureIdentForm list,
112            variables: values list ref,
113            structures: structVals list ref,
114            typeconstrs: typeConstrSet list ref,
115            location: location
116        }
117
118    |   Constraint          of
119           (* Constraint (explicit type given) *)
120           (* A constraint has a value and a type. The actual type, will, however
121              be the unification of these two and not necessarily the given type. *)
122            { value: parsetree, given: typeParsetree, location: location }
123
124    |   Layered             of
125          (* Layered pattern. Equivalent to an ordinary pattern except that the
126             variable is given the name of the object which is to be matched. *)
127            { var: parsetree, pattern: parsetree, location: location }
128
129    |   Fn                  of
130            { matches: matchtree list, location: location, expType: types ref }
131
132    |   Localdec            of (* Local dec in dec and let dec in exp. *)
133        {
134            decs: (parsetree * breakPoint option ref) list,
135            body: (parsetree * breakPoint option ref) list,
136            isLocal: bool,
137            varsInBody: values list ref, (* Variables in the in..dec part
138                                            of a local declaration. *)
139            location: location
140        } 
141
142    |   TypeDeclaration     of typebind list * location
143
144    |   AbsDatatypeDeclaration  of (* Datatype and Abstract Type declarations *)
145        {
146            isAbsType: bool,
147            typelist:  datatypebind list,
148            withtypes: typebind list,
149            declist:   (parsetree * breakPoint option ref) list,
150            location:  location,
151            equalityStatus: bool list ref
152        }
153
154    |   DatatypeReplication of
155        {
156            newType:  string,
157            oldType:  string,
158            oldLoc:   location,
159            newLoc:   location,
160            location: location
161        }
162
163    |   ExpSeq              of (parsetree * breakPoint option ref) list * location
164
165    |   Directive           of
166            (* Directives are infix, infixr and nonfix. They are processed by the
167               parser itself and only appear in the parse tree for completeness. *)
168            { tlist: string list, fix: infixity, location: location } 
169
170    |   ExDeclaration       of exbind list * location
171
172    |   Raise               of parsetree * location
173
174    |   HandleTree          of
175            (* Execute an expression and catch any exceptions. *)
176            { exp: parsetree, hrules: matchtree list, location: location, listLocation: location }
177
178    |   While               of
179            (* Ordinary while-loop *)
180            { test: parsetree, body: parsetree, location: location, breakPoint: breakPoint option ref } 
181
182    |   Case                of
183            (* Case-statement *)
184            { test: parsetree, match: matchtree list, location: location, listLocation: location, expType: types ref }
185
186    |   Andalso             of { first: parsetree, second: parsetree, location: location } 
187
188    |   Orelse              of { first: parsetree, second: parsetree, location: location }
189
190    |   Labelled            of
191        (* Labelled record & the entry in the list. "frozen" is false if it's
192           a pattern with "...". *)
193            { recList: labelRecEntry list, frozen: bool, expType: types ref, location: location }
194
195    |   Selector            of
196            { name: string, labType: types, typeof: types, location: location }
197
198    |   List                of
199            { elements: parsetree list, location: location, expType: types ref }
200    |   EmptyTree
201    |   WildCard            of location
202    |   Unit                of location
203    |   Parenthesised       of parsetree * location
204   
205    and valbind = (* Value bindings.*)
206        ValBind of (* Consists of a declaration part (pattern) and an expression. *)
207        {
208            dec: parsetree,
209            exp: parsetree,
210            line: location,
211            isRecursive: bool,
212            variables: values list ref (* list of variables declared and their poly vars *)
213        } 
214    
215   and fvalbind = (* Function binding *)
216   (* `Fun' bindings *)
217      (* A function binding is a list of clauses, each of which uses a
218         valBinding to hold the list of patterns and the corresponding function
219         body. The second pass extracts the function variable and the number of
220         patterns in each clause. It checks that they are the same in each
221         clause. *)
222       FValBind of
223         {
224           clauses:     fvalclause list, 
225           numOfPatts:  int ref,
226           functVar:    values ref,
227           argType:     types ref,
228           resultType:  types ref,
229           location:    location
230         }
231
232    and fvalclause = (* Clause within a function binding. *)
233        FValClause of
234        {
235            dec: funpattern,
236            exp: parsetree,
237            line: location,
238            breakPoint: breakPoint option ref
239        }
240        
241    and typebind = (* Non-generative type binding *)
242        TypeBind of
243         {
244           name: string,
245           typeVars: typeVarForm list,
246           decType: typeParsetree option,
247           isEqtype: bool, (* True if this was an eqtype in a signature. *)
248           tcon:     typeConstrSet ref,
249           nameLoc:  location,
250           fullLoc:  location
251         } 
252
253    and datatypebind = (* Generative type binding *)
254        DatatypeBind of
255         {
256           name:          string,
257           typeVars:      typeVarForm list,
258           constrs:       valueConstr list,
259           tcon:          typeConstrSet ref,
260           nameLoc:       location,
261           fullLoc:  location
262         }
263
264   and exbind = (* An exception declaration. It has a name and
265                   optionally a previous exception and a type. *)
266        ExBind of
267        {
268           name:         string,
269           previous:     parsetree,
270           ofType:       typeParsetree option,
271           value:        values ref,
272           nameLoc:      location,
273           fullLoc:      location
274        } 
275
276    and matchtree =
277    (* A match is a pattern and an expression. If the pattern matches then
278       the expression is evaluated in the environment of the pattern. *)
279        MatchTree of
280        {
281            vars: parsetree,
282            exp: parsetree,
283            location: location,
284            argType: types ref,
285            resType: types ref,
286            breakPoint: breakPoint option ref
287        } 
288
289    (* Name of a structure. Used only in an ``open'' declaration. *)
290    withtype structureIdentForm = 
291    {
292       name:   string,
293       value:  structVals option ref,
294       location: location
295    } 
296
297    (* An entry in a label record in an expression or a pattern. *)
298    and labelRecEntry =
299    {
300        name: string,
301        nameLoc: location,
302        valOrPat: parsetree,
303        fullLocation: location,
304        expType: types ref
305    }
306    
307    and funpattern = (* The declaration part of a fun binding. *)
308        { ident: { name: string, expType: types ref, location: location },
309          isInfix: bool, args: parsetree list, constraint: typeParsetree option }
310
311    and valueConstr =
312        {constrName: string, constrArg: typeParsetree option, idLocn: location, constrVal: values ref}
313
314    structure Sharing =
315    struct
316        type types = types
317        and  typeVarForm = typeVarForm
318        and  typeConstrSet = typeConstrSet
319        and  values = values
320        and  infixity = infixity
321        and  structVals = structVals
322        and  typeParsetree = typeParsetree
323        and  parsetree = parsetree
324        and  valbind = valbind
325        and  fvalbind = fvalbind
326        and  fvalclause = fvalclause
327        and  typebind = typebind
328        and  datatypebind = datatypebind
329        and  exbind = exbind
330        and  matchtree = matchtree
331    end
332
333end;
334