CVS: sml-dist/src/lexgen/src Makefile,NONE,1.1 lex-gen.sml,NONE,1.1 lexgen,NONE,1.1 main.sml,NONE,1.1 reg-exp-sig.sml,NONE,1.1 reg-exp.sml,NONE,1.1 sources.cm,NONE,1.1
Matthias Blume <[email protected]>
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/lexgen/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30700/src/lexgen/src Added Files: Makefile lex-gen.sml lexgen main.sml reg-exp-sig.sml reg-exp.sml sources.cm Log Message: ml-flex -> lexgen --- NEW FILE: Makefile --- # # COPYRIGHT (c) 2005 # John Reppy (http://www.cs.uchicago.edu/~jhr) # Aaron Turon ([email protected]) # All rights reserved. # OS = $(shell uname -s) ifeq ($(shell uname -s),Darwin) HEAP_SUFFIX = ppc-darwin else HEAP_SUFFIX = x86-unix endif SHELL = /bin/sh SML = sml ML_BUILD = ml-build ML_MAKEDEPEND = ml-makedepend PROGRAM = lexgen HEAP_IMAGE = $(PROGRAM).$(HEAP_SUFFIX) FE = FrontEnds BE = BackEnds ML_LEX = $(FE)/ml-lex ML_LEX_SRC = $(wildcard $(ML_LEX)/*.sml) $(ML_LEX)/ml-lex.lex $(ML_LEX)/ml-lex.yacc DUMP_SRC = $(wildcard $(BE)/Dump/*.sml) DOT_SRC = $(wildcard $(BE)/Dot/*.sml) SML_SRC = $(wildcard $(BE)/SML/*.sml) MATCH_SRC = $(wildcard $(BE)/Match/*.sml) FE_SRC = $(wildcard $(FE)/*.sml) $(ML_LEX_SRC) BE_SRC = $(wildcard $(BE)/*.sml) $(DOT_SRC) $(SML_SRC) $(MATCH_SRC) CORE_SRC = $(wildcard *.sml) SOURCES = $(CORE_SRC) $(FE_SRC) $(BE_SRC) sources.cm build: $(HEAP_IMAGE) $(HEAP_IMAGE): $(SOURCES) $(ML_BUILD) sources.cm Main.main $(PROGRAM) .depend: $(CM_FILES) touch .depend $(ML_MAKEDEPEND) -n -f .depend sources.cm $(HEAP_IMAGE) sinclude .depend #NOTE: do NOT clean out ml-lex.lex.sml, it is not autogenerated! clean: rm -rf .depend .cm FrontEnds/ml-lex/ml-lex.yacc.sml $(HEAP_IMAGE) --- NEW FILE: lex-gen.sml --- (* lex-gen.sml * * COPYRIGHT (c) 2005 * John Reppy (http://www.cs.uchicago.edu/~jhr) * Aaron Turon ([email protected]) * All rights reserved. * * DFA generation using RE derivatives *) structure LexGen : sig val gen : LexSpec.spec -> LexOutputSpec.spec end = struct structure RE = RegExp structure SIS = RegExp.SymSet structure LO = LexOutputSpec structure Map = RedBlackMapFn ( struct type ord_key = RE.re Vector.vector val compare = Vector.collate RE.compare end) (* given a list of RE vectors (start states), produce a DFA recognizer * NOTE: invoked once per start state (each start state has a DFA) *) fun mkDFA startVecs = let val n = ref 0 (* next state id *) val states = ref [] (* return the state that the re vector maps to and * a flag set to true if the state is new. *) fun mkState (stateMap, res) = (case Map.find(stateMap, res) of NONE => let val id = !n fun addFinal (idx, re, finals) = if RE.nullable re then idx :: finals else finals val q = LO.State { id = id, label = res, final = Vector.foldri addFinal [] res, next = ref [] } in n := id+1; states := q :: !states; (true, q, Map.insert(stateMap, res, q)) end | SOME q => (false, q, stateMap) (* end case *)) fun initIter (states, stateMap, []) = (List.rev states, stateMap) | initIter (states, stateMap, vec::vecs) = let val (_, q, stateMap') = mkState (stateMap, vec) in initIter (q :: states, stateMap', vecs) end val (initStates, initStatemap) = initIter ([], Map.empty, startVecs) fun f (stateMap, []) = stateMap | f (stateMap, LO.State{next, label, ...}::workList) = let fun move ((res, edge), (stateMap, workList)) = if Vector.all RE.isNone res (* if error transition *) then (stateMap, workList) else let val (isNew, q, stateMap) = mkState(stateMap, res) in next := (edge, q) :: !next; if isNew then (stateMap, q::workList) else (stateMap, workList) end val edges = RE.derivatives label in f (List.foldl move (stateMap, workList) edges) end in ignore (f (initStatemap, initStates)); (initStates, List.rev(!states)) end (* clamp a machine to the right character set *) fun clamp clampTo states = let val ascii127 = SIS.interval (0w0, 0w127) fun clampTrans (edge, q) = (SIS.intersect (ascii127, edge), q) fun clampState (LO.State{next, ...}) = next := List.map clampTrans (!next) in (List.app clampState states; states) end fun gen spec = let (* TODO: check for invalid start states on rules *) val LexSpec.Spec {decls, conf, rules} = spec val LexSpec.Conf {structName, header, arg, startStates, ...} = conf val startStates' = AtomSet.add (startStates, Atom.atom "INITIAL") (* (* split out actions and associate each ruleSpec to an action ID * * Note: matchActions tries to find textually idential actions and map * them to the same entry in the action vector *) fun matchActions rules = let fun iter ((ruleSpec, action)::rules, ruleSpecs, actions, actionMap, n) = let val key = Atom.atom action val (i, actions', actionMap', n') = case AtomMap.find (actionMap, key) of NONE => (n, action::actions, AtomMap.insert (actionMap, key, n), n+1) | SOME i => (i, actions, actionMap, n) in iter (rules, (i, ruleSpec)::ruleSpecs, actions', actionMap', n') end | iter ([], ruleSpecs, actions, _, _) = (List.rev ruleSpecs, List.rev actions) in iter (rules, [], [], AtomMap.empty, 0) end val (ruleSpecs, actions) = matchActions rules *) val (ruleSpecs, actions) = ListPair.unzip rules val actionsVec = Vector.fromList actions val startStates = AtomSet.listItems startStates' fun SSVec label = let fun hasRule (NONE, re) = re | hasRule (SOME ss, re) = if AtomSet.member (ss, label) then re else RegExp.none val rules = List.map hasRule ruleSpecs in Vector.fromList rules end val (initStates, states) = mkDFA (List.map SSVec startStates) in LO.Spec { decls = decls, header = (if String.size header = 0 then "structure " ^ (if String.size structName = 0 then "Mlex" else structName) else header), arg = arg, actions = actionsVec, dfa = clamp LexSpec.CLAMP127 states, startStates = ListPair.zip (List.map Atom.toString startStates, initStates) } end end --- NEW FILE: lexgen --- #!/bin/sh # # Wrapper for lexgen heap image # case `uname -s` in Darwin) heap=lexgen.ppc-darwin ;; *) heap=lexgen.x86-linux ;; esac if test ! -r $heap ; then echo "lexgen: no heap image!" exit 1 fi exec sml @SMLload=$heap $@ --- NEW FILE: main.sml --- (* main.sml * * COPYRIGHT (c) 2005 * John Reppy (http://www.cs.uchicago.edu/~jhr) * Aaron Turon ([email protected]) * All rights reserved. * * Driver for lexgen *) structure Main = struct structure RE = RegExp structure Lex = LexGen structure LO = LexOutputSpec fun debug s = (print s; print "\n") (* command-line parameters *) datatype options = Opt of { fname : string ref, lexCompat : bool ref, dump : bool ref, dot : bool ref, match : bool ref, beTest : bool ref } (* count the total number of DFA states *) fun numStates (LO.Spec{dfa, ...}) = List.length dfa fun mlFlex (Opt {fname, lexCompat, dot, dump, match, beTest}) = let val _ = if String.size (!fname) = 0 then (print "No input file specified (usage: lexgen [options] file)\n"; OS.Process.exit OS.Process.failure) else () val _ = if (!lexCompat = false) then (print "--ml-lex-mode switch must be specified\n"; OS.Process.exit OS.Process.failure) else() val _ = debug "[lexgen: parsing]" val inSpec' = MLLexInput.parseFile (!fname) val inSpec = if (!beTest) then LexSpec.emptyActions inSpec' else inSpec' val _ = debug "[lexgen: DFA gen]" val outSpec = Lex.gen inSpec val _ = (debug (concat [" ", Int.toString (numStates outSpec), " states in full DFA"])) val _ = if !dump then (debug "[lexgen: DFA dump]"; DumpOutput.output (outSpec, !fname)) else () val _ = if !dot then (debug "[lexgen: DOT gen]"; DotOutput.output (outSpec, !fname)) else () val _ = debug "[lexgen: SML gen]" val _ = SMLFunOutput.output (outSpec, !fname) val _ = if !match then (debug "-- Interactive matching (blank line to quit) --"; Match.output (outSpec, !fname)) else () in OS.Process.success end handle ex => ( TextIO.output(TextIO.stdErr, concat[ "uncaught exception ", General.exnName ex, " [", General.exnMessage ex, "]\n" ]); app (fn s => TextIO.output(TextIO.stdErr, concat[ " raised at ", s, "\n" ])) (SMLofNJ.exnHistory ex); OS.Process.exit OS.Process.failure) fun procArgs (Opt {fname, lexCompat, dot, dump, match, beTest}) arg = (case arg of "--dot" => dot := true | "--dump" => dump := true | "--match" => match := true | "--testbe" => beTest := true | "--ml-lex-mode" => lexCompat := true | file => if String.size (!fname) > 0 then (print "Only one input file may be specified\n"; OS.Process.exit OS.Process.failure) else fname := file (* end case *)) fun main (_, args) = let val opt = Opt {fname = ref "", lexCompat = ref false, dot = ref false, dump = ref false, match = ref false, beTest = ref false} val _ = List.app (procArgs opt) args in mlFlex opt end end --- NEW FILE: reg-exp-sig.sml --- (* reg-exp-sig.sml * * COPYRIGHT (c) 2005 * John Reppy (http://www.cs.uchicago.edu/~jhr) * Aaron Turon ([email protected]) * All rights reserved. * * RE representation and manipulation *) signature REG_EXP = sig structure Sym : INTERVAL_DOMAIN structure SymSet : INTERVAL_SET type symbol type sym_set type re val any : re (* wildcard *) val none : re (* EMPTY language *) val epsilon : re (* the nil character (of length 0) *) val mkSym : symbol -> re val mkSymSet : sym_set -> re val mkOr : re * re -> re val mkAnd : re * re -> re val mkXor : re * re -> re val mkNot : re -> re val mkConcat : re * re -> re val mkClosure : re -> re val mkOpt : re -> re val mkRep : re * int * int -> re val mkAtLeast : re * int -> re val isNone : re -> bool val nullable : re -> bool val derivative : symbol -> re -> re val derivatives : re Vector.vector -> ((re Vector.vector) * sym_set) list val symToString : symbol -> string val toString : re -> string val compare : re * re -> order end --- NEW FILE: reg-exp.sml --- (* reg-exp-fn.sml * * COPYRIGHT (c) 2005 * John Reppy (http://www.cs.uchicago.edu/~jhr) * Aaron Turon ([email protected]) * All rights reserved. * * Regular expression representation and manipulation. * * The main points here are to: * (1) make it easy for an RE parser to construct * RE expressions * (2) canonicalize REs for effective comparison * (3) implement the RE derivatives algorithm * * See the implementation notes for details on the derivatives * algorithm and the canonicalization strategy. *) structure RegExp : REG_EXP = struct (* symbols (i.e., words) *) structure Sym = struct structure W32 = Word32 type point = W32.word val compare = W32.compare val minPt : W32.word = 0w0 val maxPt = W32.notb 0w0 fun succ (w : W32.word) = if w = W32.notb 0w0 then w else w + 0w1 fun pred (w : W32.word) = if w = 0w0 then w else w - 0w1 fun isSucc (w1, w2) = (succ w1 = w2) end structure SymSet = IntervalSetFn(Sym) type symbol = Sym.point type sym_set = SymSet.set structure SIS = SymSet (* REs *) datatype re = Epsilon (* matches the empty string *) | Any (* matches any single symbol *) | None (* matches nothing (i.e. the empty language) *) | SymSet of sym_set | Concat of re list | Closure of re | Op of (rator * re list) (* list length <> 1 and in sorted order *) | Not of re and rator = OR | AND | XOR (* we give a total order to REs; this is useful for canonicalization *) fun compare (re1, re2) = let fun cmpOp (OR, OR) = EQUAL | cmpOp (OR, _) = LESS | cmpOp (_, OR) = GREATER | cmpOp (AND, AND) = EQUAL | cmpOp (AND, _) = LESS | cmpOp (_, AND) = GREATER | cmpOp (XOR, XOR) = EQUAL fun compareList (res1, res2) = List.collate compare (res1, res2) in case (re1, re2) of (Epsilon, Epsilon) => EQUAL | (Epsilon, _) => LESS | (_, Epsilon) => GREATER | (Any, Any) => EQUAL | (Any, _) => LESS | (_, Any) => GREATER | (None, None) => EQUAL | (None, _) => LESS | (_, None) => GREATER | (SymSet a, SymSet b) => SIS.compare(a, b) | (SymSet a, _) => LESS | (_, SymSet b) => GREATER | (Concat a, Concat b) => compareList(a, b) | (Concat a, _) => LESS | (_, Concat b) => GREATER | (Closure a, Closure b) => compare(a, b) | (Closure a, _) => LESS | (_, Closure b) => GREATER | (Op(op1, res1), Op(op2, res2)) => (case cmpOp (op1, op2) of EQUAL => compareList(res1, res2) | order => order (* end case *)) | (Op _, _) => LESS | (_, Op _) => GREATER | (Not a, Not b) => compare(a, b) (* end case *) end (* val sort = ListMergeSort.sort (fn (re1, re2) => compare(re1, re2) = LESS) *) (* primitive REs *) val any = Any val none = None val epsilon = Epsilon (* canonical constructors *) fun mkSymSet c = if SIS.isEmpty c then None else if SIS.isUniverse c then Any else SymSet c fun mkSym sym = mkSymSet (SIS.singleton sym) fun mkConcat (re1, re2) = (case (re1, re2) of (Epsilon, re2) => re2 | (re1, Epsilon) => re1 | (None, _) => None | (_, None) => None | (Concat res1, Concat res2) => Concat(res1@res2) | (re1, Concat res2) => Concat(re1::res2) | (Concat res1, re2) => Concat(res1@[re2]) | _ => Concat[re1, re2] (* end case *)) fun mkConcatList [] = Epsilon | mkConcatList (re::res) = mkConcat(re, mkConcatList res) fun mkClosure (Epsilon) = Epsilon | mkClosure (None) = Epsilon | mkClosure (re as Closure _) = re | mkClosure re = Closure re fun mergeSIS (res, mop) = let fun isSIS (SymSet _) = true | isSIS _ = false val (siss, res) = List.partition isSIS res in case siss of [] => res | [re] => res | sis::siss' => let fun wrapmop (SymSet s1, SymSet s2) = SymSet (mop (s1, s2)) | wrapmop _ = raise Fail "BUG: wrapmop: SymSet expected" val merged = List.foldl wrapmop sis siss' fun reinsert (re1, []) = [re1] | reinsert (re1, re::res) = (case compare (re1, re) of LESS => re1::re::res | EQUAL => raise Fail "BUG: mergeSIS: only one SymSet expected" | GREATER => re::(reinsert (re1, res)) (* end case *)) in reinsert (merged, res) end end fun mkOr (re1, re2) = let fun merge ([], res2) = res2 | merge (res1, []) = res1 | merge (re1::r1, re2::r2) = (case compare(re1, re2) of LESS => re1::merge(r1, re2::r2) | EQUAL => merge (re1::r1, r2) | GREATER => re2 :: merge(re1::r1, r2) (* end case *)) fun mk (a, b) = (case mergeSIS(merge(a, b), SIS.union) of [] => None | [re] => re | res => Op(OR, res) (* end case *)) in case (re1, re2) of (None, _) => re2 | (_, None) => re1 | (SymSet s1, SymSet s2) => mkSymSet (SIS.union (s1, s2)) | (Op(OR, res1), Op(OR, res2)) => mk(res1, res2) | (Op(OR, res1), _) => mk(res1, [re2]) | (_, Op(OR, res2)) => mk([re1], res2) | (re1, re2) => (case compare(re1, re2) of LESS => Op(OR, [re1, re2]) | EQUAL => re1 | GREATER => Op(OR, [re2, re1]) (* end case *)) (* end case *) end fun mkAnd (re1, re2) = let fun merge ([], res2) = res2 | merge (res1, []) = res1 | merge (re1::r1, re2::r2) = (case compare(re1, re2) of LESS => re1::merge(r1, re2::r2) | EQUAL => merge (re1::r1, r2) | GREATER => re2 :: merge(re1::r1, r2) (* end case *)) fun mk (a, b) = (case mergeSIS(merge(a, b), SIS.intersect) of [] => None | [re] => re | res => Op(AND, res) (* end case *)) in case (re1, re2) of (None, _) => None | (_, None) => None | (SymSet s1, SymSet s2) => mkSymSet (SIS.intersect (s1, s2)) | (Op(AND, res1), Op(AND, res2)) => mk(res1, res2) | (Op(AND, res1), _) => mk(res1, [re2]) | (_, Op(AND, res2)) => mk([re1], res2) | (re1, re2) => (case compare(re1, re2) of LESS => Op(AND, [re1, re2]) | EQUAL => re1 | GREATER => Op(AND, [re2, re1]) (* end case *)) (* end case *) end fun mkXor (re1, re2) = let fun merge ([], res2) = res2 | merge (res1, []) = res1 | merge (re1::r1, re2::r2) = (case compare(re1, re2) of LESS => re1::merge(r1, re2::r2) | EQUAL => merge (r1, r2) | GREATER => re2 :: merge(re1::r1, r2) (* end case *)) fun mk (a, b) = (case merge(a, b) of [] => None | [re] => re | res => Op(XOR, res) (* end case *)) in case (re1, re2) of (None, _) => re2 | (_, None) => re1 | (SymSet s1, SymSet s2) => mkSymSet (SIS.intersect ( SIS.union (s1, s2), SIS.complement (SIS.intersect (s1, s2)) )) | (Op(XOR, res1), Op(XOR, res2)) => mk(res1, res2) | (Op(XOR, res1), _) => mk(res1, [re2]) | (_, Op(XOR, res2)) => mk([re1], res2) | (re1, re2) => (case compare(re1, re2) of LESS => Op(XOR, [re1, re2]) | EQUAL => None (* FIXME is this right? *) | GREATER => Op(XOR, [re2, re1]) (* end case *)) (* end case *) end fun mkOp (OR, re1, re2) = mkOr(re1, re2) | mkOp (AND, re1, re2) = mkAnd(re1, re2) | mkOp (XOR, re1, re2) = mkXor(re1, re2) fun mkNot (Not re) = re | mkNot (None) = mkClosure(Any) | mkNot re = Not re fun mkOpt re = mkOr(Epsilon, re) fun mkRep (re, low, high) = let fun lowReps 0 = Epsilon | lowReps 1 = re | lowReps n = mkConcat (re, lowReps (n-1)) fun highReps 0 = Epsilon | highReps 1 = mkOpt re | highReps n = mkConcat (mkOpt re, highReps (n-1)) in if high < low then raise Subscript else mkConcat (lowReps low, highReps (high - low)) end fun mkAtLeast (re, 0) = mkClosure re | mkAtLeast (re, n) = mkConcat (re, mkAtLeast (re, n-1)) fun isNone None = true | isNone _ = false fun symToString w = "#\"" ^ (Char.toString (Char.chr (Word32.toInt w))) ^ "\"" handle Overflow => raise Fail "(BUG) RegExp: symToString on a nonascii character" fun SISToString s = let fun c2s c = if (c < 0w128) then Char.toString (Char.chr (Word32.toInt c)) else String.concat ["\\u", Word32.toString c] fun f (a, b) = if a=b then c2s a else concat[c2s a, "-", c2s b] (* we want to describe the interval set as concisely as possible, * so we compare the number of intervals in the set to the number * of intervals in its complement, and use the smaller of the two. *) val intervals = SIS.intervals s val intervals' = SIS.intervals (SIS.complement s) val (neg, rngs) = if List.length intervals < List.length intervals' then ("", intervals) else ("^", intervals') val str = neg ^ (String.concat (List.map f (rngs))) in if String.size str <= 1 then str else "[" ^ str ^ "]" end fun toString re = let fun opToString OR = "|" | opToString AND = "&" | opToString XOR = "^" fun opPrec OR = 0 | opPrec AND = 2 | opPrec XOR = 1 fun prec Any = 6 | prec None = 6 | prec Epsilon = 6 | prec (SymSet _) = 6 | prec (Concat[]) = 6 | prec (Concat _) = 3 | prec (Closure _) = 5 | prec (Op(_, [])) = 6 | prec (Op(_, [re])) = prec re | prec (Op(rator, _)) = opPrec rator | prec (Not _) = 4 fun toS (Any, l) = "{any}" :: l | toS (None, l) = "{none}" :: l | toS (Epsilon, l) = "{epsilon}" :: l | toS (SymSet s, l) = SISToString s :: l | toS (Concat[], l) = "" :: l | toS (Concat[re], l) = toS(re, l) | toS (Concat res, l) = toS'(res, 3, "", l) | toS (Closure re, l) = paren(5, re, "*" :: l) | toS (Op(_, []), l) = "{}" :: l | toS (Op(rator, [re]), l) = toS(re, l) | toS (Op(rator, res), l) = toS'(res, opPrec rator, opToString rator, l) | toS (Not re, l) = "!" :: paren(4, re, l) and toS' ([], p, rator, l) = raise Fail "empty" | toS' (re::r, p, rator, l) = paren(p, re, List.foldr (fn (re, l) => rator :: paren(p, re, l)) l r) and paren (p, re, l) = if (p <= prec re) then toS (re, l) else "(" :: toS(re, ")" :: l) in String.concat(toS(re, [])) end (* true iff epsilon is in the language recognized by the RE *) fun nullable Any = false | nullable None = false | nullable Epsilon = true | nullable (SymSet _) = false | nullable (Closure _) = true | nullable (Concat res) = List.all nullable res | nullable (Op(OR, res)) = List.exists nullable res | nullable (Op(AND, res)) = List.all nullable res | nullable (Op(XOR, re::r)) = (nullable re andalso not(List.exists nullable r)) orelse nullable(Op(XOR, r)) | nullable (Op(XOR, [])) = raise Fail "(BUG) RegExp: RE operator has no operands" | nullable (Not re) = not(nullable re) fun delta re = if (nullable re) then Epsilon else None (* compute derivative w.r.t. a symbol *) fun derivative a = let fun da Any = Epsilon | da None = None | da Epsilon = None | da (SymSet s) = if SIS.member(s, a) then Epsilon else None | da (re as Closure re') = mkConcat(da re', re) | da (Concat[]) = None | da (Concat[re]) = da re | da (Concat(re::res)) = mkOr( mkConcatList((da re)::res), mkConcat(delta re, da(Concat res))) | da (Op(_, [])) = raise Fail "(BUG) RegExp: RE operator has no operands" | da (Op(rator, [re])) = da re | da (Op(rator, re::res)) = mkOp(rator, da re, da(Op(rator, res))) | da (Not re) = mkNot(da re) in da end structure Map = RedBlackMapFn ( struct type ord_key = re Vector.vector val compare = Vector.collate compare end) (* yields the smallest partitioning of the alphabet that * "respects" the given sets. if S is one of the sets * returned by compress, then it must be either disjoint * with or a subset of each of the sets in the sets * parameter. see the implementation notes for more detail. *) fun compress sets = let (* performs partition of a set againt a list of sets, * assuming the list of sets is pairwise disjoint. *) fun part1 (set, []) = if SIS.isEmpty set then [] else [set] | part1 (set1, set2 :: ss) = if SIS.isEmpty set1 then set2 :: ss else let val i = SIS.intersect (set1, set2) in if SIS.isEmpty i then (set2 :: (part1 (set1, ss))) else let val s1 = SIS.difference (set1, i) val s2 = SIS.difference (set2, i) val ss' = if SIS.isEmpty s1 then ss else part1 (s1, ss) in if SIS.isEmpty s2 then (i :: ss') else (i :: s2 :: ss') end end in List.foldl part1 [] (SIS.universe::sets) end fun derivatives (res : re Vector.vector) = let (* ds is the "factoring function" *) fun ds Any = [SIS.universe] | ds None = [] | ds Epsilon = [] | ds (SymSet s) = [s] | ds (Closure re) = ds re | ds (Concat []) = [] | ds (Concat [re]) = ds re | ds (Concat (re::res)) = if nullable re then (ds re) @ (ds (Concat res)) else ds re | ds (Op(rator, res)) = List.concat (map ds res) | ds (Not re) = ds re val sets = Vector.foldl (fn (re, sets) => (ds re) @ sets) [] res val sets' = compress sets fun classes ([], classMap) = Map.listItemsi classMap | classes (set::sets, classMap) = let (* use first element as representative of the equiv class *) val (rep, _) = List.hd (SIS.intervals set) val derivs = Vector.map (derivative rep) res in case Map.find (classMap, derivs) of NONE => classes (sets, Map.insert(classMap, derivs, set)) | SOME set' => let val map' = Map.insert(classMap, derivs, SIS.union (set, set')) in classes (sets, map') end end in classes (sets', Map.empty) end end --- NEW FILE: sources.cm --- (* sources.cm * * COPYRIGHT (c) 2005 * John Reppy (http://www.cs.uchicago.edu/~jhr) * Aaron Turon ([email protected]) * All rights reserved. * *) Library structure Main is $/basis.cm $/smlnj-lib.cm $/pp-lib.cm $/ml-yacc-lib.cm FrontEnds/lex-spec.sml (* FrontEnds/ml-lex/ml-lex.lex : MLLex *) FrontEnds/ml-lex/ml-lex.lex.sml FrontEnds/ml-lex/ml-lex.yacc : MLYacc FrontEnds/ml-lex/ml-lex-input.sml BackEnds/lex-output-spec.sml BackEnds/output-sig.sml BackEnds/expand-file.sml BackEnds/Dot/dot-output.sml BackEnds/Dump/dump-output.sml BackEnds/Match/match.sml BackEnds/SML/ml.sml BackEnds/SML/sml-fun-output.sml lex-gen.sml reg-exp-sig.sml reg-exp.sml main.sml ------------------------------------------------------- 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