* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-*)
+ *)
(* Parser for Domtool configuration files *)
+
open Ast
%%
%term
EOF
| SYMBOL of string | CSYMBOL of string
- | STRING of string
+ | STRING of string | DOC of string
| INT of int
- | ARROW | DARROW | COLON | CARET | BANG | AND
+ | ARROW | DARROW | LARROW
+ | COLON | CARET | BANG | AND
| LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
| EQ | COMMA | BSLASH | SEMI | LET | IN | END
| ROOT
+ | EXTERN | TYPE | VAL | WITH | WHERE
%nonterm
- file of exp
+ file of file
+ | decls of decl list
+ | decl of decl
+ | decl' of decl'
+ | docOpt of string option
+ | expOpt of exp option
| exp of exp
| apps of exp
| term of exp
+ | sets of exp list
| elist of exp list
| elistNe of exp list
| clist of exp list
| typ of typ
- | ctxt of context
+ | ctxt of pred
| recd of record
| recdNe of record
%right ARROW DARROW
%right COMMA
%nonassoc EQ
+%right WITH
+%right WHERE
%right AND
%nonassoc CARET BANG
%%
-file : exp (exp)
+file : decls expOpt (decls, expOpt)
+
+decls : ([])
+ | decl SEMI decls (decl :: decls)
+
+decl : decl' docOpt (decl', docOpt, (decl'left, docOptright))
+
+decl' : EXTERN TYPE SYMBOL (DExternType SYMBOL)
+ | EXTERN VAL SYMBOL COLON typ (DExternVal (SYMBOL, typ))
+ | VAL SYMBOL EQ exp (DVal (SYMBOL, NONE, exp))
+ | VAL SYMBOL COLON typ EQ exp (DVal (SYMBOL, SOME typ, exp))
+
+docOpt : (NONE)
+ | DOC (SOME DOC)
+
+expOpt : (NONE)
+ | exp (SOME (ELocal (exp, (ESkip, (expleft, expright))),
+ (expleft, expright)))
+
exp : apps (apps)
- | BSLASH SYMBOL COLON LPAREN typ RPAREN ARROW exp (ELam (SYMBOL, typ, exp), (BSLASHleft, expright))
+ | apps WHERE sets END (ELocal ((ESeq sets, (setsleft, setsright)), apps),
+ (appsleft, ENDright))
+ | apps WITH END (EWith (apps, (ESkip, (WITHleft, ENDright))),
+ (appsleft, ENDright))
+ | apps WITH exp END (EWith (apps, exp), (appsleft, ENDright))
+ | apps WHERE sets WITH END (ELocal ((ESeq sets, (setsleft, setsright)),
+ (EWith (apps, (ESkip, (WITHleft, ENDright))),
+ (appsleft, ENDright))),
+ (appsleft, ENDright))
+ | apps WHERE sets WITH exp END (ELocal ((ESeq sets, (setsleft, setsright)),
+ (EWith (apps, exp), (appsleft, ENDright))),
+ (appsleft, ENDright))
+
+ | BSLASH SYMBOL COLON LPAREN typ RPAREN ARROW exp (ELam (SYMBOL, SOME typ, exp),
+ (BSLASHleft, expright))
+ | BSLASH SYMBOL ARROW exp (ELam (SYMBOL, NONE, exp), (BSLASHleft, expright))
| CSYMBOL EQ exp (ESet (CSYMBOL, exp), (CSYMBOLleft, expright))
| exp SEMI exp (let
val ls = case #1 exp2 of
in
(ESeq ls, (exp1left, exp2right))
end)
+ | SYMBOL LARROW CSYMBOL SEMI exp (EGet (SYMBOL, CSYMBOL, exp), (SYMBOLleft, expright))
+ (*| exp WHERE exp END (ELocal (exp1, exp2), (exp1left, ENDright))
+ | exp WHERE exp WITH END (EWith ((ELocal (exp1, exp2), (exp1left, ENDright)),
+ (ESkip, (WITHleft, ENDright))),
+ (exp1left, ENDright))
+ | exp WITH END (EWith (exp, (ESkip, (WITHleft, ENDright))), (expleft, ENDright))
+ | exp WITH exp END (EWith (exp1, exp2), (exp1left, ENDright))*)
apps : term (term)
| apps term (EApp (apps, term), (appsleft, termright))
| INT (EInt INT, (INTleft, INTright))
| STRING (EString STRING, (STRINGleft, STRINGright))
| LBRACK elist RBRACK (EList elist, (LBRACKleft, RBRACKright))
- | LET exp IN exp END (let
- val ls = case (#1 exp1, #1 exp2) of
- (ESeq ls1, ESeq ls2) => ls1 @ ls2
- | (ESeq ls, _) => ls @ [exp2]
- | (_, ESeq ls) => exp1 :: ls
- | _ => [exp1, exp2]
- in
- (ELocal (ESeq ls, (exp1left, exp2right)),
- (exp1left, exp2right))
- end)
+ | LET exp IN exp END (ELocal (exp1, exp2), (LETleft, ENDright))
| SYMBOL (EVar SYMBOL, (SYMBOLleft, SYMBOLright))
- | CSYMBOL (EEnv CSYMBOL, (CSYMBOLleft, CSYMBOLright))
+
+sets : CSYMBOL EQ apps ([(ESet (CSYMBOL, apps), (CSYMBOLleft, appsright))])
+ | CSYMBOL EQ apps SEMI sets ((ESet (CSYMBOL, apps), (CSYMBOLleft, appsright))
+ :: sets)
elist : ([])
| elistNe (elistNe)
typ : SYMBOL (TBase SYMBOL, (SYMBOLleft, SYMBOLright))
| LBRACK typ RBRACK (TList typ, (LBRACKleft, RBRACKright))
| typ ARROW typ (TArrow (typ1, typ2), (typleft, typright))
- | LBRACK ctxt RBRACK recd DARROW recd (TAction (ctxt, recd1, recd2), (ctxtleft, recd2right))
+ | LBRACK ctxt RBRACK recd DARROW recd (TAction (ctxt, recd1, recd2), (LBRACKleft, recd2right))
| LBRACK ctxt RBRACK recd (TAction (ctxt, recd, StringMap.empty),
- (ctxtleft, recdright))
+ (LBRACKleft, recdright))
| LBRACK ctxt RBRACK (TAction (ctxt, StringMap.empty, StringMap.empty),
- (ctxtleft, ctxtright))
+ (LBRACKleft, ctxtright))
| LPAREN typ RPAREN (typ)
+ | ctxt DARROW typ (TNested (ctxt, typ), (ctxtleft, typright))
recd : LBRACE RBRACE (StringMap.empty)
| LBRACE recdNe RBRACE (recdNe)
HCoop / hcoop / domtool2.git / blobdiff