![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ml.grm CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / parse|
Return to ml.grm CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / parse |
1.1 ! root 1: (* Copyright 1989 by AT&T Bell Laboratories *) ! 2: open ErrorMsg Symbol PrintUtil ! 3: open Access Basics BasicTypes TypesUtil Absyn ! 4: open Env ! 5: open EnvAccess ! 6: open ModUtil ! 7: open SigMatch ! 8: open Misc ! 9: open CoreLang ! 10: open Signs ! 11: open Strs ! 12: %% ! 13: %term ! 14: EOF | ID of Symbol.symbol | IDDOT of Symbol.symbol | TYVAR of Symbol.symbol ! 15: | INT of int | REAL of string | STRING of string | ABSTRACTION | ABSTYPE | AND ! 16: | ARROW | AS | BAR | CASE | DATATYPE | DOTDOTDOT | ELSE | END | EQUAL ! 17: | EQTYPE | EXCEPTION | DO | DARROW | FN | FUN | FUNCTOR | HANDLE | HASH ! 18: | IF | IN | INCLUDE | INFIX | INFIXR | LET | LOCAL | NONFIX | OF | OP ! 19: | OPEN | OVERLOAD | QUERY | RAISE | REC | SHARING | SIG | SIGNATURE | STRUCT ! 20: | STRUCTURE | THEN | TYPE | VAL | WHILE | WILD | WITH | WITHTYPE | ASTERISK ! 21: | COLON | COMMA | LBRACE | LBRACKET | LPAREN | RBRACE | RBRACKET | RPAREN | ! 22: SEMICOLON | ORELSE | ANDALSO | IMPORT ! 23: ! 24: %nonterm ident of symbol ! 25: | optional_op of unit ! 26: | opid of symbol ! 27: | qid of symbol list ! 28: | selector of symbol ! 29: | tycon of symbol list ! 30: | tlabel of (symbol * ty) susp ! 31: | tlabels of (symbol * ty) list susp ! 32: | ty' of ty susp ! 33: | tuple_ty of ty list susp ! 34: | ty of ty susp ! 35: | ty0_pc of ty list susp ! 36: | match of rule list stamped ! 37: | rule of rule stamped ! 38: | elabel of (symbol * exp) stamped ! 39: | elabels of (symbol * exp) list stamped ! 40: | exp_ps of exp list stamped ! 41: | exp of exp stamped ! 42: | app_exp of exp precStack stamped ! 43: | aexp of exp stamped ! 44: | bexp of exp stamped ! 45: | cexp of exp stamped ! 46: | dexp of exp stamped ! 47: | exp_list of exp list stamped ! 48: | exp_2c of exp list stamped ! 49: | pat of pat susp ! 50: | app_pat of appat precStack susp ! 51: | apat of pat susp ! 52: | plabel of (symbol * pat) susp ! 53: | plabels of ((symbol * pat) list * bool) susp ! 54: | pat_2c of pat list susp ! 55: | pat_list of pat list susp ! 56: | vb of vb list stamped ! 57: | constraint of ty option susp ! 58: | rvb of rawrvb list susp ! 59: | fb' of rawclause list susp ! 60: | fb of rawclause list list susp ! 61: | clause of rawclause susp ! 62: | tb of bool -> tb list pathstamped ! 63: | tyvars of tyvar list ! 64: | tyvar_pc of tyvar list ! 65: | db of tycon ref list pathstamped ! 66: | db' of tycon ref pathstamped ! 67: | constrs of ty -> (symbol * bool * ty) list ! 68: | constr of ty -> symbol * bool * ty ! 69: | eb of eb list susp ! 70: | qid_p of structureVar list susp ! 71: | fixity of fixity ! 72: | ldec of dec pathstamped ! 73: | exp_pa of exp list stamped ! 74: | ldecs of dec pathstamped ! 75: | ops of symbol list ! 76: | spec_s of spectype ! 77: | spec of spectype ! 78: | strspec of spectype ! 79: | tyspec of bool3 -> spectype ! 80: | valspec of spectype ! 81: | exnspec of spectype ! 82: | sharespec of spectype ! 83: | patheqn of symbol list list ! 84: | sign of signtype ! 85: | sigconstraint_op of Structure option susp ! 86: | sigb of signatureVar list susp ! 87: | str of strArg -> strexp * Structure * thinning ! 88: | sdecs of dec list pathstamped ! 89: | sdec of dec pathstamped ! 90: | strb of bool -> (symbol*structureVar*strb) list pathstamped ! 91: | fparam of (symbol * access * Structure * bool) susp ! 92: | fctb of (symbol * functorVar * fctb) list susp ! 93: | importdec of string list ! 94: | interdec of dec susp ! 95: ! 96: %verbose ! 97: %pure ! 98: %start interdec ! 99: %eop EOF SEMICOLON ! 100: ! 101: %nonassoc WITHTYPE ! 102: %right AND ! 103: %right ARROW ! 104: %right AS ! 105: %right HANDLE ! 106: %right BAR ! 107: %left ORELSE ! 108: %left ANDALSO ! 109: %left COLON ! 110: ! 111: %name ML ! 112: ! 113: %keyword ABSTRACTION ABSTYPE AND AS CASE DATATYPE DOTDOTDOT ELSE END ! 114: EQTYPE EXCEPTION DO DARROW FN FUN FUNCTOR HANDLE ! 115: IF IN INCLUDE INFIX INFIXR LET LOCAL NONFIX OF OP ! 116: OPEN OVERLOAD RAISE REC SHARING SIG SIGNATURE STRUCT ! 117: STRUCTURE THEN TYPE VAL WHILE WITH WITHTYPE ! 118: ORELSE ANDALSO IMPORT ! 119: ! 120: %subst EQUAL for DARROW | DARROW for EQUAL | ANDALSO for AND ! 121: ! 122: %prefer VAL THEN ELSE ! 123: %header (structure MLLrValues) ! 124: %% ! 125: ! 126: ident : ID (ID) ! 127: | ASTERISK (ASTERISKsym) ! 128: | EQUAL (EQUALsym) ! 129: ! 130: optional_op : OP (warn "unnecessary `op' in datatype or exception declaration") ! 131: | () ! 132: ! 133: opid : ID (ID) ! 134: | ASTERISK (ASTERISKsym) ! 135: | OP ident (ident) ! 136: ! 137: qid : IDDOT qid (IDDOT :: qid) ! 138: | ident ([ident]) ! 139: ! 140: selector: ID (ID) ! 141: | INT (let val s = makestring INT ! 142: in if INT < 1 ! 143: then complain ("nonpositive integer label in \ ! 144: \selector, found " ^ s) ! 145: else (); ! 146: Symbol.symbol s ! 147: end) ! 148: ! 149: tycon : IDDOT tycon (IDDOT :: tycon) ! 150: | ID ([ID]) ! 151: ! 152: tlabel : selector COLON ty (fn()=>(selector, ty())) ! 153: ! 154: tlabels : tlabel COMMA tlabels (fn()=>tlabel()::tlabels()) ! 155: | tlabel (fn()=>[tlabel()]) ! 156: ! 157: ty' : TYVAR (fn()=>VARty(lookTyvar TYVAR)) ! 158: | LBRACE tlabels RBRACE (fn()=>make_recordTy(tlabels())) ! 159: | LBRACE RBRACE (fn()=>make_recordTy nil) ! 160: | LPAREN ty0_pc ! 161: RPAREN tycon (fn()=>let val ts = ty0_pc() ! 162: in CONty(!lookPathArTYC(tycon,length ts),ts) ! 163: end) ! 164: | LPAREN ty RPAREN (ty) ! 165: | ty' tycon (fn()=>CONty(lookArTYCp(tycon,1),[ty'()])) ! 166: | tycon (fn()=>CONty(lookArTYCp(tycon,0),[])) ! 167: ! 168: tuple_ty : ty' ASTERISK tuple_ty (fn()=> ty'() :: tuple_ty()) ! 169: | ty' ASTERISK ty' (fn()=>[ty'1(),ty'2()]) ! 170: ! 171: ty : tuple_ty (fn()=>tupleTy(tuple_ty())) ! 172: | ty ARROW ty (fn()=>CONty(arrowTycon, [ty1(),ty2()])) ! 173: | ty' (ty') ! 174: ! 175: ty0_pc : ty COMMA ty (fn() => [ty1(),ty2()]) ! 176: | ty COMMA ty0_pc (fn() => ty()::ty0_pc()) ! 177: ! 178: match : rule (fn st => [rule st]) ! 179: | rule BAR match (fn st => rule st :: match st) ! 180: ! 181: rule : pat DARROW exp (makeRULE(pat,exp)) ! 182: ! 183: elabel : selector EQUAL exp (fn st => (selector,exp st)) ! 184: ! 185: elabels : elabel COMMA elabels (fn st => (elabel st :: elabels st)) ! 186: | elabel (fn st => [elabel st]) ! 187: ! 188: exp_ps : exp (fn st => [exp st]) ! 189: | exp SEMICOLON exp_ps (fn st => exp st :: exp_ps st) ! 190: ! 191: exp : app_exp bexp (fn st => exp_finish(exp_parse(app_exp st, ! 192: bexp st, NONfix))) ! 193: | bexp (bexp) ! 194: | cexp (cexp) ! 195: ! 196: bexp : FN match (fn st=> FNexp(match st)) ! 197: | CASE exp OF match (fn st=> CASEexp(exp st, match st)) ! 198: | WHILE exp DO exp (fn st=> WHILEexp(exp1 st, exp2 st)) ! 199: | IF exp THEN exp ! 200: ELSE exp (fn st=> IFexp(exp1 st, exp2 st, exp3 st)) ! 201: ! 202: cexp : cexp HANDLE match (fn st=> HANDLEexp(cexp st, ! 203: HANDLER(FNexp(match st)))) ! 204: | RAISE exp (fn st=> RAISEexp(exp st)) ! 205: | dexp (dexp) ! 206: ! 207: dexp : app_exp (fn st=> exp_finish(app_exp st)) ! 208: | dexp COLON ty (fn st=> CONSTRAINTexp(dexp st, ty())) ! 209: | dexp ANDALSO dexp (fn st=> ANDALSOexp(dexp1 st, dexp2 st)) ! 210: | dexp ORELSE dexp (fn st=> ORELSEexp(dexp1 st, dexp2 st)) ! 211: ! 212: app_exp : aexp (fn st => exp_start(aexp st, NONfix)) ! 213: | ident (fn st => exp_start(lookID ident, lookFIX ident)) ! 214: | app_exp aexp (fn st => exp_parse(app_exp st, aexp st, NONfix)) ! 215: | app_exp ident (fn st => exp_parse(app_exp st, lookID ident, ! 216: lookFIX ident)) ! 217: ! 218: aexp : OP ident (fn st=> lookID ident) ! 219: | IDDOT qid (fn st=> lookPath(IDDOT::qid,lookIDinStr)) ! 220: | INT (fn st => INTexp INT) ! 221: | REAL (fn st => REALexp REAL) ! 222: | STRING (fn st => STRINGexp STRING) ! 223: | HASH selector (fn st => SELECTORexp selector) ! 224: | LBRACE elabels RBRACE (fn st=> makeRECORDexp(elabels st)) ! 225: | LBRACE RBRACE (fn st=> RECORDexp nil) ! 226: | LPAREN RPAREN (fn st=> unitExp) ! 227: | LPAREN exp_ps RPAREN (fn st=> SEQexp(exp_ps st)) ! 228: | LPAREN exp_2c RPAREN (fn st=> TUPLEexp(exp_2c st)) ! 229: | LBRACKET exp_list RBRACKET (fn st=> LISTexp(exp_list st)) ! 230: | LBRACKET RBRACKET (fn st=> LISTexp nil) ! 231: | LET ldecs IN exp_ps END (fn st=> protect(protectScope,fn()=> ! 232: LETexp(ldecs([],st), ! 233: SEQexp(exp_ps st)))) ! 234: ! 235: exp_2c : exp COMMA exp_2c (fn st=> exp st :: exp_2c st) ! 236: | exp COMMA exp (fn st=> [exp1 st, exp2 st]) ! 237: ! 238: exp_list : exp (fn st=> [exp st]) ! 239: | exp COMMA exp_list (fn st=> exp st :: exp_list st) ! 240: ! 241: pat : pat AS pat (fn()=> layered(pat1(), pat2())) ! 242: | app_pat (fn()=> pat_finish(app_pat())) ! 243: | app_pat COLON ty (fn()=> CONSTRAINTpat(pat_finish(app_pat()),ty())) ! 244: ! 245: app_pat : apat (fn()=> pat_start(apat(), NONfix)) ! 246: | app_pat apat (fn()=> pat_parse(app_pat(),apat(), NONfix)) ! 247: | ID (pat_start_id ID) ! 248: | ASTERISK (pat_start_id ASTERISKsym) ! 249: | app_pat ID (pat_parse_id(app_pat,ID)) ! 250: | app_pat ASTERISK (pat_parse_id(app_pat,ASTERISKsym)) ! 251: ! 252: apat : OP ident (pat_id ident) ! 253: | IDDOT qid (fn()=>qid_pat(IDDOT::qid)) ! 254: | INT (fn()=>INTpat INT) ! 255: | REAL (fn()=>REALpat REAL) ! 256: | STRING (fn()=>STRINGpat STRING) ! 257: | WILD (fn()=>WILDpat) ! 258: | LPAREN RPAREN (fn()=>unitPat) ! 259: | LPAREN pat RPAREN (pat) ! 260: | LPAREN pat_2c RPAREN (fn()=>TUPLEpat(pat_2c())) ! 261: | LBRACKET RBRACKET (fn()=>LISTpat nil) ! 262: | LBRACKET pat_list RBRACKET (fn()=>LISTpat(pat_list())) ! 263: | LBRACE RBRACE (fn()=>makeRECORDpat(nil,false)) ! 264: | LBRACE plabels RBRACE (fn()=>makeRECORDpat(plabels())) ! 265: ! 266: plabel : selector EQUAL pat (fn()=> (selector,pat())) ! 267: | ID (fn()=> (ID, pat_id ID ())) ! 268: | ID AS pat (fn()=> (ID, LAYEREDpat(pat_id ID (), pat()))) ! 269: | ID COLON ty (fn()=> (ID, CONSTRAINTpat(pat_id ID(), ty()))) ! 270: | ID COLON ty AS pat (fn()=> (ID, LAYEREDpat(CONSTRAINTpat(pat_id ID(), ty()),pat()))) ! 271: ! 272: plabels : plabel COMMA plabels (fn()=>let val (a,(b,fx))=(plabel(),plabels()) ! 273: in (a::b, fx) ! 274: end) ! 275: | plabel (fn()=> ([plabel()],false)) ! 276: | DOTDOTDOT (fn()=> (nil, true)) ! 277: ! 278: pat_2c : pat COMMA pat_2c (fn()=> pat() :: pat_2c()) ! 279: | pat COMMA pat (fn()=>[pat1(), pat2()]) ! 280: ! 281: pat_list: pat (fn()=> [pat()]) ! 282: | pat COMMA pat_list (fn()=> pat() :: pat_list()) ! 283: ! 284: vb : vb AND vb (fn st=> vb1 st @ vb2 st) ! 285: | pat EQUAL exp (fn st=> protect(protectTyvars NONE, fn()=> ! 286: [valbind(pat(),exp st,currentTyvars())])) ! 287: ! 288: constraint : (fn()=>NONE) ! 289: | COLON ty (fn()=>SOME(ty())) ! 290: ! 291: rvb : opid constraint ! 292: EQUAL FN match (fn()=>[{name=opid,ty=constraint(),match=match}]) ! 293: | rvb AND rvb (fn()=> rvb1() @ rvb2()) ! 294: ! 295: ! 296: fb' : clause (fn()=>[clause()]) ! 297: | clause BAR fb' (fn()=>clause()::fb'()) ! 298: ! 299: fb : fb' (fn() => [checkFB(fb'())]) ! 300: | fb' AND fb (fn() => checkFB(fb'()) :: fb()) ! 301: ! 302: clause : app_pat constraint EQUAL exp (makeCLAUSE(app_pat,constraint,exp)) ! 303: ! 304: tb : tyvars ident EQUAL ty (makeTB(tyvars,ident,ty)) ! 305: | tb AND tb (fn nw => fn $ => tb1 nw $ @ tb2 nw $) ! 306: ! 307: tyvars : TYVAR ([mkTyvar(mkUBOUND TYVAR)]) ! 308: | LPAREN tyvar_pc RPAREN (tyvar_pc) ! 309: | (nil) ! 310: ! 311: tyvar_pc: TYVAR ([mkTyvar(mkUBOUND TYVAR)]) ! 312: | TYVAR COMMA tyvar_pc (mkTyvar(mkUBOUND TYVAR) :: tyvar_pc) ! 313: ! 314: db : db' AND db (fn $ => db' $ :: db $) ! 315: | db' (fn $ => [db' $]) ! 316: ! 317: db' : tyvars ident EQUAL constrs (makeDB'(tyvars,ident,constrs)) ! 318: ! 319: constrs : constr (fn t => [constr t]) ! 320: | constr BAR constrs (fn t => constr t :: constrs t) ! 321: ! 322: constr : optional_op ident (fn t=> (ident,true,t)) ! 323: | optional_op ident OF ty (fn t=> (ident,false, ! 324: CONty(arrowTycon,[ty(),t]))) ! 325: ! 326: eb : optional_op ident (makeEB ident) ! 327: | optional_op ident OF ty (makeEBof(ident,ty)) ! 328: | optional_op ident EQUAL qid (makeEBeq(ident,qid)) ! 329: | eb AND eb (fn()=> eb1() @ eb2()) ! 330: ! 331: qid_p : qid (fn()=> [getSTRpath qid]) ! 332: | qid qid_p (fn()=> getSTRpath qid :: qid_p()) ! 333: ! 334: ! 335: fixity : INFIX (infixleft 0) ! 336: | INFIX INT (infixleft INT) ! 337: | INFIXR (infixright 0) ! 338: | INFIXR INT (infixright INT) ! 339: | NONFIX (NONfix) ! 340: ! 341: ldec : VAL vb (makeVALdec vb) ! 342: | VAL REC rvb (makeVALRECdec rvb) ! 343: | FUN fb (makeFUNdec fb) ! 344: | TYPE tb (fn ps => TYPEdec(tb true ps)) ! 345: | DATATYPE db (makeDB(db, fn _ => fn _ => nil)) ! 346: | DATATYPE db WITHTYPE tb (makeDB(db, tb)) ! 347: | ABSTYPE db WITH ldecs END (makeABSTYPEdec(db,ldecs)) ! 348: | EXCEPTION eb (fn ps => EXCEPTIONdec(eb())) ! 349: | OPEN qid_p (makeOPENdec qid_p) ! 350: | fixity ops (makeFIXdec(fixity,ops)) ! 351: | OVERLOAD ident ! 352: COLON ty AS exp_pa (makeOVERLOADdec(ident,ty,exp_pa)) ! 353: ! 354: exp_pa : exp (fn st => [exp st]) ! 355: | exp AND exp_pa (fn st => exp st :: exp_pa st) ! 356: ! 357: ldecs : (fn $ => SEQdec nil) ! 358: | ldec ldecs (makeSEQdec(ldec,ldecs)) ! 359: | ldec SEMICOLON ldecs (fn $ => SEQdec nil) ! 360: | LOCAL ldecs IN ldecs END ldecs (makeSEQdec( ! 361: makeLOCALdec(ldecs1,ldecs2),ldecs3)) ! 362: ! 363: ops : ident ([ident]) ! 364: | ident ops (ident::ops) ! 365: ! 366: spec_s : (fn $ => nil) ! 367: | spec spec_s (fn $ => spec $ @ spec_s $) ! 368: | spec SEMICOLON spec_s (fn $ => spec $ @ spec_s $) ! 369: ! 370: spec : STRUCTURE strspec (strspec) ! 371: | DATATYPE db (make_dtyspec db) ! 372: | TYPE tyspec (tyspec NO) ! 373: | EQTYPE tyspec (tyspec YES) ! 374: | VAL valspec (valspec) ! 375: | EXCEPTION exnspec (exnspec) ! 376: | fixity ops (make_fixityspec(fixity,ops)) ! 377: | SHARING sharespec (sharespec) ! 378: | INCLUDE ident (make_includespec ident) ! 379: ! 380: strspec : strspec AND strspec (fn $ => strspec1 $ @ strspec2 $) ! 381: | ident COLON sign (make_strspec(ident,sign)) ! 382: ! 383: tyspec : tyspec AND tyspec (fn eq => fn $ => ! 384: tyspec1 eq $ @ tyspec2 eq $) ! 385: | tyvars ident (fn eq => make_tyspec(eq,tyvars,ident)) ! 386: ! 387: valspec : valspec AND valspec (fn $ => valspec1 $ @ valspec2 $) ! 388: | opid COLON ty (make_valspec(opid,ty)) ! 389: ! 390: exnspec : exnspec AND exnspec (fn $ => exnspec1 $ @ exnspec2 $) ! 391: | ident (make_exnspec ident) ! 392: | ident OF ty (make_exnspecOF (ident,ty)) ! 393: ! 394: sharespec: sharespec AND sharespec (fn $ => sharespec1 $ @ sharespec2 $) ! 395: | TYPE patheqn (make_type_sharespec patheqn) ! 396: | patheqn (make_str_sharespec patheqn) ! 397: ! 398: patheqn: qid EQUAL qid ([qid1,qid2]) ! 399: | qid EQUAL patheqn (qid :: patheqn) ! 400: ! 401: sign : ID (makeSIGid ID) ! 402: | SIG spec_s END (makeSIG spec_s) ! 403: ! 404: sigconstraint_op : (fn()=>NONE) ! 405: | COLON sign (fn()=>SOME(sign(1,Stampset.newStampsets()))) ! 406: ! 407: sigb : sigb AND sigb (fn()=> sigb1() @ sigb2()) ! 408: | ident EQUAL sign (make_sigb(ident,sign)) ! 409: ! 410: str : qid (make_str_qid qid) ! 411: | STRUCT sdecs END (make_str_struct sdecs) ! 412: | ID LPAREN sdecs RPAREN (make_str_app(ID,spread_args sdecs)) ! 413: | ID LPAREN str RPAREN (make_str_app(ID,single_arg str)) ! 414: | LET sdecs IN str END (make_str_let(sdecs,str)) ! 415: ! 416: sdecs : sdec sdecs (fn $ => sdec $ :: sdecs $) ! 417: | sdec SEMICOLON sdecs (fn $ => sdec $ :: sdecs $) ! 418: | LOCAL sdecs IN sdecs ! 419: END sdecs (fn $ =>makeLOCALsdecs(sdecs1,sdecs2) $ ! 420: @ sdecs $) ! 421: | (fn $ => nil) ! 422: ! 423: sdec : STRUCTURE strb (makeSTRBs(strb false)) ! 424: | ABSTRACTION strb (makeSTRBs(strb true)) ! 425: | SIGNATURE sigb (makeSIGdec sigb) ! 426: | FUNCTOR fctb (makeFCTdec fctb) ! 427: | ldec (fn (pa,_,st)=> ! 428: let val dec = ldec(pa,st) ! 429: in Typecheck.decType dec; dec ! 430: end) ! 431: ! 432: strb : ident sigconstraint_op ! 433: EQUAL str (makeSTRB(ident,sigconstraint_op,str)) ! 434: | strb AND strb (fn a => fn $ => strb1 a $ @ strb2 a $) ! 435: ! 436: fparam : ID COLON sign (single_formal(ID,sign)) ! 437: | spec_s (spread_formal spec_s) ! 438: ! 439: fctb : ident LPAREN fparam RPAREN ! 440: sigconstraint_op EQUAL str (makeFCTB(ident,fparam,sigconstraint_op,str)) ! 441: | fctb AND fctb (fn $ => fctb1 $ @ fctb2 $) ! 442: ! 443: importdec: STRING ([STRING]) ! 444: | STRING importdec (STRING :: importdec) ! 445: ! 446: interdec: sdec (fn()=> sdec([],Stampset.globalStamps)) ! 447: | IMPORT importdec (fn()=>IMPORTdec importdec) ! 448: | exp (fn()=>toplevelexp exp)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.