diff options
| -rw-r--r-- | ccross.sml | 6 | ||||
| -rw-r--r-- | common.sml | 3 | ||||
| -rw-r--r-- | doc/c89-draft.html | 1 | ||||
| -rw-r--r-- | exn_handler.fun | 11 | ||||
| -rw-r--r-- | hashtable.sml | 4 | ||||
| -rw-r--r-- | ppc.fun | 228 | ||||
| -rw-r--r-- | ppc.sig | 12 | ||||
| -rw-r--r-- | tokenizer.fun | 54 | ||||
| -rw-r--r-- | tokenizer.sig | 4 |
9 files changed, 122 insertions, 201 deletions
@@ -1,13 +1,9 @@ structure ccross:> CCROSS = struct structure T:> TOKENIZER = Tokenizer(structure H = Hashtable; structure S = Stream) - structure ppc:> PPC = ppc(structure Tree = Tree; structure T = T) - structure D:> DRIVER = Driver(ppc) - - structure ExnHandler:> EXN_HANDLER = - ExnHandler(structure T = T; structure P = ppc) + structure ExnHandler: EXN_HANDLER = ExnHandler end val () = MLton.Exn.setTopLevelHandler ccross.ExnHandler.handler @@ -36,6 +36,7 @@ structure Fold = struct fun step0 h (a, f) = fold (h a, f) fun step1 h (a, f) b = fold (h (b, a), f) fun step2 h (a, f) b c = fold (h (b, c, a), f) + fun step3 h (a, f) b c d = fold (h (b, c, d, a), f) end structure FRU = struct @@ -128,6 +129,8 @@ in (ifF ign (fn () => f output); (ign, output))) z fun A1 z = Fold.step2 (fn (f, v, (ign, output)) => (ifF ign (fn () => f (output, v)); (ign, output))) z + fun A2 z = Fold.step3 (fn (f, v1, v2, (ign, output)) => + (ifF ign (fn () => f (output, v1, v2)); (ign, output))) z end fun Ign z = Fold.step0 (fn (_, output) => (true, output)) z diff --git a/doc/c89-draft.html b/doc/c89-draft.html index c86e957..a74fade 100644 --- a/doc/c89-draft.html +++ b/doc/c89-draft.html @@ -2,7 +2,6 @@ <HEAD>
<!-- Meta http equivalent was here -->
<TITLE>The C89 Draft</TITLE>
-<LINK href="c89-draft.css" rel="stylesheet"></HEAD>
<BODY>
<H1>The C89 Draft</H1>
<FONT size="-1">
diff --git a/exn_handler.fun b/exn_handler.fun index b4e7275..c0a2d7a 100644 --- a/exn_handler.fun +++ b/exn_handler.fun @@ -1,6 +1,4 @@ -functor ExnHandler(structure T: TOKENIZER; structure P: PPC): - EXN_HANDLER = -struct +structure ExnHandler: EXN_HANDLER = struct val eprintf = fn z => printf `"error: " z @@ -31,12 +29,7 @@ struct fun handler e = ( printf `"\n"; case e of - T.FsmTableIsTooSmall => - eprintf `"fsm table is too small. Increate 'maxState' value\n" % - | IO.Io _ => ioExn e - | T.TkErrorAug (pos, msg) => eprintf T.S.Ppos pos `": " `msg `"\n" % - | P.TkError v => P.tkErrorPrint v - | P.TkClassError v => P.tkClassErrorPrint v + IO.Io _ => ioExn e | _ => otherExn e; exit 1 ) handle _ => sysExit 127 diff --git a/hashtable.sml b/hashtable.sml index 6ec7277..822d1fd 100644 --- a/hashtable.sml +++ b/hashtable.sml @@ -39,12 +39,12 @@ structure Hashtable: HASHTABLE = struct fun next idx mask = (idx + `1) andb mask - fun lookup2 ((array, _, mask): 'a t) (key: string) f g = + fun lookup2 (array, _, mask) key f g = let fun find idx = case sub (array, !idx) of NONE => g () - | SOME (key', v: 'a) => + | SOME (key', v) => if key' = key then case f v of (NONE, res) => res @@ -17,7 +17,6 @@ struct buffer: layer list, macros: (string, bool * T.S.pos * macro) Tree.t, - debugMode: bool, incDirs: string list } @@ -26,9 +25,6 @@ struct val insertMacro = Tree.insert macroCompare val macrosLookup = fn z => Tree.lookup2 macroCompare z - type tkErrorVal = tkPos * string - exception TkError of tkErrorVal - datatype tkClass = Ctk of T.token | Cid | @@ -37,57 +33,53 @@ struct Cbinop | Cop - type tkClassErrorVal = tkPos * tkClass list - exception TkClassError of tkClassErrorVal - fun pos2tkPos pos = TkPos (pos, []) + fun tkPos2pos (TkPos (pos, [])) = pos + | tkPos2pos _ = raise Unreachable val dummyEOSpos = pos2tkPos $ T.S.Pos ("<Unreachable>", 0, 0) - fun raiseTkError pos msg = raise TkError (pos, msg) - fun raiseTkErrorP pos g = - sprintf (fn (a, f) => g (a, raiseTkError pos o f)) + val PlayersU = fn z => + let + fun PlayersU (out, ((macroName, pos) :: layers)) = + Printf out `"\tfrom " `macroName `" at " T.S.Ppos pos `"\n" + A1 PlayersU layers % + | PlayersU (_, []) = () + in + bind A1 PlayersU + end z - fun printLayersU ((macroName, pos) :: layers) = ( - printf `"\tfrom " `macroName `" at " T.S.Ppos pos `"\n" %; - printLayersU layers - ) - | printLayersU [] = () + fun warningLow (TkPos (pos, layers)) msg f g = + printf `"\n" T.S.Ppos pos `":" `msg `": " + (fn (a, _) => g (a, fn (_, out) => + (Printf out `"\n" PlayersU layers %; f ()))) - fun tkErrorPrint (TkPos (pos, layers), msg) = ( - printf T.S.Ppos pos `": " `msg `"\n" %; - printLayersU layers - ) + fun warning pos g = warningLow pos "warning" (fn () => ()) g + fun error pos g = warningLow pos "error" (fn () => exit 1) g - fun raiseTkClassError pos cls = raise TkClassError (pos, cls) + fun errorSpos pos g = error (pos2tkPos pos) g - fun tkClassErrorPrint (TkPos (pos, layers), cls) = + fun clerror (TkPos (pos, layers)) cls = let - val printCtk = fn - Ctk tk => printf T.Ptk tk % - | Cid => printf `"identifier" % - | Cconst => printf `"constant" % - | Cunop => printf `"unary operator" % - | Cbinop => printf `"binary operator" % - | Cop => printf `"operator" % + fun Pcl (out, cl) = + case cl of + Ctk tk => Printf out T.Ptk tk % + | Cid => Printf out `"identifier" % + | Cconst => Printf out `"constant" % + | Cunop => Printf out `"unary operator" % + | Cbinop => Printf out `"binary operator" % + | Cop => Printf out `"operator" % - fun printClassList [] = raise Unreachable - | printClassList [ctk] = printCtk ctk - | printClassList [ctk1, ctk2] = ( - printCtk ctk1; - printf `" or "; - printCtk ctk2 - ) - | printClassList (ctk :: ctks) = ( - printCtk ctk; - printf `", "; - printClassList ctks - ) + fun Pcls (_, []) = raise Unreachable + | Pcls (out, [cl]) = Printf out A1 Pcl cl % + | Pcls (out, [cl1, cl2]) = + Printf out A1 Pcl cl1 `" or " A1 Pcl cl2 % + | Pcls (out, cl :: cls) = + Printf out A1 Pcl cl `", " A1 Pcls cls % in - printf T.S.Ppos pos `": expected " %; - printClassList cls; - printf `"\n"; - printLayersU layers + printf `"\n" T.S.Ppos pos `":error: expected " A1 Pcls cls `"\n" + PlayersU layers; + exit 1 end val updatePpc = fn z => @@ -114,13 +106,6 @@ struct printLayers out layers ) - val Players = fn z => - let - fun Players (out, layers) = printLayers out layers - in - bind A1 Players - end z - fun convPos (T.S.Pos (fname, line, col)) plen = let val fname = String.extract (fname, plen, NONE) @@ -141,8 +126,8 @@ struct findPrefix' 0 s1 s2 end - fun PlayersCompact (_, (_, [])) = "" - | PlayersCompact (out, (startPrx, L as (layer :: layers))) = + fun PlayersCompact (_, _, []) = "" + | PlayersCompact (out, startPrx, L as (layer :: layers)) = let fun getFname (_, T.S.Pos (fname, _, _)) = fname @@ -173,7 +158,7 @@ struct [] => Printf out `fname' `":" I line' `"| \t" % | _ => let - val prefix = PlayersCompact (out, (SOME fname', layers')) + val prefix = PlayersCompact (out, SOME fname', layers') val fname' = String.extract (fname', size prefix, NONE) in Printf out `"; @" `fname' `":" I line' `"| \t" % @@ -187,40 +172,22 @@ struct (off, layers', (fname', line')) end - val PtkPos = fn z => - let - fun PtkPos (out, TkPos (pos, layers)) = ( - if layers <> [] then - Printf out `"(" Players layers `") " % - else - (); - Printf out T.S.Ppos pos % - ) - in - bind A1 PtkPos - end z - - fun warning (TkPos (pos, layers)) g = - printf `"\n" T.S.Ppos pos `":warning: " - (fn (a, _) => g (a, fn (_, output) => - (output "\n"; printLayersU layers))) - - val printMacroHeader = fn z => + val PmacroHeader = fn z => let - fun printMacroHeader (out, (id, mLayers)) = + fun printMacroHeader (out, id, mLayers) = let - fun Players (out, v) = ignore $ PlayersCompact (out, v) + fun Players (out, x, y) = ignore $ PlayersCompact (out, x, y) in - Printf out `"\nexpanding (" A1 Players (NONE, rev mLayers) + Printf out `"\nexpanding (" A2 Players NONE (rev mLayers) `") macro " `id % end in - bind A1 printMacroHeader + bind A2 printMacroHeader end z - val printTokenL = fn z => + val PtokenL = fn z => let - fun printTokenL (out, (offset, l)) = + fun printTokenL (out, offset, l) = let fun printList _ [] = () | printList cache (tk :: tail) = @@ -246,7 +213,7 @@ struct Printf out `"\n" % end in - bind A1 printTokenL + bind A2 printTokenL end z fun updateH head = fn s => Stream head :: tl s @@ -280,14 +247,14 @@ struct end | getTokenNoexpand ppc = (T.EOS, dummyEOSpos, ppc) - fun checkClass (tk, pos) clList raiseClassErr = + fun checkClass (tk, pos) clList = let fun belongsToClass tk (Ctk tk') = tk = tk' | belongsToClass (T.Id _) (Cid) = true | belongsToClass _ Cid = false | belongsToClass _ _ = raise Unreachable - fun checkClass' [] = raiseClassErr pos clList + fun checkClass' [] = clerror pos clList | checkClass' (cl :: tail) = if belongsToClass tk cl then () @@ -297,16 +264,16 @@ struct checkClass' clList end - fun getClassGeneric clList getToken raiseClassErr buf = + fun getClassGeneric clList getToken ppc = let - val (tk, pos, buf) = getToken buf - val () = checkClass (tk, pos) clList raiseClassErr + val (tk, pos, ppc) = getToken ppc + val () = checkClass (tk, pos) clList in - (tk, pos, buf) + (tk, pos, ppc) end - fun getClassNoexpand (ppc: t) clList = - getClassGeneric clList getTokenNoexpand raiseTkClassError ppc + fun getClassNoexpand ppc clList = + getClassGeneric clList getTokenNoexpand ppc datatype IncludeArg = LocalInc of string * string | ExternalInc of string @@ -319,8 +286,8 @@ struct in (path, instream) end handle - OS.Path.Path => raiseTkError pos "invalid argument" - | Size => raiseTkError pos "resulting path is too long" + OS.Path.Path => errorSpos pos `"invalid argument" % + | Size => errorSpos pos `"resulting path is too long" % | IO.Io v => raise IO.Io v ) | ExternalInc arg => @@ -336,19 +303,19 @@ struct in case try incDirs of SOME pair => pair - | NONE => raiseTkError pos "unable to find header" + | NONE => errorSpos pos `"unable to find header" % end fun checkEndsWith pos arg c = let fun find i = if i = size arg then - raiseTkError pos "unfinished #include argument" + errorSpos pos `"unfinished #include argument" % else if String.sub (arg, i) = c then if i + 1 = size arg then String.extract (arg, 1, SOME $ size arg - 2) else - raiseTkError pos "some garbage after #include argument" + errorSpos pos `"some garbage after #include argument" % else find (i + 1) in @@ -359,7 +326,7 @@ struct let fun eatSpaces s off = if off = size s then - raiseTkError pos "invalid #include argument" + errorSpos pos `"invalid #include argument" % else if String.sub (s, off) = #" " then eatSpaces s (off + 1) else @@ -374,7 +341,7 @@ struct else if start = #"<" then ExternalInc $ check #">" else - raiseTkError pos "invalid #include argument" + errorSpos pos `"invalid #include argument" % end fun dprintf ppc = @@ -383,11 +350,13 @@ struct else printf Ign + val PDP = fn z => bind A0 (fn out => out "\n!!! ") z + fun handleInclude (T.PpcInclude (dir, arg), pos) ppc = let val arg = parseIncludeArg pos arg dir val (path, instream) = findFile pos arg (#incDirs ppc) - val () = dprintf ppc `"\n#include: " `path % + val () = dprintf ppc PDP T.S.Ppos pos `": #include: " `path % val stream = T.S.createFromInstream path instream in updatePpc ppc u#buffer (fn buf => Stream stream :: buf) % @@ -400,7 +369,7 @@ struct in case tk of T.NewLine => (acc, ppc) - | T.EOS => raiseTkClassError pos [Ctk T.NewLine] + | T.EOS => clerror pos [Ctk T.NewLine] | _ => getDefineMacroBody ppc ((tk, pos) :: acc) end @@ -416,7 +385,7 @@ struct () else ( Printf out `" {"; - Printf out printTokenL (1, body); + Printf out PtokenL 1 body; Printf out `"}" % ) @@ -433,7 +402,7 @@ struct fun validateArg (id, _) [] = id | validateArg (id, pos) ((id', pos') :: tail) = if id = id' then - raiseTkError pos' "macro argument name is already taken" + error pos' `"macro argument name is already taken" % else validateArg (id, pos) tail @@ -506,11 +475,11 @@ struct fun parseDefine ppc = let val (macroName, pos, ppc) = getClassNoexpand ppc [Cid] - val TkPos (pos, _) = pos + val pos = tkPos2pos pos val macroName = case macroName of T.Id id => id | _ => raise Unreachable - val () = dprintf ppc `"\n#define " `macroName % + val () = dprintf ppc PDP T.S.Ppos pos `": #define " `macroName % val parser = if isFuncMacroDefine (size macroName) pos ppc then @@ -571,15 +540,15 @@ struct updatePpc ppc u#buffer f % end - val printBody = fn z => + val Pbody = fn z => let - fun printBody (out, (msg, body)) = ( + fun printBody (out, msg, body) = ( Printf out `"\n" `msg `" {"; - Printf out printTokenL (1, body); + Printf out PtokenL 1 body; Printf out `"}\n" % ) in - bind A1 printBody + bind A2 printBody end z datatype collectCtx = @@ -592,8 +561,8 @@ struct val mLayers = addLayer (id, pos) in - dprintf ppc printMacroHeader (id, mLayers); - dprintf ppc printBody ("body", rev revBody); + dprintf ppc PmacroHeader id mLayers; + dprintf ppc Pbody "body" (rev revBody); insertRevBody revBody ppc end @@ -605,7 +574,7 @@ struct val (tk, pos, ppc) = getTokenNoexpand ppc in if T.isPpcDir tk then - raiseTkError pos "preprocessor directive inside macro arguments" + error pos `"preprocessor directive inside macro arguments" % else (tk, pos, ppc) end @@ -615,7 +584,7 @@ struct val (tk, pos, ppc) = getTokenRestricted ppc in case tk of - T.EOS => raiseTkError mPos "unfinished argument list" + T.EOS => error mPos `"unfinished argument list" % | T.Coma => (true, rev acc, ppc) | T.RParen => (false, rev acc, ppc) | _ => parseArg ppc ((tk, pos) :: acc) @@ -623,7 +592,7 @@ struct fun parseArgs ppc params acc = let - fun bind _ [] = raiseTkError mPos "too many arguments" + fun bind _ [] = error mPos `"too many arguments" % | bind body (param :: params) = ((param, body), params) val (continue, arg, ppc) = parseArg ppc [] @@ -633,13 +602,13 @@ struct parseArgs ppc otherParams (bindedParam :: acc) else if length otherParams > 0 then - raiseTkError mPos "not enough arguments" + error mPos `"not enough arguments" % else (rev (bindedParam :: acc), ppc) end val (_, _, ppc) = getClassGeneric [Ctk T.LParen] - getTokenRestricted raiseTkClassError ppc + getTokenRestricted ppc val (res, ppc) = parseArgs ppc params [] in (res, ppc) @@ -689,7 +658,7 @@ struct fun print [] = () | print ((p, args) :: tail) = ( Printf out `p `": "; - Printf out printTokenL (1, args); + Printf out PtokenL 1 args; print tail ) in @@ -712,7 +681,7 @@ struct end fun apply f bp = List.map (fn (p, arg) => (p, f arg)) bp - val () = dprintf ppc printMacroHeader (id, mLayers) % + val () = dprintf ppc PmacroHeader id mLayers % val (bindedParams, ppc) = parseFuncMacroArgs mPos params ppc val bp1 = apply addLayers2args bindedParams @@ -724,7 +693,7 @@ struct val body = setLayers (id, mPos) body val body = subst (id, mPos) bp2 body [] in - dprintf ppc printBody ("subst", body); + dprintf ppc Pbody "subst" body; insertRevBody (rev body) ppc end @@ -736,8 +705,7 @@ struct fun def dl = collect (level + dl) ppc ((tk, pos) :: acc) fun unexpected tk prevTk = - raiseTkErrorP pos - `"unexpected " T.Ptk tk `" inside " T.Ptk prevTk % + error pos `"unexpected " T.Ptk tk `" inside " T.Ptk prevTk % fun handleIfdef ifTk = if tk = T.PpcElif then @@ -757,7 +725,7 @@ struct | AfterElif => def 0 in case tk of - T.EOS => raiseTkError ifPos "unfinished conditional directive" + T.EOS => errorSpos ifPos `"unfinished conditional directive" % | T.PpcEndif => if level = 0 then if ctx = AfterElif then @@ -841,7 +809,7 @@ struct else (not defined, "ifndef") in - dprintf ppc `"\n" PtkPos ifPos `": #" `form `" " `id `" -> " B cond %; + dprintf ppc PDP T.S.Ppos ifPos `": #" `form `" " `id `" -> " B cond %; (cond, ppc) end @@ -852,13 +820,13 @@ struct val (tk, _, ppc) = getTokenNoexpand ppc in case tk of - T.EOS => raiseTkError ifPos "unfinished #if condition" + T.EOS => errorSpos ifPos `"unfinished #if condition" % | T.NewLine => ppc | _ => skip ppc end val cond = true in - dprintf ppc `"\n" PtkPos ifPos `": #if -> " B cond `" (skipping)" %; + dprintf ppc PDP T.S.Ppos ifPos `": #if -> " B cond `" (skipping)" %; (cond, skip ppc) end @@ -875,7 +843,7 @@ struct val (cond, ppc) = eval ifPos ppc val (revBody, ppc) = getRevBody ifPos cond ppc in - dprintf `" {" printTokenL (1, rev revBody) `"}\n"; + dprintf `" {" PtokenL 1 (rev revBody) `"}\n"; insertRevBody revBody ppc end @@ -921,10 +889,12 @@ struct | _ => def () end + and handleStray (tk, pos) _ = errorSpos pos `"stray " T.Ptk tk % + and ppcFallback (_, pos) _ = - raiseTkError pos "directive is not implemented" + errorSpos pos `"directive is not implemented" % - and handleToken tk pos (ppc: t) = + and handleToken tk pos ppc = let fun %tk = fn tk' => tk' = tk val directiveTable = [ @@ -934,16 +904,16 @@ struct (%T.PpcIfndef, handleIf), (%T.PpcUndef, handleUndef), (%T.PpcIf, handleIf), - (%T.PpcElse, ppcFallback), - (%T.PpcElif, ppcFallback), - (%T.PpcEndif, ppcFallback), + (%T.PpcElse, handleStray), + (%T.PpcElif, handleStray), + (%T.PpcEndif, handleStray), (%T.PpcWarning, ppcFallback), (%T.PpcError, ppcFallback), (%T.PpcPragma, ppcFallback) ] in case List.find (fn (f, _) => f tk) directiveTable of - SOME (_, f) => getToken $ f (tk, pos) ppc + SOME (_, f) => getToken $ f (tk, tkPos2pos pos) ppc | NONE => handleRegularToken tk pos ppc end @@ -1002,6 +972,6 @@ struct | _ => (tk, pos, ppc) end in - getClassGeneric clList getTokenSkipNL raiseTkClassError ppc + getClassGeneric clList getTokenSkipNL ppc end end @@ -3,14 +3,8 @@ signature PPC = sig structure T: TOKENIZER type t - type tkErrorVal - type tkClassErrorVal type tkPos - exception TkError of tkErrorVal - exception TkClassError of tkClassErrorVal - - datatype tkClass = Ctk of T.token | Cid | @@ -23,10 +17,4 @@ signature PPC = sig val debugPrint: string -> string list -> unit val getClass: t -> tkClass list -> T.token * tkPos * t - - val raiseTkError: tkPos -> string -> 'a - val tkErrorPrint: tkErrorVal -> unit - - val raiseTkClassError: tkPos -> tkClass list -> 'a - val tkClassErrorPrint: tkClassErrorVal -> unit end diff --git a/tokenizer.fun b/tokenizer.fun index 5b5f436..24e0211 100644 --- a/tokenizer.fun +++ b/tokenizer.fun @@ -129,9 +129,8 @@ struct datatype tkErrorAuxInfo = TkiEOF | TkiDx of int | TkiStart exception TkError of tkErrorAuxInfo * string - exception TkErrorAug of S.pos * string - exception FsmTableIsTooSmall + fun error pos msg = (printf `"\n" S.Ppos pos `": " `msg `"\n" %; exit 1) (* Unreachable (should be) *) exception TokenWithoutRepr @@ -392,8 +391,9 @@ struct val tokenRepr = filterNeeded tokenRepr [] - fun fsmInsert' T curState tk repr = fsmInsert T curState tk repr handle - Subscript => raise FsmTableIsTooSmall + fun fsmInsert' T curState tk repr = fsmInsert T curState tk repr + handle Subscript => + die 2 `"fsm table is too small. Increate 'maxState' value\n" % in while !r < length buf do ( update (buf, !r, (Invalid, array(128, ~1))); @@ -472,12 +472,12 @@ struct (tk, pos, stream) end - fun tkError2aug stream (dx, msg) = + fun errorDx stream dx msg = let val off = S.getOffset stream - 1 + dx val (pos, _) = S.getPosRaw off stream in - TkErrorAug (pos, msg) + error pos msg end fun parserWrapper stream parser acc = @@ -492,13 +492,13 @@ struct val (c, stream) = S.getchar stream val (acc, tk, stream) = parser acc (stream, startOff) c handle - TkError (TkiDx dx, msg) => raise tkError2aug stream (dx, msg) - | TkError (TkiStart, msg) => raise TkErrorAug (pos, msg) + TkError (TkiDx dx, msg) => errorDx stream dx msg + | TkError (TkiStart, msg) => error pos msg | TkError (TkiEOF, msg) => let val (pos, _) = S.EOFpos stream in - raise TkErrorAug (pos, msg) + error pos msg end in case tk of @@ -868,7 +868,7 @@ struct in case line of SOME line => (PpcInclude (getDir stream, line), stream) - | NONE => raise TkErrorAug (pos, "line does not end with '\n'\n") + | NONE => error pos "line does not end with '\\n'" end fun isPpcDir (PpcInclude _) = true @@ -880,8 +880,7 @@ struct fun handlePpcDir (tk, pos) stream = let open String - fun error () = - raise TkErrorAug (pos, "expected preprocessor directive") + val error = fn () => error pos "expected preprocessor directive" fun getById id = let @@ -904,29 +903,6 @@ struct | _ => error () end - (* - fun formPpcDir (Id s) = - let - open String - in - case List.find - (fn (_, repr) => - sub (repr, 0) = ppcPrefix andalso - extract (repr, 1, NONE) = s) - tokenRepr - of - SOME (tk, _) => tk - | NONE => raise ExpectedPpcDir - end - | formPpcDir kwElse = PpcElse - | formPpcDir kwIf = PpcIf - | formPpcDir _ = raise ExpectedPpcDir - - fun handlePpcDir (pos, tk) stream = - formPpcDir tk stream handle ExpectedPpcDir => - raise TkErrorAug (pos, "expected preprocessor directive") - *) - fun unexpectedCharRaise stream c = let val (pos, _) = S.getPosAfterChar stream @@ -936,7 +912,7 @@ struct else "<" ^ Int.toString (ord c) ^ ">" in - raise TkErrorAug (pos, "unexpected character " ^ repr) + error pos ("unexpected character " ^ repr) end fun skipComment stream pos = @@ -945,7 +921,7 @@ struct let val (c, stream) = case S.getchar stream of - (NONE, _) => raise TkErrorAug (pos, "unfinished comment") + (NONE, _) => error pos "unfinished comment" | (SOME c, stream) => (c, stream) in if prevIsAsterisk andalso c = #"/" then @@ -965,7 +941,7 @@ struct let val (pos, _) = S.getPosAfterChar stream in - raise TkErrorAug (pos, "expected \\n after backslash") + error pos "expected \\n after backslash" end in case c of @@ -990,7 +966,7 @@ struct val (tk, pos', stream) = getToken stream in if tk = EOS then - raise TkErrorAug (pos, "unfinished preprecessor directive") + error pos "unfinished preprecessor directive" else let val (tk, stream) = handlePpcDir (tk, pos') stream diff --git a/tokenizer.sig b/tokenizer.sig index 91de93a..a1f5c28 100644 --- a/tokenizer.sig +++ b/tokenizer.sig @@ -123,10 +123,6 @@ signature TOKENIZER = sig PpcError | PpcPragma - (* Fatal. both may be thrown by tokenize *) - exception FsmTableIsTooSmall - exception TkErrorAug of S.pos * string - val getToken: S.t -> token * S.pos * S.t val Ptk: (token, 'a, 'b) a1printer |