1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006, Adam Chlipala
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.
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.
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.
19 (* Parser for Domtool configuration files *)
24 %header (functor DomtoolLrValsFn(structure Token : TOKEN))
28 | SYMBOL of string | CSYMBOL of string
29 | STRING of string | DOC of string
31 | ARROW | DARROW | LARROW
32 | COLON | CARET | BANG | AND
33 | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
34 | EQ | COMMA | BSLASH | BSLASHBSLASH | SEMI | LET | IN | BEGIN | END
37 | EXTERN | TYPE | VAL | ENV | WITH | WHERE | CONTEXT
44 | docOpt of string option
45 | expOpt of exp option
59 %verbose (* print summary of errors *)
60 %pos int (* positions *)
82 file : docOpt decls expOpt (docOpt, decls, expOpt)
85 | decl decls (decl :: decls)
87 decl : decl' SEMI docOpt (decl', docOpt, (decl'left, docOptright))
89 decl' : EXTERN TYPE SYMBOL (DExternType SYMBOL)
90 | EXTERN VAL SYMBOL COLON typ (DExternVal (SYMBOL, typ))
91 | VAL SYMBOL EQ exp (DVal (SYMBOL, NONE, exp))
92 | VAL SYMBOL COLON typ EQ exp (DVal (SYMBOL, SOME typ, exp))
93 | ENV CSYMBOL EQ exp (DEnv (CSYMBOL, NONE, exp))
94 | ENV CSYMBOL COLON typ EQ exp (DEnv (CSYMBOL, SOME typ, exp))
95 | CONTEXT CSYMBOL (DContext CSYMBOL)
105 | apps WHERE sets END (ELocal ((ESeq sets, (setsleft, setsright)), apps),
106 (appsleft, ENDright))
107 | apps WITH END (EWith (apps, (ESkip, (WITHleft, ENDright))),
108 (appsleft, ENDright))
109 | apps WITH exp END (EWith (apps, exp), (appsleft, ENDright))
110 | apps WHERE sets WITH END (ELocal ((ESeq sets, (setsleft, setsright)),
111 (EWith (apps, (ESkip, (WITHleft, ENDright))),
112 (appsleft, ENDright))),
113 (appsleft, ENDright))
114 | apps WHERE sets WITH exp END (ELocal ((ESeq sets, (setsleft, setsright)),
115 (EWith (apps, exp), (appsleft, ENDright))),
116 (appsleft, ENDright))
118 | BSLASH SYMBOL COLON LPAREN typ RPAREN ARROW exp (ELam (SYMBOL, SOME typ, exp),
119 (BSLASHleft, expright))
120 | BSLASH SYMBOL ARROW exp (ELam (SYMBOL, NONE, exp), (BSLASHleft, expright))
121 | BSLASHBSLASH SYMBOL COLON ctxt ARROW exp (EALam (SYMBOL, ctxt, exp),
122 (BSLASHBSLASHleft, expright))
123 | CSYMBOL EQ exp (ESet (CSYMBOL, exp), (CSYMBOLleft, expright))
125 val ls = case #1 exp2 of
129 (ESeq ls, (exp1left, exp2right))
132 | SYMBOL LARROW CSYMBOL SEMI exp (EGet (SYMBOL, NONE, CSYMBOL, exp), (SYMBOLleft, expright))
133 | SYMBOL COLON typ LARROW CSYMBOL SEMI exp (EGet (SYMBOL, SOME typ, CSYMBOL, exp), (SYMBOLleft, expright))
134 | IF exp THEN exp ELSE exp END (EIf (exp1, exp2, exp3), (IFleft, ENDright))
137 | apps term (EApp (apps, term), (appsleft, termright))
139 term : LPAREN exp RPAREN (exp)
140 | BEGIN exp END (exp)
141 | INT (EInt INT, (INTleft, INTright))
142 | STRING (EString STRING, (STRINGleft, STRINGright))
143 | LBRACK elist RBRACK (EList elist, (LBRACKleft, RBRACKright))
144 | LET exp IN exp END (ELocal (exp1, exp2), (LETleft, ENDright))
145 | SYMBOL (EVar SYMBOL, (SYMBOLleft, SYMBOLright))
146 | SKIP (ESkip, (SKIPleft, SKIPright))
148 sets : CSYMBOL EQ apps SEMIopt ([(ESet (CSYMBOL, apps), (CSYMBOLleft, appsright))])
149 | CSYMBOL EQ apps SEMI sets ((ESet (CSYMBOL, apps), (CSYMBOLleft, appsright))
159 | exp COMMA elistNe (exp :: elistNe)
161 typ : SYMBOL (TBase SYMBOL, (SYMBOLleft, SYMBOLright))
162 | LBRACK typ RBRACK (TList typ, (LBRACKleft, RBRACKright))
163 | typ ARROW typ (TArrow (typ1, typ2), (typleft, typright))
164 | LBRACK ctxt RBRACK recd DARROW recd (TAction (ctxt, recd1, recd2), (LBRACKleft, recd2right))
165 | LBRACK ctxt RBRACK recd (TAction (ctxt, recd, StringMap.empty),
166 (LBRACKleft, recdright))
167 | LBRACK ctxt RBRACK (TAction (ctxt, StringMap.empty, StringMap.empty),
168 (LBRACKleft, ctxtright))
169 | LPAREN typ RPAREN (typ)
170 | ctxt DARROW typ (TNested (ctxt, typ), (ctxtleft, typright))
172 recd : LBRACE RBRACE (StringMap.empty)
173 | LBRACE recdNe RBRACE (recdNe)
175 recdNe : CSYMBOL COLON typ (StringMap.insert (StringMap.empty, CSYMBOL, typ))
176 | CSYMBOL COLON typ COMMA recdNe (StringMap.insert (recdNe, CSYMBOL, typ))
178 ctxt : ROOT (CRoot, (ROOTleft, ROOTright))
179 | CSYMBOL (CConst CSYMBOL, (CSYMBOLleft, CSYMBOLright))
180 | CARET ctxt (CPrefix ctxt, (CARETleft, ctxtright))
181 | BANG ctxt (CNot ctxt, (BANGleft, ctxtright))
182 | ctxt AND ctxt (CAnd (ctxt1, ctxt2), (ctxt1left, ctxt2right))
183 | LPAREN ctxt RPAREN (ctxt)