X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/63920aa5296a85edd9d734a65be22d9911358df2..6ae327f88a6be8efd02cfe4b713444f9f3ac2672:/src/domtool.grm?ds=sidebyside diff --git a/src/domtool.grm b/src/domtool.grm index 102349e..549a183 100644 --- a/src/domtool.grm +++ b/src/domtool.grm @@ -14,7 +14,7 @@ * 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 *) @@ -26,19 +26,26 @@ open Ast %term EOF | SYMBOL of string | CSYMBOL of string - | STRING of string + | STRING of string | DOC of string | INT of int | 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 | CONTEXT %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 @@ -62,15 +69,51 @@ open Ast %right ARROW DARROW %right COMMA %nonassoc EQ +%right WITH +%right WHERE %right AND %nonassoc CARET BANG %% -file : exp (exp) +file : docOpt decls expOpt (docOpt, decls, expOpt) + +decls : ([]) + | decl decls (decl :: decls) + +decl : decl' SEMI 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)) + | CONTEXT CSYMBOL (DContext CSYMBOL) + +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 @@ -79,7 +122,8 @@ exp : apps (apps) in (ESeq ls, (exp1left, exp2right)) end) - | SYMBOL LARROW CSYMBOL SEMI exp (EGet (SYMBOL, CSYMBOL, exp), (SYMBOLleft, expright)) + | exp SEMI (exp) + | SYMBOL LARROW CSYMBOL SEMI exp (EGet (SYMBOL, CSYMBOL, exp), (SYMBOLleft, expright)) apps : term (term) | apps term (EApp (apps, term), (appsleft, termright)) @@ -88,10 +132,13 @@ 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 (ELocal (ESeq [exp1, exp2], (LETleft, ENDright)), - (LETleft, ENDright)) + | 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) @@ -107,6 +154,7 @@ typ : SYMBOL (TBase SYMBOL, (SYMBOLleft, SYMBOLrig | 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)