CVS: sml-dist/src/lexgen/src/BackEnds/SML ml.sml,1.1,1.2 sml-fun-output.sml,1.1,1.2

Update of /cvsroot/smlnj/sml-dist/src/lexgen/src/BackEnds/SML
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14104/src/lexgen/src/BackEnds/SML

Modified Files:
	ml.sml sml-fun-output.sml 
Log Message:
improvements/bugfixes to lexgen from Aaron Turon

Index: ml.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/lexgen/src/BackEnds/SML/ml.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ml.sml	1 Mar 2006 04:44:29 -0000	1.1
--- ml.sml	1 Mar 2006 20:17:27 -0000	1.2
***************
*** 37,40 ****
--- 37,41 ----
        | ML_RefPut of ml_exp * ml_exp
        | ML_Raw of ml_token list
+       | ML_NewGroup of ml_exp
  
      and ml_pat
***************
*** 235,238 ****
--- 236,240 ----
  		  | (ML_Raw toks) => letBody(inLet, fn () => (
  		      hbox(); app (fn (Tok s) => str s) toks; close()))
+ 		  | (ML_NewGroup e) => ppExp(inLet, false, e)
  		(* end case *))
  	  and ppExp' e = ppExp(false, false, e)

Index: sml-fun-output.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/lexgen/src/BackEnds/SML/sml-fun-output.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** sml-fun-output.sml	1 Mar 2006 04:44:29 -0000	1.1
--- sml-fun-output.sml	1 Mar 2006 20:17:27 -0000	1.2
***************
*** 100,104 ****
  
      fun mkState actionVec (s, k) = let
!           val LO.State {id, label, final, next} = s
  	  fun addMatch (i, lastMatch) = let
  		val lastMatch' = if hasREJECT (Vector.sub (actionVec, i))
--- 100,104 ----
  
      fun mkState actionVec (s, k) = let
!           val LO.State {id, startState, label, final, next} = s
  	  fun addMatch (i, lastMatch) = let
  		val lastMatch' = if hasREJECT (Vector.sub (actionVec, i))
***************
*** 139,144 ****
  		   | NONE =>  ML_App ("yystuck", [lastMatch])
  		 (* end case *))
!         (* if first state in machine, check for eof *)
! 	  val errAct = if id = 0
  		       then ML_If (ML_App("yyInput.eof", [ML_Var "strm"]),
  				   ML_App("UserDeclarations.eof", [ML_Var "yyarg"]),
--- 139,144 ----
  		   | NONE =>  ML_App ("yystuck", [lastMatch])
  		 (* end case *))
!         (* if start state, check for eof *)
! 	  val errAct = if startState
  		       then ML_If (ML_App("yyInput.eof", [ML_Var "strm"]),
  				   ML_App("UserDeclarations.eof", [ML_Var "yyarg"]),
***************
*** 220,226 ****
  		     else letl
  	  in  
! 	    ML_Fun (actName i, ["strm", "lastMatch"], letr, k)
  	  end
  
      fun lexerHook spec strm = let
            val LO.Spec {actions, dfa, startStates, ...} = spec
--- 220,245 ----
  		     else letl
  	  in  
! 	    ML_NewGroup (ML_Fun (actName i, ["strm", "lastMatch"], letr, k))
  	  end
  
+     structure SCC = GraphSCCFn (
+       struct
+         type ord_key = LO.dfa_state
+         fun compare (LO.State{id = id1, ...}, LO.State{id = id2, ...}) =
+ 	      Int.compare (id1, id2)
+       end)
+ 
+     fun mkStates (actions, dfa, startStates, k) = let
+           fun follow (LO.State {next, ...}) = 
+ 	        #2 (ListPair.unzip (!next))
+           val scc = SCC.topOrder' { roots = startStates, follow = follow }
+ 	  val mkState' = mkState actions
+ 	  fun mkGrp (SCC.SIMPLE state, k) = ML_NewGroup (mkState' (state, k))
+ 	    | mkGrp (SCC.RECURSIVE states, k) = 
+ 	        ML_NewGroup (List.foldr mkState' k states)
+           in
+             List.foldl mkGrp k scc
+           end
+ 
      fun lexerHook spec strm = let
            val LO.Spec {actions, dfa, startStates, ...} = spec
***************
*** 232,236 ****
  	  val innerExp = ML_Case (ML_RefGet (ML_Var "yyss"),
  				  List.map matchSS startStates)
! 	  val statesExp = List.foldr (mkState actions) innerExp dfa
  	  val lexerExp = Vector.foldri mkAction statesExp actions
            val ppStrm = TextIOPP.openOut {dst = strm, wid = 80}
--- 251,257 ----
  	  val innerExp = ML_Case (ML_RefGet (ML_Var "yyss"),
  				  List.map matchSS startStates)
! 	  val statesExp = mkStates 
! 			    (actions, dfa, 
! 			     #2 (ListPair.unzip startStates), innerExp)
  	  val lexerExp = Vector.foldri mkAction statesExp actions
            val ppStrm = TextIOPP.openOut {dst = strm, wid = 80}



-------------------------------------------------------
This SF.Net email is sponsored by xPML, a groundbreaking scripting language
that extends applications into web and mobile media. Attend the live webcast
and join the prime developer group breaking into this new coding territory!
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=110944&bid=241720&dat=121642