Parse new `var' primitive
[hcoop/domtool2.git] / src / ast.sml
1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006-2007, Adam Chlipala
3 *
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
17 *)
18
19 (* Configuration language abstract syntax *)
20
21 structure Ast = struct
22
23 open DataStructures
24
25 (* A description of a predicate on configuration block stacks *)
26 datatype pred' =
27 CRoot
28 (* The stack is empty. *)
29 | CConst of string
30 (* The given pred name is on top of the stack. *)
31 | CPrefix of pred
32 (* Some prefix of the stack matches the pred. *)
33 | CNot of pred
34 (* The pred does not match. *)
35 | CAnd of pred * pred
36 (* Both preds match. *)
37 withtype pred = pred' * position
38
39 datatype typ' =
40 TBase of string
41 (* Base type *)
42 | TList of typ
43 (* SML 'a list *)
44 | TArrow of typ * typ
45 (* SML -> *)
46 | TAction of pred * record * record
47 (* An action that:
48 * - Is valid in the given pred
49 * - Expects an environment compatible with the first record
50 * - Modifies it according to the second record *)
51 | TNested of pred * typ
52 (* Allow nested configuration, in the form of a function from an action
53 * satisfying the first predicate to an action satisfying the second and
54 * with the same environment variable IO behavior. *)
55
56 | TError
57 (* Marker that something already went wrong, so don't generate further
58 * error messages. *)
59 | TUnif of string * typ option ref
60 (* Unification variable to be determined during type-checking *)
61 withtype typ = typ' * position
62 and record = (typ' * position) StringMap.map
63
64 datatype exp' =
65 EInt of int
66 (* Constant integer *)
67 | EString of string
68 (* Constant string *)
69 | EList of exp list
70 (* Basic list constructor *)
71
72 | ELam of string * typ option * exp
73 (* Function abstraction *)
74 | EVar of string
75 (* Variable bound by a function *)
76 | EApp of exp * exp
77 (* Function application *)
78
79 | ESkip
80 (* Do-nothing action *)
81 | ESet of string * exp
82 (* Set an environment variable *)
83 | EGet of string * typ option * string * exp
84 (* Get an environment variable *)
85 | ESeq of exp list
86 (* Monad sequencer; execute a number of commands in order *)
87 | ELocal of exp * exp
88 (* Local execution; like ESeq, but the writes of the first
89 * action are abandoned *)
90 | EWith of exp * exp
91 (* Apply a TNested to an action *)
92 | EALam of string * pred * exp
93 (* Abstraction for building TNested values *)
94 | EIf of exp * exp * exp
95 (* If..then..else *)
96 withtype exp = exp' * position
97
98 datatype decl' =
99 DExternType of string
100 | DExternVal of string * typ
101 | DVal of string * typ option * exp
102 | DEnv of string * typ option * exp
103 | DContext of string
104 type decl = decl' * string option * position
105
106 type file = string option * decl list * exp option
107
108 fun multiApp (f, loc, args) =
109 foldl (fn (arg, e) => (EApp (e, arg), loc)) f args
110
111 datatype unification_error =
112 UnifyPred of pred * pred
113 | UnifyTyp of typ * typ
114 | UnifyOccurs of string * typ
115
116 exception Unify of unification_error
117
118 datatype type_error =
119 WrongType of string * exp * typ * typ * unification_error option
120 | WrongForm of string * string * exp * typ * unification_error option
121 | UnboundVariable of string
122 | WrongPred of string * pred * pred
123
124 end