X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/42198578566be256bbdebf22757f41edef4aa6ee..dac62e84b324d2187ec9b9882efa47125d5599a4:/src/domtool.grm diff --git a/src/domtool.grm b/src/domtool.grm index 79d13a1..cd899e1 100644 --- a/src/domtool.grm +++ b/src/domtool.grm @@ -14,9 +14,10 @@ * 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 %% @@ -25,22 +26,33 @@ 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 + | 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 pred + | recd of record + | recdNe of record %verbose (* print summary of errors *) %pos int (* positions *) @@ -52,17 +64,53 @@ open Ast %name Domtool %right SEMI +%nonassoc COLON %nonassoc IN -%right ARROW +%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)) + +docOpt : (NONE) + | DOC (SOME DOC) + +expOpt : (NONE) + | exp (SOME (ELocal (exp, (ESkip, (expleft, expright))), + (expleft, expright))) + exp : apps (apps) - | BSLASH SYMBOL COLON typ 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 @@ -71,6 +119,13 @@ exp : apps (apps) 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)) @@ -79,15 +134,12 @@ term : LPAREN exp RPAREN (exp) | 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 - (ESeq ls, (exp1left, exp2right)) - end) + | LET exp IN exp END (ELocal (exp1, exp2), (LETleft, ENDright)) + | SYMBOL (EVar SYMBOL, (SYMBOLleft, SYMBOLright)) + +sets : CSYMBOL EQ apps ([(ESet (CSYMBOL, apps), (CSYMBOLleft, appsright))]) + | CSYMBOL EQ apps SEMI sets ((ESet (CSYMBOL, apps), (CSYMBOLleft, appsright)) + :: sets) elist : ([]) | elistNe (elistNe) @@ -96,3 +148,25 @@ elistNe: exp ([exp]) | exp COMMA elistNe (exp :: 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), (LBRACKleft, recd2right)) + | LBRACK ctxt RBRACK recd (TAction (ctxt, recd, StringMap.empty), + (LBRACKleft, recdright)) + | LBRACK ctxt RBRACK (TAction (ctxt, StringMap.empty, StringMap.empty), + (LBRACKleft, ctxtright)) + | LPAREN typ RPAREN (typ) + | ctxt DARROW typ (TNested (ctxt, typ), (ctxtleft, typright)) + +recd : LBRACE RBRACE (StringMap.empty) + | LBRACE recdNe RBRACE (recdNe) + +recdNe : CSYMBOL COLON typ (StringMap.insert (StringMap.empty, CSYMBOL, typ)) + | CSYMBOL COLON typ COMMA recdNe (StringMap.insert (recdNe, CSYMBOL, typ)) + +ctxt : ROOT (CRoot, (ROOTleft, ROOTright)) + | CSYMBOL (CConst CSYMBOL, (CSYMBOLleft, CSYMBOLright)) + | CARET ctxt (CPrefix ctxt, (CARETleft, ctxtright)) + | BANG ctxt (CNot ctxt, (BANGleft, ctxtright)) + | ctxt AND ctxt (CAnd (ctxt1, ctxt2), (ctxt1left, ctxt2right)) + | LPAREN ctxt RPAREN (ctxt)