Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /ml-lex/releases/release-110.80/lexgen.sml
ViewVC logotype

Diff of /ml-lex/releases/release-110.80/lexgen.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

sml/trunk/src/ml-lex/lexgen.sml revision 656, Fri Jun 9 03:39:04 2000 UTC ml-lex/releases/release-110.80/lexgen.sml revision 4283, Fri Aug 19 12:31:11 2016 UTC
# Line 68  Line 68 
68  # Revision 1.3  1997/10/04  03:52:13  dbm  # Revision 1.3  1997/10/04  03:52:13  dbm
69  #   Fix to remove output file if ml-lex fails.  #   Fix to remove output file if ml-lex fails.
70  #  #
71            10/17/02 (jhr) changed bad character error message to properly
72                    print the bad character.
73            10/17/02 (jhr) fixed skipws to use Char.isSpace test.
74            07/27/05 (jhr) add \r as a recognized escape sequence.
75   *)   *)
76    
77  (* Subject: lookahead in sml-lex  (* Subject: lookahead in sml-lex
# Line 210  Line 214 
214    
215  structure LexGen: LEXGEN =  structure LexGen: LEXGEN =
216     struct     struct
217     open Array List     val sub = Array.sub
218     infix 9 sub     infix 9 sub
219    
220     datatype token = CHARS of bool array | QMARK | STAR | PLUS | BAR     datatype token = CHARS of bool array | QMARK | STAR | PLUS | BAR
# Line 421  Line 425 
425                num (explode s, 0)                num (explode s, 0)
426              end              end
427    
428        fun skipws () = (case nextch()        fun skipws () = let val ch = nextch()
429               of #" " => skipws()              in
430                | #"\t" => skipws()                if Char.isSpace ch
431                | #"\n" => skipws()                  then skipws()
432                | x => x                  else ch
433              (* end case *))              end
434    
435        and nextch () = getch(!LexBuf)        and nextch () = getch(!LexBuf)
436    
437        and escaped () = (case nextch()        and escaped () = (case nextch()
438               of #"b" => #"\008"               of #"b" => #"\008"
439                | #"n" => #"\n"                | #"n" => #"\n"
440                  | #"r" => #"\r"
441                | #"t" => #"\t"                | #"t" => #"\t"
442                | #"h" => #"\128"                | #"h" => #"\128"
443                | x => let                | x => let
# Line 453  Line 458 
458                    end                    end
459              (* end case *))              (* end case *))
460    
461        and onechar x = let val c = array(!CharSetSize, false)        and onechar x = let val c = Array.array(!CharSetSize, false)
462                in                in
463                  update(c, Char.ord(x), true); CHARS(c)                  Array.update(c, Char.ord(x), true); CHARS(c)
464                end                end
465    
466        in case !LexState of 0 => let val makeTok = fn () =>        in case !LexState of 0 => let val makeTok = fn () =>
# Line 498  Line 503 
503                               end                               end
504                          in ID(getID [ch])                          in ID(getID [ch])
505                          end                          end
506                        else (prSynErr ("bad character: " ^ String.str ch))                        else prSynErr (String.concat[
507                              "bad character: \"", Char.toString ch, "\""
508                            ])
509          in NextTok := makeTok()          in NextTok := makeTok()
510          end          end
511          | 1 => let val rec makeTok = fn () =>          | 1 => let val rec makeTok = fn () =>
# Line 521  Line 528 
528                  | #"$" => DOLLAR                  | #"$" => DOLLAR
529                  | #"/" => SLASH                  | #"/" => SLASH
530                  | #";" => SEMI                  | #";" => SEMI
531                  | #"." => let val c = array(!CharSetSize,true) in                  | #"." => let val c = Array.array(!CharSetSize,true) in
532                                  update(c,10,false); CHARS(c)                                  Array.update(c,10,false); CHARS(c)
533                          end                          end
534                          (* assign and arrow *)                          (* assign and arrow *)
535                  | #"=" => let val c = nextch() in                  | #"=" => let val c = nextch() in
# Line 534  Line 541 
541                                  end;                                  end;
542                          val first = classch();                          val first = classch();
543                          val flag = (first <> #"^");                          val flag = (first <> #"^");
544                          val c = array(!CharSetSize,not flag);                          val c = Array.array(!CharSetSize,not flag);
545                          fun add NONE = ()                          fun add NONE = ()
546                            | add (SOME x) = update(c, Char.ord(x), flag)                            | add (SOME x) = Array.update(c, Char.ord(x), flag)
547                          and range (x, y) = if x>y                          and range (x, y) = if x>y
548                                then (prErr "bad char. range")                                then (prErr "bad char. range")
549                                else let                                else let
# Line 604  Line 611 
611          in NextTok := makeTok()          in NextTok := makeTok()
612          end          end
613          | 2 => NextTok :=          | 2 => NextTok :=
614               (case skipws()                 (case skipws() of
615                   of #"(" => let                    #"(" =>
616                          fun GetAct (lpct,x) = (case getch(!LexBuf)                    let
617                                 of #"(" => GetAct (lpct+1, #"("::x)                      fun loop_to_end (backslash, x) =
618                                  | #")" => if lpct = 0 then (implode (rev x))                        let
619                                                        else GetAct(lpct-1, #")"::x)                          val c    = getch (! LexBuf)
620                                  | y => GetAct(lpct,y::x)                          val notb = not backslash
621                                (* end case *))                          val nstr = c :: x
622                          in ACTION (GetAct (0,nil))                        in
623                            case c of
624                              #"\"" => if notb then nstr
625                                       else loop_to_end (false, nstr)
626                            | _ => loop_to_end (c = #"\\" andalso notb, nstr)
627                          end
628                        fun GetAct (lpct, x) =
629                          let
630                            val c    = getch (! LexBuf)
631                            val nstr = c :: x
632                          in
633                            case c of
634                              #"\"" => GetAct (lpct, loop_to_end (false, nstr))
635                            | #"(" => GetAct (lpct + 1, nstr)
636                            | #")" => if lpct = 0 then implode (rev x)
637                                      else GetAct(lpct - 1, nstr)
638                            | _ => GetAct(lpct, nstr)
639                          end
640                      in
641                        ACTION (GetAct (0,nil))
642                          end                          end
643                   | #";" => SEMI                   | #";" => SEMI
644                   | c => (prSynErr ("invalid character " ^ String.str c)))                   | c => (prSynErr ("invalid character " ^ String.str c)))
# Line 634  Line 660 
660                  handle LOOKUP => prErr ("bad regular expression name: "^                  handle LOOKUP => prErr ("bad regular expression name: "^
661                                              name)                                              name)
662    
663          and newline = fn () => let val c = array(!CharSetSize,false) in          and newline = fn () => let val c = Array.array(!CharSetSize,false) in
664                  update(c,10,true); c                  Array.update(c,10,true); c
665                  end                  end
666    
667          and endline = fn e => trail(e,CLASS(newline(),0))          and endline = fn e => trail(e,CLASS(newline(),0))
# Line 657  Line 683 
683                  | LP => let val e = exp0() in                  | LP => let val e = exp0() in
684                   if !NextTok = RP then                   if !NextTok = RP then
685                    (AdvanceTok(); exp1(e))                    (AdvanceTok(); exp1(e))
686                   else (prSynErr "missing '('") end                   else (prSynErr "missing ')'") end
687                  | ID(name) => exp1(lookup' name)                  | ID(name) => exp1(lookup' name)
688                  | _ => raise SyntaxError                  | _ => raise SyntaxError
689    
# Line 971  Line 997 
997                  | false => (say "(0, 0, \"\")]\n";                  | false => (say "(0, 0, \"\")]\n";
998                      say "fun f(n, i, x) = (n, Vector.tabulate(i, decode x)) \n")                      say "fun f(n, i, x) = (n, Vector.tabulate(i, decode x)) \n")
999    
1000              val _ = say "val s = map f (rev (tl (rev s))) \n"              val _ = say "val s = List.map f (List.rev (tl (List.rev s))) \n"
1001              val _ = say "exception LexHackingError \n"              val _ = say "exception LexHackingError \n"
1002              val _ = say "fun look ((j,x)::r, i: int) = if i = j then x else look(r, i) \n"              val _ = say "fun look ((j,x)::r, i: int) = if i = j then x else look(r, i) \n"
1003              val _ = say "  | look ([], i) = raise LexHackingError\n"              val _ = say "  | look ([], i) = raise LexHackingError\n"
# Line 1033  Line 1059 
1059    
1060          fun msg x = TextIO.output(TextIO.stdOut, x)          fun msg x = TextIO.output(TextIO.stdOut, x)
1061    
1062    in (say "in Vector.fromList(map g \n["; makeTable(rs,newfins);    in (say "in Vector.fromList(List.map g \n["; makeTable(rs,newfins);
1063        say "])\nend\n";        say "])\nend\n";
1064      msg ("\nNumber of states = " ^ (Int.toString (length trans)));      msg ("\nNumber of states = " ^ (Int.toString (length trans)));
1065      msg ("\nNumber of distinct rows = " ^ (Int.toString (!count)));      msg ("\nNumber of distinct rows = " ^ (Int.toString (!count)));
# Line 1050  Line 1076 
1076      let fun startline f = if f then say "  " else say "| "      let fun startline f = if f then say "  " else say "| "
1077           fun make(nil,f) = (startline f; say "_ => raise Internal.LexerError\n")           fun make(nil,f) = (startline f; say "_ => raise Internal.LexerError\n")
1078            | make((x,a)::y,f) = (startline f; say x; say " => ";            | make((x,a)::y,f) = (startline f; say x; say " => ";
1079                                  if Substring.size(#2 (Substring.position "yytext" (Substring.all a))) = 0                                  if Substring.size(#2 (Substring.position "yytext" (Substring.full a))) = 0
1080   then   then
1081                                       (say "("; say a; say ")")                                       (say "("; say a; say ")")
1082                                  else (say "let val yytext=yymktext() in ";                                  else (say "let val yytext=yymktext() in ";
# Line 1060  Line 1086 
1086      end      end
1087    
1088  fun leafdata(e:(int list * exp) list) =  fun leafdata(e:(int list * exp) list) =
1089          let val fp = array(!LeafNum + 1,nil)          let val fp = Array.array(!LeafNum + 1,nil)
1090          and leaf = array(!LeafNum + 1,EPS)          and leaf = Array.array(!LeafNum + 1,EPS)
1091          and tcpairs = ref nil          and tcpairs = ref nil
1092          and trailmark = ref ~1;          and trailmark = ref ~1;
1093          val rec add = fn          val rec add = fn
1094                    (nil,x) => ()                    (nil,x) => ()
1095                  | (hd::tl,x) => (update(fp,hd,union(fp sub hd,x));                  | (hd::tl,x) => (Array.update(fp,hd,union(fp sub hd,x));
1096                          add(tl,x))                          add(tl,x))
1097          and moredata = fn          and moredata = fn
1098                    CLOSURE(e1) =>                    CLOSURE(e1) =>
# Line 1074  Line 1100 
1100                  | ALT(e1,e2) => (moredata(e1); moredata(e2))                  | ALT(e1,e2) => (moredata(e1); moredata(e2))
1101                  | CAT(e1,e2) => (moredata(e1); moredata(e2);                  | CAT(e1,e2) => (moredata(e1); moredata(e2);
1102                          add(lastpos(e1),firstpos(e2)))                          add(lastpos(e1),firstpos(e2)))
1103                  | CLASS(x,i) => update(leaf,i,CLASS(x,i))                  | CLASS(x,i) => Array.update(leaf,i,CLASS(x,i))
1104                  | TRAIL(i) => (update(leaf,i,TRAIL(i)); if !trailmark = ~1                  | TRAIL(i) => (Array.update(leaf,i,TRAIL(i)); if !trailmark = ~1
1105                          then trailmark := i else ())                          then trailmark := i else ())
1106                  | END(i) => (update(leaf,i,END(i)); if !trailmark <> ~1                  | END(i) => (Array.update(leaf,i,END(i)); if !trailmark <> ~1
1107                          then (tcpairs := (!trailmark,i)::(!tcpairs);                          then (tcpairs := (!trailmark,i)::(!tcpairs);
1108                          trailmark := ~1) else ())                          trailmark := ~1) else ())
1109                  | _ => ()                  | _ => ()
# Line 1163  Line 1189 
1189       end       end
1190    
1191  and startstates() =  and startstates() =
1192          let val startarray = array(!StateNum + 1, nil);          let val startarray = Array.array(!StateNum + 1, nil);
1193              fun listofarray(a,n) =              fun listofarray(a,n) =
1194                  let fun f i l = if i >= 0 then  f (i-1) ((a sub i)::l) else l                  let fun f i l = if i >= 0 then  f (i-1) ((a sub i)::l) else l
1195                  in f (n-1) nil end                  in f (n-1) nil end
# Line 1172  Line 1198 
1198                  | (startlist,e)::tl => (fix(startlist,firstpos(e));makess(tl))                  | (startlist,e)::tl => (fix(startlist,firstpos(e));makess(tl))
1199          and fix = fn          and fix = fn
1200                    (nil,_) => ()                    (nil,_) => ()
1201                  | (s::tl,firsts) => (update(startarray,s,                  | (s::tl,firsts) => (Array.update(startarray,s,
1202                          union(firsts,startarray sub s));                          union(firsts,startarray sub s));
1203                          fix(tl,firsts))                          fix(tl,firsts))
1204          in makess(rules);listofarray(startarray, !StateNum + 1)          in makess(rules);listofarray(startarray, !StateNum + 1)
# Line 1223  Line 1249 
1249               else sayln "\t| action (i,(node::acts)::l) =";               else sayln "\t| action (i,(node::acts)::l) =";
1250           sayln "\t\tcase node of";           sayln "\t\tcase node of";
1251           sayln "\t\t    Internal.N yyk => ";           sayln "\t\t    Internal.N yyk => ";
1252           sayln "\t\t\t(let fun yymktext() = substring(!yyb,i0,i-i0)\n\           sayln "\t\t\t(let fun yymktext() = String.substring(!yyb,i0,i-i0)\n\
1253                 \\t\t\t     val yypos = i0+ !yygone";                 \\t\t\t     val yypos = i0+ !yygone";
1254           if !CountNewLines           if !CountNewLines
1255              then (sayln "\t\t\tval _ = yylineno := CharVector.foldli";              then (sayln "\t\t\tval _ = yylineno := CharVectorSlice.foldli";
1256                    sayln "\t\t\t\t(fn (_,#\"\\n\", n) => n+1 | (_,_, n) => n) (!yylineno) (!yyb,i0,SOME(i-i0))")                    sayln "\t\t\t\t(fn (_,#\"\\n\", n) => n+1 | (_,_, n) => n) (!yylineno) (CharVectorSlice.slice (!yyb,i0,SOME(i-i0)))")
1257              else ();              else ();
1258           if !HaveReject           if !HaveReject
1259               then (say "\t\t\tfun REJECT() = action(i,acts::l";               then (say "\t\t\tfun REJECT() = action(i,acts::l";
# Line 1250  Line 1276 
1276           if !UsesTrailingContext then say ",nil" else ();           if !UsesTrailingContext then say ",nil" else ();
1277           say ") else";           say ") else";
1278           sayln "\t    let val newchars= if !yydone then \"\" else yyinput 1024";           sayln "\t    let val newchars= if !yydone then \"\" else yyinput 1024";
1279           sayln "\t    in if (size newchars)=0";           sayln "\t    in if (String.size newchars)=0";
1280           sayln "\t\t  then (yydone := true;";           sayln "\t\t  then (yydone := true;";
1281           say "\t\t        if (l=i0) then UserDeclarations.eof ";           say "\t\t        if (l=i0) then UserDeclarations.eof ";
1282           sayln (case !ArgCode of NONE => "()" | SOME _ => "yyarg");           sayln (case !ArgCode of NONE => "()" | SOME _ => "yyarg");
# Line 1258  Line 1284 
1284           if !UsesTrailingContext then           if !UsesTrailingContext then
1285              sayln ",nil))" else sayln "))";              sayln ",nil))" else sayln "))";
1286           sayln "\t\t  else (if i0=l then yyb := newchars";           sayln "\t\t  else (if i0=l then yyb := newchars";
1287           sayln "\t\t     else yyb := substring(!yyb,i0,l-i0)^newchars;";           sayln "\t\t     else yyb := String.substring(!yyb,i0,l-i0)^newchars;";
1288           sayln "\t\t     yygone := !yygone+i0;";           sayln "\t\t     yygone := !yygone+i0;";
1289           sayln "\t\t     yybl := size (!yyb);";           sayln "\t\t     yybl := String.size (!yyb);";
1290           sayln "\t\t     scan (s,AcceptingLeaves,l-i0,0))";           sayln "\t\t     scan (s,AcceptingLeaves,l-i0,0))";
1291           sayln "\t    end";           sayln "\t    end";
1292           sayln "\t  else let val NewChar = Char.ord(Unsafe.CharVector.sub(!yyb,l))";           sayln "\t  else let val NewChar = Char.ord(Unsafe.CharVector.sub(!yyb,l))";
# Line 1277  Line 1303 
1303           sayln "\tend";           sayln "\tend";
1304           sayln "\tend";           sayln "\tend";
1305           if !UsesPrevNewLine then () else sayln "(*";           if !UsesPrevNewLine then () else sayln "(*";
1306           sayln "\tval start= if substring(!yyb,!yybufpos-1,1)=\"\\n\"";           sayln "\tval start= if String.substring(!yyb,!yybufpos-1,1)=\"\\n\"";
1307           sayln "then !yybegin+1 else !yybegin";           sayln "then !yybegin+1 else !yybegin";
1308           if !UsesPrevNewLine then () else sayln "*)";           if !UsesPrevNewLine then () else sayln "*)";
1309           say "\tin scan(";           say "\tin scan(";

Legend:
Removed from v.656  
changed lines
  Added in v.4283

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0