(* File: Parser2.grm Author: Nicholas Wolverson (later tweaked by JRL) Date: February 2008 (started) Description: mlyacc grammar for Lingay *) (* A few ML utilities *) fun lookup "bogus" = 10000 | lookup s = 0 (* Coercing a variable x to unit type, thus: split {k = (x={})} as {}+r in e end *) fun ucoerce pos x e = Absyn.Split (pos, Absyn.Product (pos, [("__k", Absyn.Eq (pos, Absyn.Var(pos,x), Absyn.Product(pos,[])))]), [], "__q", e) ; (* Nicholas's version using "fn": fun coerce pos x t e = Absyn.App(pos, Absyn.Fun(pos, x, t, e), Absyn.Var(pos, x)) fun ucoerce pos x e = coerce pos x (Absyn.ProdTy([],[])) e *) fun infixop pos opp e1 e2 = Absyn.App(pos, Absyn.App(pos, Absyn.Const (pos, opp), e1), e2) fun typeOrUnit (l, SOME t) = (l,t) | typeOrUnit (l, NONE) = (l, Types.ProdTy ([],[])) exception IntLitError of string fun fromString s = case Int.fromString s of SOME n => n | NONE => raise IntLitError s %% %eop EOF SEMI (* %pos declares the type of positions for terminals. Each symbol has an associated left and right position. *) %pos int %term ID of string | INT of string | BOOL of bool | ROWVAR of string | LSUM | RSUM | LPROD | RPROD | LPAREN | RPAREN | PRODEXT | UNITTY | COLON | BANG | MERGE | INJECT | DOT | DOLLAR | CAST | BACKSLASH | EOF | SEMI | COMMA | EQUALS | ARROW | WARROW | LOLLY | BAR | DCOLON | BOOLTY | INTTY | LINEAR | RECTYPE | CLASSIMPL | EXTEND | WITH | END | CASE | OF | ROOT | SPLIT | AS | IN | NEW | UNFOLD | FOLD | DER | PROM | LET | IF | THEN | ELSE | CATCHCONT | FORCE | REC | FN | ONCEFN | CASEFN | CASEONCEFN | TAG | TOK | VAL | TYPE | LOCAL | DATATYPE | SAFE | METASAFE | METASAFELIN | ARGSAFE | WRITESAFE | PLUS | MINUS | LT | FIELDS | METHODS | CONSTR | EXTENDING | RECVAL | FUN | RECFUN | QUERY | ASSIGN | REFTYPE | FOR | WILDCARD | DOTS | VS | MAKE | REF | DEREF | CLASS | FUNCLASS | LINCLASS | ISO %nonterm START of (int*int) Ssyn.topdec | SAFETAG of Ssyn.safetag | DEC of (int*int) Ssyn.dec | ARGLIST of (Ssyn.pattern * Types.ty) list | EXP of (int*int) Ssyn.exp | EXP1 of (int*int) Ssyn.exp | EXP2 of (int*int) Ssyn.exp | EXP3 of (int*int) Ssyn.exp | EXP4 of (int*int) Ssyn.exp | DECEXP of (int*int) Ssyn.exp | MATCH of (int*int) Ssyn.match | PATTERN of Ssyn.pattern | PATTERN1 of Ssyn.pattern | PATTERN2 of Ssyn.pattern | RECORDPAT of Ssyn.recordpat | RECORDPAT1 of Ssyn.recordpat | COMPPATLIST of (Types.label * Ssyn.pattern) list | COMPPATLIST' of (Types.label * Ssyn.pattern) list | COMPASSLIST of (Types.label * (int*int) Ssyn.exp) list | COMPASSLIST' of (Types.label * (int*int) Ssyn.exp) list | CASECLAUSE of (int*int) Ssyn.caseclause | CASECLAUSELIST of (int*int) Ssyn.caseclause list | CASECLAUSELIST' of (int*int) Ssyn.caseclause list | CLASSKIND of Ssyn.classkind | EXTENDCLAUSE of (int*int) Ssyn.extendclause | METHODBODY of (int*int) Ssyn.methodbody | METHODBODYLIST of (int*int) Ssyn.methodbody list | METHODBODYLIST' of (int*int) Ssyn.methodbody list | TY of Types.ty | TY' of Types.ty | TYCOMPONENTS of (Types.label * Types.ty) list | TYCOMPONENTSREST of (Types.label * Types.ty) list | TYSUMMANDS of (Types.label * Types.ty option) list | LINOPT of bool %name Lingay %noshift EOF SEMI %value ID ("bogus") %nodefault %verbose %% (* the parser returns the value associated with the expression *) START : TYPE ID EQUALS TY (Ssyn.TypeDec ((TYPEleft,TYright),ID,TY)) | DATATYPE ID ISO LSUM TYSUMMANDS RSUM (Ssyn.DatatypeDec ((DATATYPEleft,RSUMright),ID,TYSUMMANDS)) | SAFETAG DEC (Ssyn.Dec ((SAFETAGleft,DECright),SAFETAG,DEC)) | EOF (Ssyn.Empty) SAFETAG : (Ssyn.None) | SAFE (Ssyn.Safe) | WRITESAFE (Ssyn.Writesafe) | ARGSAFE (Ssyn.Argsafe) | METASAFE (Ssyn.Metasafe) | METASAFELIN (Ssyn.MetasafeLin) DEC : VAL PATTERN EQUALS EXP (Ssyn.Val (PATTERN,EXP)) | RECVAL ID COLON TY EQUALS EXP (Ssyn.RecVal (ID,TY,EXP)) | FUN ID ARGLIST EQUALS EXP (Ssyn.Funn (ID,ARGLIST,EXP)) | RECFUN ID ARGLIST COLON TY EQUALS EXP (Ssyn.RecFunn (ID,ARGLIST,TY,EXP)) | EXP (Ssyn.Val (Ssyn.VarPat "it", EXP)) ARGLIST : LPAREN PATTERN1 COLON TY RPAREN ( [(PATTERN1,TY)] ) | LPAREN PATTERN1 COLON TY RPAREN ARGLIST ( (PATTERN1,TY)::ARGLIST ) EXP : EXP1 ( EXP1 ) | ONCEFN MATCH (Ssyn.Oncefn ((ONCEFNleft,MATCHright), MATCH)) | FN MATCH (Ssyn.Fn ((FNleft,MATCHright), MATCH)) | REC MATCH (Ssyn.Rec ((RECleft,MATCHright), MATCH)) | CATCHCONT MATCH (Ssyn.Catchcont ((CATCHCONTleft,MATCHright), MATCH)) | IF EXP THEN EXP ELSE EXP (Ssyn.If((IFleft,EXP3right), EXP1,EXP2,EXP3)) | ID ASSIGN EXP (Ssyn.Assign((IDleft,EXPright), ID,EXP)) EXP1 : EXP2 ( EXP2 ) | EXP2 EQUALS EXP2 (Ssyn.Eq((EXP21left, EXP22right), EXP21,EXP22)) | EXP2 BACKSLASH EXP2 (Ssyn.VS((EXP21left, EXP22right), EXP21,EXP22)) EXP2 : EXP3 ( EXP3 ) | EXP2 DOLLAR EXP3 (Ssyn.Dollar((EXP2left,EXP3right), EXP2,EXP3)) | EXP3 PLUS EXP3 (Ssyn.Infix((EXP31left,EXP32right), Ssyn.IntPlus, EXP31,EXP32)) | EXP3 MINUS EXP3 (Ssyn.Infix((EXP31left,EXP32right), Ssyn.IntMinus, EXP31,EXP32)) | EXP3 LT EXP3 (Ssyn.Infix((EXP31left,EXP32right), Ssyn.IntLessThan, EXP31,EXP32)) | EXP3 MERGE EXP3 (Ssyn.Merge((EXP31left,EXP32right), EXP31,EXP32)) | EXP3 CAST TY (Ssyn.Cast ((EXP31left,EXP31right), EXP3,TY)) EXP3 : EXP4 ( EXP4 ) | TAG ID EXP4 (Ssyn.Tag((TAGleft,EXP4right), ID,EXP4)) | TOK ID (Ssyn.Tok((TOKleft,IDright), ID)) | EXP3 DOT ID (Ssyn.Dot((EXP3left,IDright), EXP3,ID)) | PROM EXP4 (Ssyn.Prom((PROMleft,EXP4right), EXP4)) | DER EXP4 (Ssyn.Der((DERleft,EXP4right), EXP4)) | FORCE EXP4 (Ssyn.Force((FORCEleft,EXP4right), EXP4)) | FOLD TY' EXP4 (Ssyn.Fold((FOLDleft,EXP4right), TY',EXP4)) | UNFOLD EXP4 (Ssyn.Unfold((UNFOLDleft,EXP4right), EXP4)) | EXP3 EXP4 (Ssyn.Juxta((EXP3left,EXP4right), EXP3,EXP4)) | NEW EXP4 (Ssyn.New((NEWleft,EXP4right), EXP4)) | MAKE EXP4 EXP4 (Ssyn.Make((MAKEleft,EXP42right), EXP41,EXP42)) | REF ID EXP4 (Ssyn.Ref((REFleft,EXP4right), ID,EXP4)) | DEREF EXP4 (Ssyn.Deref((DEREFleft,EXP4right), EXP4)) EXP4 : ID (Ssyn.Var((IDleft,IDright), ID)) | INT (Ssyn.Lit((INTleft,INTright), Ssyn.Int INT)) | BOOL (Ssyn.Lit((BOOLleft,BOOLright), Ssyn.Bool BOOL)) | LPAREN RPAREN (Ssyn.Unit((LPARENleft,RPARENright))) | QUERY ID (Ssyn.Query((QUERYleft,IDright), ID)) | LPROD COMPASSLIST RPROD (Ssyn.Product((LPRODleft,RPRODright), COMPASSLIST)) | SPLIT DECEXP AS RECORDPAT IN DECEXP END (Ssyn.Split((SPLITleft,ENDright), DECEXP1,RECORDPAT,DECEXP2)) | SPLIT DECEXP AS RECORDPAT1 IN DECEXP END (Ssyn.Split((SPLITleft,ENDright), DECEXP1,RECORDPAT1,DECEXP2)) | CASE DECEXP OF CASECLAUSELIST END (Ssyn.Case((CASEleft,ENDright), DECEXP,CASECLAUSELIST)) | LINOPT ROOT (Ssyn.Root((LINOPTleft,ROOTright), LINOPT)) | LINOPT EXTEND EXP WITH EXP COMMA EXP END (Ssyn.Extend((LINOPTleft,ENDright), LINOPT,EXP1,EXP2,EXP3)) | CLASSKIND DCOLON TY EXTENDCLAUSE WITH FIELDS TYCOMPONENTS METHODS METHODBODYLIST CONSTR MATCH END (Ssyn.Class((CLASSKINDleft,ENDright), CLASSKIND, TY,EXTENDCLAUSE, Types.ProdTy(TYCOMPONENTS,[]), METHODBODYLIST, MATCH)) | REFTYPE ID FOR TY IN DECEXP END (Ssyn.Reftype((REFTYPEleft,ENDright), ID,TY,DECEXP)) | LPAREN DECEXP RPAREN ( DECEXP ) DECEXP : EXP ( EXP ) | DEC SEMI DECEXP (Ssyn.DecExp((DECleft,DECEXPright), DEC,DECEXP)) MATCH : ID COLON TY WARROW EXP (Ssyn.VarMatch(ID,TY,EXP)) | PATTERN2 COLON TY WARROW EXP (Ssyn.PatMatch(PATTERN2,TY,EXP)) | FOLD TY PATTERN WARROW EXP (Ssyn.FoldMatch(TY,PATTERN,EXP)) PATTERN : PATTERN1 ( PATTERN1 ) | RECORDPAT (Ssyn.RecPat(RECORDPAT)) | FOLD TY PATTERN1 (Ssyn.FoldPat(TY,PATTERN1)) PATTERN1 : PATTERN2 ( PATTERN2 ) | ID (Ssyn.VarPat(ID)) PATTERN2 : WILDCARD (Ssyn.WildPat) | RECORDPAT1 (Ssyn.RecPat(RECORDPAT1)) | LPAREN PATTERN RPAREN ( PATTERN ) RECORDPAT : LPROD COMPPATLIST RPROD PLUS ID (Ssyn.GenRecPat(COMPPATLIST,ID)) RECORDPAT1 : LPROD COMPPATLIST RPROD (Ssyn.RigidRecPat(COMPPATLIST)) | LPROD COMPPATLIST RPROD DOTS (Ssyn.FlexRecPat(COMPPATLIST)) | LPAREN PATTERN BACKSLASH PATTERN RPAREN (Ssyn.VSRecPat(PATTERN1,PATTERN2)) | LPAREN RPAREN (Ssyn.RigidRecPat []) COMPPATLIST : ( [] ) | ID EQUALS PATTERN COMPPATLIST' ( (ID,PATTERN)::COMPPATLIST' ) COMPPATLIST' : ( [] ) | COMMA ID EQUALS PATTERN COMPPATLIST' ( (ID,PATTERN)::COMPPATLIST' ) COMPASSLIST : ( [] ) | ID EQUALS EXP COMPASSLIST' ( (ID,EXP)::COMPASSLIST' ) COMPASSLIST' : ( [] ) | COMMA ID EQUALS EXP COMPASSLIST' ( (ID,EXP)::COMPASSLIST' ) CASECLAUSELIST : ( [] ) | CASECLAUSE CASECLAUSELIST' ( CASECLAUSE::CASECLAUSELIST' ) CASECLAUSELIST' : ( [] ) | BAR CASECLAUSE CASECLAUSELIST' ( CASECLAUSE::CASECLAUSELIST' ) CASECLAUSE : ID ID WARROW DECEXP ( Ssyn.VarClause(ID1,ID2,DECEXP) ) | ID PATTERN2 WARROW DECEXP ( Ssyn.PatClause(ID,PATTERN2,DECEXP) ) | ID WARROW DECEXP ( Ssyn.TokClause(ID,DECEXP) ) CLASSKIND : CLASS ( Ssyn.Imp ) | FUNCLASS ( Ssyn.Fun ) | LINCLASS ( Ssyn.Lin ) EXTENDCLAUSE : ( Ssyn.NoExtend ) | EXTENDING EXP COLON TY ( Ssyn.StdExtend (EXP,TY) ) | EXTENDING ID ( Ssyn.AbbrevExtend ID ) METHODBODYLIST : ( [] ) | METHODBODY METHODBODYLIST' ( METHODBODY::METHODBODYLIST' ) METHODBODYLIST' : ( [] ) | COMMA METHODBODY METHODBODYLIST' ( METHODBODY::METHODBODYLIST' ) METHODBODY : ID PATTERN1 EQUALS EXP ( Ssyn.Method(ID,PATTERN1,EXP) ) TY : TY' ARROW TY (Types.BangTy(Types.FunTy(TY',TY))) | TY' LOLLY TY (Types.FunTy(TY',TY)) | TY' PRODEXT TY (Types.MergeTy(TY',TY)) | RECTYPE ID WARROW TY (Types.RecTy(ID,TY)) | TY' (TY') TY': BOOLTY (Types.BoolTy) | INTTY (Types.IntTy) | UNITTY (Types.ProdTy([],[])) | ID (Types.NamedTy(ID)) | LPROD TYCOMPONENTS RPROD (Types.ProdTy(TYCOMPONENTS,[])) | VS LPAREN TY COMMA TY RPAREN (Types.ProdTy([("value",TY1),("state",TY2)],[])) | LSUM TYSUMMANDS RSUM (Types.SumTy (map typeOrUnit TYSUMMANDS)) | LSUM RSUM (Types.SumTy []) | BANG TY' (Types.BangTy(TY')) | LINOPT CLASSIMPL TY COMMA TY COMMA TY' END (Types.ClassImplTy (LINOPT,TY1,TY2,TY')) | LINOPT CLASSIMPL FIELDS TY METHODS TY CONSTR TY' END (Types.ClassImplTy (LINOPT,TY1,TY2,TY')) | LPAREN TY RPAREN (TY) TYCOMPONENTS : ( [] ) | ID COLON TY TYCOMPONENTSREST ( (ID,TY) :: TYCOMPONENTSREST ) TYCOMPONENTSREST : ( [] ) | COMMA ID COLON TY TYCOMPONENTSREST ( (ID,TY) :: TYCOMPONENTSREST ) TYSUMMANDS : ID OF TY ( [(ID, SOME TY)] ) | ID ( [(ID, NONE)] ) | ID OF TY COMMA TYSUMMANDS ( (ID, SOME TY) :: TYSUMMANDS ) | ID COMMA TYSUMMANDS ( (ID, NONE) :: TYSUMMANDS ) LINOPT : (false) | LINEAR (true)