![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lexgen.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / lib / lexgen|
Return to lexgen.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / lib / lexgen |
1.1 ! root 1: (* Lexical analyzer generator for Standard ML. ! 2: Version 1.1, February 1989 ! 3: ! 4: Copyright (c) 1989 by Andrew W. Appel, James S. Mattson, David R. Tarditi ! 5: ! 6: This software comes with ABSOLUTELY NO WARRANTY. ! 7: This software is subject only to the PRINCETON STANDARD ML SOFTWARE LIBRARY ! 8: COPYRIGHT NOTICE, LICENSE AND DISCLAIMER, (in the file "COPYRIGHT", ! 9: distributed with this software). You may copy and distribute this software; ! 10: see the COPYRIGHT NOTICE for details and restrictions. ! 11: ! 12: Changes: ! 13: 7/25/89(drt): added %header declaration, code to place ! 14: user declarations at same level as makeLexer, etc. ! 15: This is needed for the parser generator. ! 16: ! 17: 10/89(awa): added %arg declaration (see lexgen.doc). ! 18: *) ! 19: ! 20: functor RedBlack(B : sig type key ! 21: val > : key*key->bool ! 22: end): ! 23: sig type tree ! 24: type key ! 25: val empty : tree ! 26: val insert : key * tree -> tree ! 27: val lookup : key * tree -> key ! 28: exception notfound of key ! 29: end = ! 30: struct ! 31: open B ! 32: datatype color = RED | BLACK ! 33: datatype tree = empty | tree of key * color * tree * tree ! 34: exception notfound of key ! 35: ! 36: fun insert (key,t) = ! 37: let fun f empty = tree(key,RED,empty,empty) ! 38: | f (tree(k,BLACK,l,r)) = ! 39: if key>k ! 40: then case f r ! 41: of r as tree(rk,RED, rl as tree(rlk,RED,rll,rlr),rr) => ! 42: (case l ! 43: of tree(lk,RED,ll,lr) => ! 44: tree(k,RED,tree(lk,BLACK,ll,lr), ! 45: tree(rk,BLACK,rl,rr)) ! 46: | _ => tree(rlk,BLACK,tree(k,RED,l,rll), ! 47: tree(rk,RED,rlr,rr))) ! 48: | r as tree(rk,RED,rl, rr as tree(rrk,RED,rrl,rrr)) => ! 49: (case l ! 50: of tree(lk,RED,ll,lr) => ! 51: tree(k,RED,tree(lk,BLACK,ll,lr), ! 52: tree(rk,BLACK,rl,rr)) ! 53: | _ => tree(rk,BLACK,tree(k,RED,l,rl),rr)) ! 54: | r => tree(k,BLACK,l,r) ! 55: else if k>key ! 56: then case f l ! 57: of l as tree(lk,RED,ll, lr as tree(lrk,RED,lrl,lrr)) => ! 58: (case r ! 59: of tree(rk,RED,rl,rr) => ! 60: tree(k,RED,tree(lk,BLACK,ll,lr), ! 61: tree(rk,BLACK,rl,rr)) ! 62: | _ => tree(lrk,BLACK,tree(lk,RED,ll,lrl), ! 63: tree(k,RED,lrr,r))) ! 64: | l as tree(lk,RED, ll as tree(llk,RED,lll,llr), lr) => ! 65: (case r ! 66: of tree(rk,RED,rl,rr) => ! 67: tree(k,RED,tree(lk,BLACK,ll,lr), ! 68: tree(rk,BLACK,rl,rr)) ! 69: | _ => tree(lk,BLACK,ll,tree(k,RED,lr,r))) ! 70: | l => tree(k,BLACK,l,r) ! 71: else tree(key,BLACK,l,r) ! 72: | f (tree(k,RED,l,r)) = ! 73: if key>k then tree(k,RED,l, f r) ! 74: else if k>key then tree(k,RED, f l, r) ! 75: else tree(key,RED,l,r) ! 76: in case f t ! 77: of tree(k,RED, l as tree(_,RED,_,_), r) => tree(k,BLACK,l,r) ! 78: | tree(k,RED, l, r as tree(_,RED,_,_)) => tree(k,BLACK,l,r) ! 79: | t => t ! 80: end ! 81: ! 82: ! 83: fun lookup (key,t) = ! 84: let fun look empty = raise (notfound key) ! 85: | look (tree(k,_,l,r)) = ! 86: if k>key then look l ! 87: else if key>k then look r ! 88: else k ! 89: in look t ! 90: end ! 91: ! 92: end ! 93: ! 94: signature LEXGEN = ! 95: sig ! 96: val lexGen: string -> unit ! 97: end ! 98: ! 99: structure LexGen: LEXGEN = ! 100: struct ! 101: ! 102: datatype token = CHARS of bool array | QMARK | STAR | PLUS | BAR ! 103: | LP | RP | CARAT | DOLLAR | SLASH | STATE of string list ! 104: | REPS of int * int | ID of string | ACTION of string ! 105: | BOF | EOF | ASSIGN | SEMI | ARROW | LEXMARK | LEXSTATES | ! 106: COUNT | REJECT | FULLCHARSET | STRUCT | HEADER | ARG ! 107: ! 108: datatype exp = EPS | CLASS of bool array * int | CLOSURE of exp ! 109: | ALT of exp * exp | CAT of exp * exp | TRAIL of int ! 110: | END of int ! 111: ! 112: (* flags describing input Lex spec. - unnecessary code is omitted *) ! 113: (* if possible *) ! 114: ! 115: val CharFormat = ref false; ! 116: val UsesTrailingContext = ref false; ! 117: val UsesPrevNewLine = ref false; ! 118: ! 119: (* flags for various bells & whistles that Lex has. These slow the ! 120: lexer down and should be omitted from production lexers (if you ! 121: really want speed) *) ! 122: ! 123: val CountNewLines = ref false; ! 124: val HaveReject = ref false; ! 125: ! 126: (* Can increase size of character set *) ! 127: ! 128: val CharSetSize = ref 128; ! 129: ! 130: (* Can name structure or declare header code *) ! 131: ! 132: val StrName = ref "Mlex" ! 133: val HeaderCode = ref "" ! 134: val HeaderDecl = ref false ! 135: val ArgCode = ref (NONE: string option) ! 136: val StrDecl = ref false ! 137: ! 138: val ResetFlags = fn () => (CountNewLines := false; HaveReject := false; ! 139: CharSetSize := 128; StrName := "Mlex"; ! 140: HeaderCode := ""; HeaderDecl:= false; ! 141: ArgCode := NONE; ! 142: StrDecl := false) ! 143: ! 144: val LexOut = ref(std_out); ! 145: val say = fn x => output (!LexOut) x ! 146: ! 147: (* Union: merge two sorted lists of integers *) ! 148: ! 149: fun union(a,b) = let val rec merge = fn ! 150: (nil,nil,z) => z ! 151: | (nil,el::more,z) => merge(nil,more,el::z) ! 152: | (el::more,nil,z) => merge(more,nil,el::z) ! 153: | (x::morex,y::morey,z) => if (x:int)=(y:int) ! 154: then merge(morex,morey,x::z) ! 155: else if x>y then merge(morex,y::morey,x::z) ! 156: else merge(x::morex,morey,y::z) ! 157: in merge(rev a,rev b,nil) ! 158: end ! 159: ! 160: (* Nullable: compute if a important expression parse tree node is nullable *) ! 161: ! 162: val rec nullable = fn ! 163: EPS => true ! 164: | CLASS(_) => false ! 165: | CLOSURE(_) => true ! 166: | ALT(n1,n2) => nullable(n1) orelse nullable(n2) ! 167: | CAT(n1,n2) => nullable(n1) andalso nullable(n2) ! 168: | TRAIL(_) => true ! 169: | END(_) => false ! 170: ! 171: (* FIRSTPOS: firstpos function for parse tree expressions *) ! 172: ! 173: and firstpos = fn ! 174: EPS => nil ! 175: | CLASS(_,i) => [i] ! 176: | CLOSURE(n) => firstpos(n) ! 177: | ALT(n1,n2) => union(firstpos(n1),firstpos(n2)) ! 178: | CAT(n1,n2) => if nullable(n1) then union(firstpos(n1),firstpos(n2)) ! 179: else firstpos(n1) ! 180: | TRAIL(i) => [i] ! 181: | END(i) => [i] ! 182: ! 183: (* LASTPOS: Lastpos function for parse tree expressions *) ! 184: ! 185: and lastpos = fn ! 186: EPS => nil ! 187: | CLASS(_,i) => [i] ! 188: | CLOSURE(n) => lastpos(n) ! 189: | ALT(n1,n2) => union(lastpos(n1),lastpos(n2)) ! 190: | CAT(n1,n2) => if nullable(n2) then union(lastpos(n1),lastpos(n2)) ! 191: else lastpos(n2) ! 192: | TRAIL(i) => [i] ! 193: | END(i) => [i] ! 194: ; ! 195: ! 196: (* ++: Increment an integer reference *) ! 197: ! 198: fun ++(x) : int = (x := !x + 1; !x); ! 199: ! 200: structure dict = ! 201: struct ! 202: type 'a relation = 'a * 'a -> bool ! 203: abstype ('b,'a) dictionary = DATA of { Table : ('b * 'a) list, ! 204: Leq : 'b * 'b -> bool } ! 205: with ! 206: exception LOOKUP ! 207: fun create Leqfunc = DATA { Table = nil, Leq = Leqfunc } ! 208: fun lookup (DATA { Table = entrylist, Leq = leq }) key = ! 209: let fun search [] = raise LOOKUP ! 210: | search((k,item)::entries) = ! 211: if leq(key,k) ! 212: then if leq(k,key) then item else raise LOOKUP ! 213: else search entries ! 214: in search entrylist ! 215: end ! 216: fun enter (DATA { Table = entrylist, Leq = leq }) ! 217: (newentry as (key : 'b,item :'a)) : ('b,'a) dictionary = ! 218: let val gt = fn a => fn b => not (leq(a,b)) ! 219: val eq = fn k => fn k' => (leq(k,k')) andalso (leq(k',k)) ! 220: fun update nil = [ newentry ] ! 221: | update ((entry as (k,_))::entries) = ! 222: if (eq key k) then newentry::entries ! 223: else if gt k key then newentry::(entry::entries) ! 224: else entry::(update entries) ! 225: in DATA { Table = update entrylist, Leq = leq } ! 226: end ! 227: fun listofdict (DATA { Table = entrylist,Leq = leq}) = ! 228: let fun f (nil,r) = rev r ! 229: | f (a::b,r) = f (b,a::r) ! 230: in f(entrylist,nil) ! 231: end ! 232: end ! 233: end ! 234: ! 235: open dict; ! 236: ! 237: (* INPUT.ML : Input w/ one character push back capability *) ! 238: ! 239: val LineNum = ref 1; ! 240: ! 241: abstype ibuf = ! 242: BUF of instream * {b : string ref, p : int ref} ! 243: with ! 244: fun make_ibuf(s) = BUF (s, {b=ref"", p = ref 0}) ! 245: fun close_ibuf (BUF (s,_)) = close_in(s) ! 246: exception eof ! 247: fun getch (a as (BUF(s,{b,p}))) = ! 248: if (!p = (size (!b))) ! 249: then (b := input s (max(1,min(1024,can_input s))); ! 250: p := 0; ! 251: if (size (!b))=0 ! 252: then raise eof ! 253: else getch a) ! 254: else (let val ch = substring(!b,!p,1) ! 255: in (if ch = "\n" ! 256: then LineNum := !LineNum + 1 ! 257: else (); ! 258: p := !p + 1; ! 259: ch) ! 260: end) ! 261: fun ungetch(BUF(s,{b,p})) = ( ! 262: if substring(!b,!p,1) = "\n" ! 263: then LineNum := !LineNum - 1 ! 264: else (); ! 265: p := !p - 1) ! 266: end; ! 267: ! 268: exception error ! 269: ! 270: val pr_err = fn x => (output std_out ("mlex: syntax error in line "^ ! 271: (makestring (!LineNum))^ ! 272: ": "^x^"\n"); raise error) ! 273: ! 274: exception syntax_error; (* error in user's input file *) ! 275: ! 276: exception lex_error; (* unexpected error in lexer *) ! 277: ! 278: val LexBuf = ref(make_ibuf(std_in)); ! 279: val LexState = ref 0; ! 280: val NextTok = ref BOF; ! 281: val inquote = ref false; ! 282: ! 283: fun AdvanceTok () : unit = ! 284: ! 285: let fun isletter(x:string) = x>="a" andalso x<="z" orelse x>="A" andalso x<="Z"; ! 286: fun isdigit(x:string) = x>="0" andalso x<="9"; ! 287: (* check for valid (non-leading) identifier character (added by JHR) *) ! 288: fun isidentchr c = ( ! 289: (isletter c) orelse (isdigit c) orelse (c = "_") orelse (c = "'")) ! 290: fun atoi(s:string) : int = ! 291: let val rec num = fn ! 292: (x::y,n) => if isdigit(x) then num(y,10*n+ord(x)-(ord "0")) else n ! 293: | (_,n) => n ! 294: in num(explode(s),0) ! 295: end; ! 296: ! 297: val rec skipws = fn () => case nextch() of ! 298: " " => skipws() ! 299: | "\t" => skipws() ! 300: | "\n" => skipws() ! 301: | x => x ! 302: ! 303: and nextch = fn () => getch(!LexBuf) ! 304: ! 305: and escaped = fn () => case nextch() of ! 306: "b" => "\008" ! 307: | "n" => "\n" ! 308: | "t" => "\t" ! 309: | x => ! 310: let fun f(n,c,t) = ! 311: if c=3 then ! 312: if n>= (!CharSetSize) then ! 313: pr_err("illegal ascii escape '"^t^"'") ! 314: else chr n ! 315: else let val ch=nextch() ! 316: in if isdigit ch then ! 317: f(n*10+(ord ch)-(ord "0"),c+1,t^ch) ! 318: else pr_err("illegal ascii escape '"^t^"'") ! 319: end ! 320: in if isdigit x then ! 321: f((ord x)-ord("0"),1,x) ! 322: else x ! 323: end ! 324: ! 325: and onechar = fn x => let val c = array(!CharSetSize,false) in ! 326: update(c,ord(x),true); CHARS(c) ! 327: end ! 328: ! 329: in case !LexState of 0 => let val makeTok = fn () => ! 330: case skipws() of ! 331: (* Lex % operators *) ! 332: "%" => (case nextch() of ! 333: "%" => LEXMARK ! 334: | a => let fun f s = ! 335: let val a = nextch() ! 336: in if isletter a then f(a::s) ! 337: else (ungetch(!LexBuf); ! 338: implode(rev s)) ! 339: end ! 340: val command = f [a] ! 341: in if command = "reject" then REJECT ! 342: else if command = "count" then COUNT ! 343: else if command = "full" then FULLCHARSET ! 344: else if command = "s" then LEXSTATES ! 345: else if command = "S" then LEXSTATES ! 346: else if command = "structure" then STRUCT ! 347: else if command = "header" then HEADER ! 348: else if command = "arg" then ARG ! 349: else pr_err "unknown % operator " ! 350: end ! 351: ) ! 352: (* semicolon (for end of LEXSTATES) *) ! 353: | ";" => SEMI ! 354: (* anything else *) ! 355: | ch => if isletter(ch) then ! 356: let fun getID matched = ! 357: let val x = nextch() ! 358: (**** fix by JHR ! 359: in if isletter(x) orelse isdigit(x) orelse ! 360: x = "_" orelse x = "'" ! 361: ****) ! 362: in if (isidentchr x) ! 363: then getID (x::matched) ! 364: else (ungetch(!LexBuf); implode(rev matched)) ! 365: end ! 366: in ID(getID [ch]) ! 367: end ! 368: else (pr_err ("bad character: " ^ ch)) ! 369: in NextTok := makeTok() ! 370: end ! 371: | 1 => let val rec makeTok = fn () => ! 372: if !inquote then case nextch() of ! 373: (* inside quoted string *) ! 374: "\\" => onechar(escaped()) ! 375: | "\"" => (inquote := false; makeTok()) ! 376: | x => onechar(x) ! 377: else case skipws() of ! 378: (* single character operators *) ! 379: "?" => QMARK ! 380: | "*" => STAR ! 381: | "+" => PLUS ! 382: | "|" => BAR ! 383: | "(" => LP ! 384: | ")" => RP ! 385: | "^" => CARAT ! 386: | "$" => DOLLAR ! 387: | "/" => SLASH ! 388: | ";" => SEMI ! 389: | "." => let val c = array(!CharSetSize,true) in ! 390: update(c,10,false); CHARS(c) ! 391: end ! 392: (* assign and arrow *) ! 393: | "=" => let val c = nextch() in ! 394: if c=">" then ARROW else (ungetch(!LexBuf); ASSIGN) ! 395: end ! 396: (* character set *) ! 397: | "[" => let val rec classch = fn () => let val x = skipws() ! 398: in if x="\\" then escaped() else x ! 399: end; ! 400: val first = classch(); ! 401: val flag = (first<>"^"); ! 402: val c = array(!CharSetSize,not flag); ! 403: val rec add = fn x => if x="" then () ! 404: else update(c,ord(x),flag) ! 405: and range = fn (x,y) => ! 406: if x>y then (pr_err "bad char. range") ! 407: else let val i = ref(ord(x)) and j = ord(y) ! 408: in while !i<=j do (add(chr(!i)); i := !i + 1) ! 409: end ! 410: and getClass = fn (last) => case classch() of ! 411: "]" => (add(last); c) ! 412: | "-" => if last<>"" then ! 413: let val x = classch() in ! 414: if x="]" then (add(last);add("-"); c) ! 415: else (range(last,x);getClass("")) ! 416: end ! 417: else getClass("-") ! 418: | x => (add(last); getClass(x)) ! 419: in CHARS(getClass(if first="^" then "" else first)) ! 420: end ! 421: (* Start States specification *) ! 422: | "<" => let val rec get_state = fn (prev,matched) => ! 423: case nextch() of ! 424: ">" => matched::prev ! 425: | "," => get_state(matched::prev,"") ! 426: | x => if isletter(x) then get_state(prev,matched^x) ! 427: else (pr_err "bad start state list") ! 428: in STATE(get_state(nil,"")) ! 429: end ! 430: (* {id} or repititions *) ! 431: | "{" => let val ch = nextch() in if isletter(ch) then ! 432: let val rec getID = fn (matched) => ! 433: case nextch() of ! 434: "}" => matched ! 435: (**** fix by JHR ! 436: | x => if isletter(x) orelse isdigit(x) then ! 437: ****) ! 438: | x => if (isidentchr x) then ! 439: getID(matched^x) ! 440: else (pr_err "invalid char. class name") ! 441: in ID(getID(ch)) ! 442: end ! 443: else if isdigit(ch) then ! 444: let val rec get_r = fn ! 445: (matched,r1) => case nextch() of ! 446: "}" => let val n = atoi(matched) in ! 447: if r1 = ~1 then (n,n) else (r1,n) ! 448: end ! 449: | "," => if r1 = ~1 then get_r("",atoi(matched)) ! 450: else (pr_err "invalid repetitions spec.") ! 451: | x => if isdigit(x) then get_r(matched^x,r1) ! 452: else (pr_err "invalid char in repetitions spec") ! 453: in REPS(get_r(ch,~1)) ! 454: end ! 455: else (pr_err "bad repetitions spec") ! 456: end ! 457: (* Lex % operators *) ! 458: | "%" => if nextch() = "%" then LEXMARK else ! 459: (ungetch(!LexBuf); onechar ("%")) ! 460: (* backslash escape *) ! 461: | "\\" => onechar(escaped()) ! 462: (* start quoted string *) ! 463: | "\"" => (inquote := true; makeTok()) ! 464: (* anything else *) ! 465: | ch => onechar(ch) ! 466: in NextTok := makeTok() ! 467: end ! 468: | 2 => NextTok := ! 469: (case skipws() ! 470: of "(" => let fun GetAct (lpct,x) = ! 471: case getch(!LexBuf) ! 472: of "(" => GetAct (lpct+1,"("::x) ! 473: | ")" => if lpct = 0 then (implode (rev x)) ! 474: else GetAct(lpct-1,")"::x) ! 475: | y => GetAct(lpct,y::x) ! 476: in ACTION (GetAct (0,nil)) ! 477: end ! 478: | ";" => SEMI ! 479: | c => (pr_err ("invalid character "^c))) ! 480: | _ => raise lex_error ! 481: end ! 482: handle eof => NextTok := EOF ; ! 483: ! 484: fun GetTok (_:unit) : token = ! 485: let val t = !NextTok in AdvanceTok(); t ! 486: end; ! 487: val SymTab = ref (create String.<=) : (string,exp) dictionary ref ! 488: ! 489: fun GetExp () : exp = ! 490: ! 491: let val rec optional = fn e => ALT(EPS,e) ! 492: ! 493: and newline = fn () => let val c = array(!CharSetSize,false) in ! 494: update(c,10,true); c ! 495: end ! 496: ! 497: and endline = fn e => trail(e,CLASS(newline(),0)) ! 498: ! 499: and trail = fn (e1,e2) => CAT(CAT(e1,TRAIL(0)),e2) ! 500: ! 501: and closure1 = fn e => CAT(e,CLOSURE(e)) ! 502: ! 503: and repeat = fn (min,max,e) => let val rec rep = fn ! 504: (0,0) => EPS ! 505: | (0,1) => ALT(e,EPS) ! 506: | (0,i) => CAT(rep(0,1),rep(0,i-1)) ! 507: | (i,j) => CAT(e,rep(i-1,j-1)) ! 508: in rep(min,max) ! 509: end ! 510: ! 511: and exp0 = fn () => case GetTok() of ! 512: CHARS(c) => exp1(CLASS(c,0)) ! 513: | LP => let val e = exp0() in ! 514: if !NextTok = RP then ! 515: (AdvanceTok(); exp1(e)) ! 516: else (pr_err "missing '('") end ! 517: | ID(name) => exp1(lookup(!SymTab)(name)) ! 518: | _ => raise syntax_error ! 519: ! 520: and exp1 = fn (e) => case !NextTok of ! 521: SEMI => e ! 522: | ARROW => e ! 523: | EOF => e ! 524: | LP => exp2(e,exp0()) ! 525: | RP => e ! 526: | t => (AdvanceTok(); case t of ! 527: QMARK => exp1(optional(e)) ! 528: | STAR => exp1(CLOSURE(e)) ! 529: | PLUS => exp1(closure1(e)) ! 530: | CHARS(c) => exp2(e,CLASS(c,0)) ! 531: | BAR => ALT(e,exp0()) ! 532: | DOLLAR => endline(e) ! 533: | SLASH => trail(e,exp0()) ! 534: | REPS(i,j) => exp1(repeat(i,j,e)) ! 535: | ID(name) => exp2(e,lookup(!SymTab)(name)) ! 536: | _ => raise syntax_error) ! 537: ! 538: and exp2 = fn (e1,e2) => case !NextTok of ! 539: SEMI => CAT(e1,e2) ! 540: | ARROW => CAT(e1,e2) ! 541: | EOF => CAT(e1,e2) ! 542: | LP => exp2(CAT(e1,e2),exp0()) ! 543: | RP => CAT(e1,e2) ! 544: | t => (AdvanceTok(); case t of ! 545: QMARK => exp1(CAT(e1,optional(e2))) ! 546: | STAR => exp1(CAT(e1,CLOSURE(e2))) ! 547: | PLUS => exp1(CAT(e1,closure1(e2))) ! 548: | CHARS(c) => exp2(CAT(e1,e2),CLASS(c,0)) ! 549: | BAR => ALT(CAT(e1,e2),exp0()) ! 550: | DOLLAR => endline(CAT(e1,e2)) ! 551: | SLASH => trail(CAT(e1,e2),exp0()) ! 552: | REPS(i,j) => exp1(CAT(e1,repeat(i,j,e2))) ! 553: | ID(name) => exp2(CAT(e1,e2),lookup(!SymTab)(name)) ! 554: | _ => raise syntax_error) ! 555: in exp0() ! 556: end; ! 557: val StateTab = ref(create(String.<=)) : (string,int) dictionary ref ! 558: ! 559: val StateNum = ref 0; ! 560: ! 561: fun GetStates () : int list = ! 562: ! 563: let fun add nil sl = sl ! 564: | add (x::y) sl = add y (union ([lookup (!StateTab)(x)],sl)) ! 565: ! 566: fun addall i sl = ! 567: if i <= !StateNum then addall (i+2) (union ([i],sl)) ! 568: else sl ! 569: ! 570: fun incall (x::y) = (x+1)::incall y ! 571: | incall nil = nil ! 572: ! 573: fun addincs nil = nil ! 574: | addincs (x::y) = x::(x+1)::addincs y ! 575: ! 576: val state_list = ! 577: case !NextTok of ! 578: STATE s => (AdvanceTok(); LexState := 1; add s nil) ! 579: | _ => addall 1 nil ! 580: ! 581: in case !NextTok ! 582: of CARAT => (LexState := 1; AdvanceTok(); UsesPrevNewLine := true; ! 583: incall state_list) ! 584: | _ => addincs state_list ! 585: end ! 586: ! 587: val LeafNum = ref ~1; ! 588: ! 589: fun renum(e : exp) : exp = ! 590: let val rec label = fn ! 591: EPS => EPS ! 592: | CLASS(x,_) => CLASS(x,++LeafNum) ! 593: | CLOSURE(e) => CLOSURE(label(e)) ! 594: | ALT(e1,e2) => ALT(label(e1),label(e2)) ! 595: | CAT(e1,e2) => CAT(label(e1),label(e2)) ! 596: | TRAIL(i) => TRAIL(++LeafNum) ! 597: | END(i) => END(++LeafNum) ! 598: in label(e) ! 599: end; ! 600: ! 601: exception parse_error; ! 602: ! 603: fun parse() : (string * (int list * exp) list * ((string,string) dictionary)) = ! 604: let val Accept = ref (create String.<=) : (string,string) dictionary ref ! 605: val rec ParseRtns = fn l => case getch(!LexBuf) of ! 606: "%" => let val c = getch(!LexBuf) in ! 607: if c="%" then (implode (rev l)) ! 608: else ParseRtns(c::"%"::l) ! 609: end ! 610: | c => ParseRtns(c::l) ! 611: and ParseDefs = fn () => ! 612: (LexState:=0; AdvanceTok(); case !NextTok of ! 613: LEXMARK => () ! 614: | LEXSTATES => ! 615: let fun f () = (case !NextTok of (ID i) => ! 616: (StateTab := enter(!StateTab)(i,++StateNum); ! 617: ++StateNum; AdvanceTok(); f()) ! 618: | _ => ()) ! 619: in AdvanceTok(); f (); ! 620: if !NextTok=SEMI then ParseDefs() else ! 621: (pr_err "expected ';'") ! 622: end ! 623: | ID x => (LexState:=1; AdvanceTok(); if GetTok() = ASSIGN ! 624: then (SymTab := enter(!SymTab)(x,GetExp()); ! 625: if !NextTok = SEMI then ParseDefs() ! 626: else (pr_err "expected ';'")) ! 627: else raise syntax_error) ! 628: | REJECT => (HaveReject := true; ParseDefs()) ! 629: | COUNT => (CountNewLines := true; ParseDefs()) ! 630: | FULLCHARSET => (CharSetSize := 256; ParseDefs()) ! 631: | HEADER => (LexState := 2; AdvanceTok(); ! 632: case GetTok() ! 633: of ACTION s => ! 634: if (!StrDecl) then ! 635: (pr_err "cannot have both %s and %header \ ! 636: \declarations") ! 637: else if (!HeaderDecl) then ! 638: (pr_err "duplicate %header declarations") ! 639: else ! 640: (HeaderCode := s; LexState := 0; ! 641: HeaderDecl := true; ParseDefs()) ! 642: | _ => raise syntax_error) ! 643: | ARG => (LexState := 2; AdvanceTok(); ! 644: case GetTok() ! 645: of ACTION s => ! 646: (case !ArgCode ! 647: of SOME _ => pr_err "duplicate %arg declarations" ! 648: | NONE => ArgCode := SOME s; ! 649: LexState := 0; ! 650: ParseDefs()) ! 651: | _ => raise syntax_error) ! 652: | STRUCT => (AdvanceTok(); ! 653: case !NextTok of ! 654: (ID i) => ! 655: if (!HeaderDecl) then ! 656: (pr_err "cannot have both %s and %header \ ! 657: \declarations") ! 658: else if (!StrDecl) then ! 659: (pr_err "duplicate %s declarations") ! 660: else StrName := i ! 661: | _ => (pr_err "expected ID"); ! 662: ParseDefs()) ! 663: | _ => raise syntax_error) ! 664: and ParseRules = ! 665: fn rules => (LexState:=1; AdvanceTok(); case !NextTok of ! 666: LEXMARK => rules ! 667: | EOF => rules ! 668: | _ => ! 669: let val s = GetStates() ! 670: val e = renum(CAT(GetExp(),END(0))) ! 671: in ! 672: if !NextTok = ARROW then ! 673: (LexState:=2; AdvanceTok(); ! 674: case GetTok() of ACTION(act) => ! 675: if !NextTok=SEMI then ! 676: (Accept:=enter(!Accept) (makestring (!LeafNum),act); ! 677: ParseRules((s,e)::rules)) ! 678: else (pr_err "expected ';'") ! 679: | _ => raise syntax_error) ! 680: else (pr_err "expected '=>'") ! 681: end) ! 682: in let val usercode = ParseRtns nil ! 683: in (ParseDefs(); (usercode,ParseRules(nil),!Accept)) ! 684: end ! 685: end handle syntax_error => (pr_err "") ! 686: ! 687: fun makebegin () : unit = ! 688: let fun make nil = () ! 689: | make ((x,n:int)::y)=(say "val "; say x; say " = " ; ! 690: say "STARTSTATE "; ! 691: say (makestring n); say ";\n"; make y) ! 692: in say "\n(* start state definitions *)\n\n"; make(listofdict(!StateTab)) ! 693: end ! 694: ! 695: structure L = ! 696: struct ! 697: nonfix > ! 698: type key = int list * string ! 699: fun > ((key,item:string),(key',item')) = ! 700: let fun f ((a:int)::a') (b::b') = if Integer.> (a,b) then true ! 701: else if a=b then f a' b' ! 702: else false ! 703: | f _ _ = false ! 704: in f key key' ! 705: end ! 706: end ! 707: ! 708: structure RB = RedBlack(L) ! 709: ! 710: fun maketable (fins:(int * (int list)) list, ! 711: tcs :(int * (int list)) list, ! 712: tcpairs: (int * int) list, ! 713: trans : (int*(int list)) list) : unit = ! 714: ! 715: (* Fins = (state #, list of final leaves for the state) list ! 716: tcs = (state #, list of trailing context leaves which begin in this state) ! 717: list ! 718: tcpairs = (trailing context leaf, end leaf) list ! 719: trans = (state #,list of transitions for state) list *) ! 720: ! 721: let datatype elem = N of int | T of int | D of int ! 722: val count = ref 0 ! 723: val _ = (if length(trans)<256 then CharFormat := true ! 724: else CharFormat := false; ! 725: if length(tcpairs)> 0 then ! 726: (UsesTrailingContext := true; ! 727: say "\ndatatype yyfinstate = N of int | \ ! 728: \ T of int | D of int\n") ! 729: else (UsesTrailingContext := false; ! 730: say "\ndatatype yyfinstate = N of int"); ! 731: say "\ntype statedata = {fin : yyfinstate list, trans: "; ! 732: case !CharFormat of ! 733: true => say "string}" ! 734: | false => say "int array}"; ! 735: say "\n(* transition & final state table *)\nval tab = let\n") ! 736: val newfins = ! 737: let fun IsEndLeaf t = ! 738: let fun f ((l,e)::r) = if (e=t) then true else f r ! 739: | f nil = false in f tcpairs end ! 740: ! 741: fun GetEndLeaf t = ! 742: let fun f ((tl,el)::r) = if (tl=t) then el else f r ! 743: in f tcpairs ! 744: end ! 745: fun GetTrConLeaves s = ! 746: let fun f ((s',l)::r) = if (s = s') then l else f r ! 747: | f nil = nil ! 748: in f tcs ! 749: end ! 750: fun sort_leaves s = ! 751: let fun insert (x:int) (a::b) = ! 752: if (x <= a) then x::(a::b) ! 753: else a::(insert x b) ! 754: | insert x nil = [x] ! 755: in fold (fn (x,r) => insert x r) s nil ! 756: end ! 757: fun conv a = if (IsEndLeaf a) then (D a) else (N a) ! 758: fun merge (a::a',b::b') = ! 759: if (a <= b) then (conv a)::merge(a',b::b') ! 760: else (T b)::(merge(a::a',b')) ! 761: | merge (a::a',nil) = (conv a)::(merge (a',nil)) ! 762: | merge (nil,b::b') = (T b)::(merge (b',nil)) ! 763: | merge (nil,nil) = nil ! 764: ! 765: in map (fn (x,l) => ! 766: rev (merge (l, ! 767: sort_leaves (map (fn x => GetEndLeaf x) (GetTrConLeaves x))))) ! 768: fins ! 769: end ! 770: ! 771: val rs = ! 772: let open RB ! 773: fun makeItems x = ! 774: let fun MakeList(nil,i) = () ! 775: | MakeList([(x:int)],i) = say (makestring x) ! 776: | MakeList(x::tl,16) = ! 777: (say "\n"; say (makestring x); say ","; MakeList(tl,1)) ! 778: | MakeList(x::tl,i) = ! 779: (say (makestring x); say ","; MakeList(tl,i+1)) ! 780: fun MakeString(nil,i) = () ! 781: | MakeString(((x:int)::tl),i) = ! 782: let val x = (makestring x) ! 783: val x' = (case size x of ! 784: 1 => "00" ^ x | 2 => "0" ^ x | 3 => x) ! 785: in if i=16 ! 786: then (say "\\\n\\\\"; say x'; MakeString(tl,1)) ! 787: else (say "\\"; say x'; MakeString(tl,i+1)) ! 788: end ! 789: in case !CharFormat of ! 790: true => (say " =\n\""; MakeString(x,0); say "\"\n") ! 791: | false => (say " = arrayoflist\n["; MakeList(x,0); say "]\n") ! 792: end ! 793: fun makeEntry(nil,rs,t) = rev rs ! 794: | makeEntry(((l:int,x)::y),rs,t) = ! 795: let val name = "s" ^ (makestring l) ! 796: in let val (r,n) = lookup ((x,name),t) ! 797: in makeEntry(y,(n::rs),t) ! 798: end handle notfound _ => (count := !count+1; ! 799: say "val "; say name; makeItems x; ! 800: makeEntry(y,(name::rs),(insert ((x,name),t)))) ! 801: end ! 802: in (makeEntry(trans,nil,empty)) ! 803: end ! 804: ! 805: fun makeTable(nil,nil) = () ! 806: | makeTable(a::a',b::b') = ! 807: let fun makeItems nil = () ! 808: | makeItems (hd::tl) = ! 809: let val (t,n) = ! 810: case hd of ! 811: (N i) => ("(N ",i) ! 812: | (T i) => ("(T ",i) ! 813: | (D i) => ("(D ",i) ! 814: in (say t; say (makestring n); say ")"; ! 815: if null tl ! 816: then () ! 817: else (say ","; makeItems tl)) ! 818: end ! 819: in (say "{fin = ["; makeItems b; ! 820: say "], trans = "; say a; say "}"; ! 821: if null a' ! 822: then () ! 823: else (say ",\n"; makeTable(a',b'))) ! 824: end ! 825: ! 826: fun msg x = output std_out x ! 827: ! 828: in (say "in arrayoflist\n["; makeTable(rs,newfins); say "]\nend\n"; ! 829: msg ("\nNumber of states = " ^ (makestring (length trans))); ! 830: msg ("\nNumber of distinct rows = " ^ (makestring (!count))); ! 831: msg ("\nApprox. memory size of trans. table = " ^ ! 832: (makestring (!count*(!CharSetSize)*(if !CharFormat then 1 else 8)))); ! 833: msg " bytes\n") ! 834: end ! 835: ! 836: (* makeaccept: Takes a (string,string) dictionary, prints case statement for ! 837: accepting leaf actions. The key strings are the leaf #'s, the data strings ! 838: are the actions *) ! 839: ! 840: fun makeaccept ends = ! 841: let fun startline f = if f then say " " else say "| " ! 842: fun make(nil,f) = (startline f; say "_ => raise Internal.LexerError\n") ! 843: | make((x,a)::y,f) = (startline f; say x; say " => ("; ! 844: say a; say ")\n"; make(y,false)) ! 845: in make (listofdict(ends),true) ! 846: end ! 847: ! 848: fun leafdata(e:(int list * exp) list) = ! 849: let val fp = array(!LeafNum + 1,nil) ! 850: and leaf = array(!LeafNum + 1,EPS) ! 851: and tcpairs = ref nil ! 852: and trailmark = ref ~1; ! 853: val rec add = fn ! 854: (nil,x) => () ! 855: | (hd::tl,x) => (update(fp,hd,union(fp sub hd,x)); ! 856: add(tl,x)) ! 857: and moredata = fn ! 858: CLOSURE(e1) => ! 859: (moredata(e1); add(lastpos(e1),firstpos(e1))) ! 860: | ALT(e1,e2) => (moredata(e1); moredata(e2)) ! 861: | CAT(e1,e2) => (moredata(e1); moredata(e2); ! 862: add(lastpos(e1),firstpos(e2))) ! 863: | CLASS(x,i) => update(leaf,i,CLASS(x,i)) ! 864: | TRAIL(i) => (update(leaf,i,TRAIL(i)); if !trailmark = ~1 ! 865: then trailmark := i else ()) ! 866: | END(i) => (update(leaf,i,END(i)); if !trailmark <> ~1 ! 867: then (tcpairs := (!trailmark,i)::(!tcpairs); ! 868: trailmark := ~1) else ()) ! 869: | _ => () ! 870: and makedata = fn ! 871: nil => () ! 872: | (_,x)::tl => (moredata(x);makedata(tl)) ! 873: in trailmark := ~1; makedata(e); (fp,leaf,!tcpairs) ! 874: end; ! 875: ! 876: fun makedfa(rules) = ! 877: let val StateTab = ref (create(String.<=)) : (string,int) dictionary ref ! 878: val fintab = ref (create(Integer.<=)) : (int,(int list)) dictionary ref ! 879: val transtab = ref (create(Integer.<=)) : (int,int list) dictionary ref ! 880: val tctab = ref (create(Integer.<=)) : (int,(int list)) dictionary ref ! 881: val (fp, leaf, tcpairs) = leafdata(rules); ! 882: ! 883: fun visit (state,statenum) = ! 884: let val transitions = gettrans(state) in ! 885: fintab := enter(!fintab)(statenum,getfin(state)); ! 886: tctab := enter(!tctab)(statenum,gettc(state)); ! 887: transtab := enter(!transtab)(statenum,transitions) ! 888: end ! 889: ! 890: and visitstarts (states) = ! 891: let fun vs nil i = () ! 892: | vs (hd::tl) i = (visit (hd,i); vs tl (i+1)) ! 893: in vs states 0 ! 894: end ! 895: ! 896: and hashstate(s: int list) = ! 897: let val rec hs = ! 898: fn (nil,z) => z ! 899: | ((x:int)::y,z) => hs(y,z ^ " " ^ (makestring x)) ! 900: in hs(s,"") ! 901: end ! 902: ! 903: and find(s) = lookup(!StateTab)(hashstate(s)) ! 904: ! 905: and add(s,n) = StateTab := enter(!StateTab)(hashstate(s),n) ! 906: ! 907: and getstate (state) = ! 908: find(state) ! 909: handle LOOKUP => let val n = ++StateNum in ! 910: add(state,n); visit(state,n); n ! 911: end ! 912: ! 913: and getfin state = ! 914: let fun f nil fins = fins ! 915: | f (hd::tl) fins = ! 916: case (leaf sub hd) ! 917: of END _ => f tl (hd::fins) ! 918: | _ => f tl fins ! 919: in f state nil ! 920: end ! 921: ! 922: and gettc state = ! 923: let fun f nil fins = fins ! 924: | f (hd::tl) fins = ! 925: case (leaf sub hd) ! 926: of TRAIL _ => f tl (hd::fins) ! 927: | _ => f tl fins ! 928: in f state nil ! 929: end ! 930: ! 931: and gettrans (state) = ! 932: let fun loop c tlist = ! 933: let fun cktrans nil r = r ! 934: | cktrans (hd::tl) r = ! 935: case (leaf sub hd) of ! 936: CLASS(i,_)=> ! 937: (if (i sub c) then cktrans tl (union(r,fp sub hd)) ! 938: else cktrans tl r handle Subscript => ! 939: cktrans tl r ! 940: ) ! 941: | _ => cktrans tl r ! 942: in if c >= 0 then ! 943: let val v=cktrans state nil ! 944: in loop (c-1) (if v=nil then 0::tlist else (getstate v)::tlist) ! 945: end ! 946: else tlist ! 947: end ! 948: in loop ((!CharSetSize) - 1) nil ! 949: end ! 950: ! 951: and startstates() = ! 952: let val startarray = array(!StateNum + 1, nil); ! 953: fun listofarray(a,n) = ! 954: let fun f i l = if i >= 0 then f (i-1) ((a sub i)::l) else l ! 955: in f (n-1) nil end ! 956: val rec makess = fn ! 957: nil => () ! 958: | (startlist,e)::tl => (fix(startlist,firstpos(e));makess(tl)) ! 959: and fix = fn ! 960: (nil,_) => () ! 961: | (s::tl,firsts) => (update(startarray,s, ! 962: union(firsts,startarray sub s)); ! 963: fix(tl,firsts)) ! 964: in makess(rules);listofarray(startarray, !StateNum + 1) ! 965: end ! 966: ! 967: in visitstarts(startstates()); ! 968: (listofdict(!fintab),listofdict(!transtab),listofdict(!tctab),tcpairs) ! 969: end ! 970: ! 971: val skel_hd = ! 972: " struct\n\ ! 973: \ structure UserDeclarations =\n\ ! 974: \ struct\n\ ! 975: \" ! 976: ! 977: ! 978: val skel_mid2 = ! 979: " | Internal.D i =>\n\ ! 980: \ let val newrs =\n\ ! 981: \ if (List.exists (fn x => i=x) rs) then rs\n\ ! 982: \ else i::rs\n\ ! 983: \ in action (i,(acts::l),newrs)\n\ ! 984: \ end\n\ ! 985: \ | Internal.T k =>\n\ ! 986: \ let fun f (a::b,r) =\n\ ! 987: \ if a=k\n\ ! 988: \ then action(i,(((Internal.N a)::acts)::l),(b@r))\n\ ! 989: \ else f (b,a::r)\n\ ! 990: \ | f (nil,r) = action(i,(acts::l),rs)\n\ ! 991: \ in f (rs,nil)\n\ ! 992: \ end\n\ ! 993: \" ! 994: ! 995: fun lexGen(infile) = ! 996: let val outfile = infile ^ ".sml" ! 997: fun PrintLexer (ends) = ! 998: let val sayln = fn x => (say x; say "\n") ! 999: in case !ArgCode ! 1000: of NONE => (sayln "fun lex () : Internal.result ="; ! 1001: sayln "let fun continue() = lex() in") ! 1002: | SOME s => (say "fun lex "; say "(yyarg as ("; say s; sayln ")) ="; ! 1003: sayln "let fun continue() : Internal.result = "); ! 1004: say " let fun scan (s,AcceptingLeaves : Internal.yyfinstate"; ! 1005: sayln " list list,l,i0) ="; ! 1006: if !UsesTrailingContext ! 1007: then say "\tlet fun action (i,nil,rs)" ! 1008: else say "\tlet fun action (i,nil)"; ! 1009: sayln " = raise LexError"; ! 1010: if !UsesTrailingContext ! 1011: then sayln "\t| action (i,nil::l,rs) = action(i-1,l,rs)" ! 1012: else sayln "\t| action (i,nil::l) = action (i-1,l)"; ! 1013: if !UsesTrailingContext ! 1014: then sayln "\t| action (i,(node::acts)::l,rs) =" ! 1015: else sayln "\t| action (i,(node::acts)::l) ="; ! 1016: sayln "\t\tcase node of"; ! 1017: sayln "\t\t Internal.N yyk => "; ! 1018: sayln "\t\t\t(let val yytext = substring(!yyb,i0,i-i0)"; ! 1019: if !CountNewLines ! 1020: then (sayln "\t\t\tval _ = yylineno :="; ! 1021: sayln "(fold (fn (x,r) => if x =\"\\n\" then r+1 else r)"; ! 1022: sayln "(explode yytext) (!yylineno))") ! 1023: else (); ! 1024: sayln "\t\t\topen UserDeclarations Internal.StartStates"; ! 1025: sayln " in (yypos := i; case yyk of "; ! 1026: sayln ""; ! 1027: sayln "\t\t\t(* Application actions *)\n"; ! 1028: makeaccept(ends); ! 1029: say "\n\t\t) end "; ! 1030: if !HaveReject ! 1031: then (say "handle Reject => action(i,acts::l"; ! 1032: if !UsesTrailingContext ! 1033: then say ",rs)" ! 1034: else say ")") ! 1035: else (); ! 1036: say ")\n\n"; ! 1037: if (!UsesTrailingContext) then say skel_mid2 else (); ! 1038: sayln "\tval {fin,trans} = Internal.tab sub s"; ! 1039: sayln "\tval NewAcceptingLeaves = fin::AcceptingLeaves"; ! 1040: sayln "\tin if l = !yybl then"; ! 1041: sayln "\t let val newchars= if !yydone then \"\" else yyinput 1024"; ! 1042: sayln "\t in if (size newchars)=0"; ! 1043: sayln "\t\t then (yydone := true;"; ! 1044: say "\t\t if (l=i0) then UserDeclarations.eof "; ! 1045: sayln (case !ArgCode of NONE => "()" | SOME _ => "yyarg"); ! 1046: say "\t\t else action(l,NewAcceptingLeaves"; ! 1047: if !UsesTrailingContext then ! 1048: sayln ",nil))" else sayln "))"; ! 1049: sayln "\t\t else (if i0=l then yyb := newchars"; ! 1050: sayln "\t\t else yyb := substring(!yyb,i0,l-i0)^newchars;"; ! 1051: sayln "\t\t yybl := size (!yyb);"; ! 1052: sayln "\t\t scan (s,AcceptingLeaves,l-i0,0))"; ! 1053: sayln "\t end"; ! 1054: sayln "\t else let val NewChar = ordof(!yyb,l)"; ! 1055: (say "\t\tval NewState = "; ! 1056: case (!CharFormat) ! 1057: of true => sayln "ordof(trans,NewChar)" ! 1058: | false => sayln "(trans sub NewChar)"); ! 1059: say "\t\tin if NewState=0 then action(l,NewAcceptingLeaves"; ! 1060: if !UsesTrailingContext then sayln ",nil)" else sayln ")"; ! 1061: sayln "\t\telse scan(NewState,NewAcceptingLeaves,l+1,i0)"; ! 1062: sayln "\tend"; ! 1063: sayln "\tend"; ! 1064: if !UsesPrevNewLine then () else sayln "(*"; ! 1065: sayln "\tval start= if substring(!yyb,!yypos-1,1)=\"\\n\""; ! 1066: sayln "then !yybegin+1 else !yybegin"; ! 1067: if !UsesPrevNewLine then () else sayln "*)"; ! 1068: say "\tin scan("; ! 1069: if !UsesPrevNewLine then say "start" ! 1070: else say "!yybegin (* start *)"; ! 1071: sayln ",nil,!yypos,!yypos)"; ! 1072: sayln " end"; ! 1073: sayln (case !ArgCode of NONE => "end" | SOME _ => "in continue end"); ! 1074: sayln " in lex"; ! 1075: sayln " end"; ! 1076: sayln "end" ! 1077: end ! 1078: ! 1079: in (UsesPrevNewLine := false; ! 1080: ResetFlags(); ! 1081: LexBuf := make_ibuf(open_in infile); ! 1082: LexOut := open_out(outfile); ! 1083: StateNum := 2; ! 1084: LineNum := 1; ! 1085: StateTab := enter(create(String.<=))("INITIAL",1); ! 1086: LeafNum := ~1; ! 1087: let ! 1088: val (user_code,rules,ends) = parse(); ! 1089: val (fins,trans,tctab,tcpairs) = makedfa(rules) ! 1090: in ! 1091: if (!HeaderDecl) ! 1092: then say (!HeaderCode) ! 1093: else say ("structure " ^ (!StrName)); ! 1094: say "=\n"; ! 1095: say skel_hd; ! 1096: say user_code; ! 1097: say "end (* end of user routines *)\n"; ! 1098: say "exception LexError (* raised if illegal leaf "; ! 1099: say "action tried *)\n"; ! 1100: say "structure Internal =\n\tstruct\n"; ! 1101: maketable(fins,tctab,tcpairs,trans); ! 1102: say "structure StartStates =\n\tstruct\n"; ! 1103: say "\tdatatype yystartstate = STARTSTATE of int\n"; ! 1104: makebegin(); ! 1105: say "\nend\n"; ! 1106: say "type result = UserDeclarations.lexresult\n"; ! 1107: say "\texception LexerError (* raised if illegal leaf "; ! 1108: say "action tried *)\n"; ! 1109: if !HaveReject ! 1110: then say "\texception Reject\t(* for implementing REJECT *)\n" ! 1111: else (); ! 1112: say "end\n\n"; ! 1113: if !CountNewLines then say "val yylineno = ref 0\n\n" else (); ! 1114: say "fun makeLexer yyinput = \n"; ! 1115: say "let \n"; ! 1116: say "\tval yyb = ref \"\\n\" \t\t(* buffer *)\n\ ! 1117: \\tval yybl = ref 1\t\t(*buffer length *)\n\ ! 1118: \\tval yypos = ref 1\t\t(* location of next character to use *)\n\ ! 1119: \\tval yydone = ref false\t\t(* eof found yet? *)\n\ ! 1120: \\tval yybegin = ref 1\t\t(*Current 'start state' for lexer *)\n\ ! 1121: \\n\tval YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>\n\ ! 1122: \\t\t yybegin := x\n\n"; ! 1123: if !HaveReject ! 1124: then say "\tval REJECT = fn () => raise Internal.Reject\n\n" ! 1125: else (); ! 1126: PrintLexer(ends); ! 1127: close_ibuf(!LexBuf); ! 1128: close_out(!LexOut) ! 1129: end) ! 1130: end ! 1131: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.