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/trunk/lexgen.sml
ViewVC logotype

Diff of /ml-lex/trunk/lexgen.sml

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

sml/branches/SMLNJ/src/ml-lex/lexgen.sml revision 418, Fri Sep 3 23:51:27 1999 UTC sml/trunk/src/ml-lex/lexgen.sml revision 1832, Wed Jul 27 18:49:19 2005 UTC
# Line 45  Line 45 
45                  and characters.                  and characters.
46          02/08/95 (jhr) Modified to use new List module interface.          02/08/95 (jhr) Modified to use new List module interface.
47          05/18/95 (jhr) changed Vector.vector to Vector.fromList          05/18/95 (jhr) changed Vector.vector to Vector.fromList
48  *  
  * $Log: lexgen.sml,v $  
  * Revision 1.1.1.1  1998/04/08 18:40:10  george  
  * Version 110.5  
  *  
49   * Revision 1.9  1998/01/06 19:23:53  appel   * Revision 1.9  1998/01/06 19:23:53  appel
50   *   added %posarg feature to permit position-within-file to be passed   *   added %posarg feature to permit position-within-file to be passed
51   *   as a parameter to makeLexer   *   as a parameter to makeLexer
# Line 72  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  # Revision 1.2  1997/05/06  01:12:38  george          10/17/02 (jhr) changed bad character error message to properly
72  # *** empty log message ***                  print the bad character.
73  #          10/17/02 (jhr) fixed skipws to use Char.isSpace test.
74   * Revision 1.2  1996/02/26  15:02:27  george          07/27/05 (jhr) add \r as a recognized escape sequence.
  *    print no longer overloaded.  
  *    use of makestring has been removed and replaced with Int.toString ..  
  *    use of IO replaced with TextIO  
  *  
  * Revision 1.1.1.1  1996/01/31  16:01:15  george  
  * Version 109  
  *  
75   *)   *)
76    
77  (* Subject: lookahead in sml-lex  (* Subject: lookahead in sml-lex
# Line 436  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 513  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 619  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 912  Line 923 
923    
924           fun GetEndLeaf t =           fun GetEndLeaf t =
925             let fun f ((tl,el)::r) = if (tl=t) then el else f r             let fun f ((tl,el)::r) = if (tl=t) then el else f r
926                     | f _ = raise Match
927             in f tcpairs             in f tcpairs
928             end             end
929           fun GetTrConLeaves s =           fun GetTrConLeaves s =
# Line 987  Line 999 
999    
1000              val _ = say "val s = map f (rev (tl (rev s))) \n"              val _ = say "val s = map f (rev (tl (rev s))) \n"
1001              val _ = say "exception LexHackingError \n"              val _ = say "exception LexHackingError \n"
1002              val _ = say "fun look ((j,x)::r, i) = 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"
1004    
1005          val _ = say "fun g {fin=x, trans=i} = {fin=x, trans=look(s,i)} \n"          val _ = say "fun g {fin=x, trans=i} = {fin=x, trans=look(s,i)} \n"
1006           in res           in res
1007          end          end
1008    
1009            fun makeTable args = let
1010                fun makeOne (a, b) = let
1011                    fun item (N i) = ("N", i)
1012                      | item (T i) = ("T", i)
1013                      | item (D i) = ("D", i)
1014                    fun makeItem x = let
1015                        val (t, n) = item x
1016                    in
1017                        app say ["(", t, " ", Int.toString n, ")"]
1018                    end
1019                    fun makeItems [] = ()
1020                      | makeItems [x] = makeItem x
1021                      | makeItems (hd :: tl) =
1022                        (makeItem hd; say ","; makeItems tl)
1023                in
1024                    say "{fin = [";
1025                    makeItems b;
1026                    app say ["], trans = ", a, "}"]
1027                end
1028                fun mt ([], []) = ()
1029                  | mt ([a], [b]) = makeOne (a, b)
1030                  | mt (a :: a', b :: b') =
1031                    (makeOne (a, b); say ",\n"; mt (a', b'))
1032                  | mt _ = raise Match
1033            in
1034                mt args
1035            end
1036    
1037    (*
1038          fun makeTable(nil,nil) = ()          fun makeTable(nil,nil) = ()
1039            | makeTable(a::a',b::b') =            | makeTable(a::a',b::b') =
1040               let fun makeItems nil = ()               let fun makeItems nil = ()
# Line 1014  Line 1055 
1055                    then ()                    then ()
1056                    else (say ",\n"; makeTable(a',b')))                    else (say ",\n"; makeTable(a',b')))
1057                end                end
1058    *)
1059    
1060          fun msg x = TextIO.output(TextIO.stdOut, x)          fun msg x = TextIO.output(TextIO.stdOut, x)
1061    
# Line 1210  Line 1252 
1252           sayln "\t\t\t(let fun yymktext() = substring(!yyb,i0,i-i0)\n\           sayln "\t\t\t(let fun yymktext() = 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";

Legend:
Removed from v.418  
changed lines
  Added in v.1832

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