diff options
| -rw-r--r-- | cpp.fun | 31 | ||||
| -rw-r--r-- | general.sml | 2 | ||||
| -rw-r--r-- | stream.sig | 7 | ||||
| -rw-r--r-- | stream.sml | 54 | ||||
| -rw-r--r-- | tokenizer.fun | 17 | ||||
| -rw-r--r-- | tokenizer.sig | 4 |
6 files changed, 89 insertions, 26 deletions
@@ -91,7 +91,36 @@ functor Cpp(T: TOKENIZER): CPP = struct fun debugPrint fname = let val stream = create fname + val cache = T.S.pposCacheInit $ hd $ #fileInfo stream + + fun print' cache stream first = + let + val (tk, stream) = getToken stream + val ` = Int.toString + in + case tk of + T.NewLine => print' cache stream first + | T.EOS => () + | tk => + let + val ((line, col), cache') = T.S.pposCacheAdvance + (getLastPos stream) cache + fun printTk () = + print $ `col ^ ":" ^ T.token2str tk ^ " " + in + if T.S.pposCacheGetLine cache = line andalso not first then + printTk () + else + (if not first then print "\n" else (); + printLn $ T.S.pposCacheGetFname cache' ^ ":" ^ `line; + print "\t"; + printTk ()); + print' cache' stream false + end + end in - () + print' cache stream true; + print "\n" end + end diff --git a/general.sml b/general.sml index 0cf2ebd..cb4652a 100644 --- a/general.sml +++ b/general.sml @@ -23,8 +23,8 @@ in Unevaluated th => let val x = th () handle e => (value := Exn e; raise e) - val () = value := Evaluated x in + value := Evaluated x; x end | Evaluated v => v @@ -3,6 +3,7 @@ signature STREAM = sig type fileOffset = int type pos = fileId * fileOffset type ppos (* pretty pos *) + type pposCache type t type fileInfo = fileId * string * string @@ -10,7 +11,6 @@ signature STREAM = sig val convert: t -> fileInfo val ppos2str: ppos -> string - val printPos: fileInfo -> pos -> unit val getchar: t -> char option * t @@ -36,4 +36,9 @@ signature STREAM = sig (* throws IO.Io *) val create: string -> t + + val pposCacheInit: fileInfo -> pposCache + val pposCacheAdvance: pos -> pposCache -> (int * int) * pposCache + val pposCacheGetLine: pposCache -> int + val pposCacheGetFname: pposCache -> string end @@ -1,9 +1,16 @@ structure Stream :> STREAM = struct type fileId = int type fileOffset = int + type fileInfo = fileId * string * string + + type t = fileId * string * fileOffset * string + type pos = fileId * fileOffset type ppos = string * int * int option - type fileInfo = fileId * string * string + + type pposCache = + { id: fileId, fname: string, contents: string, + offset: fileOffset, line: int, col: int } exception UngetcError exception InvalidFileInfo @@ -17,31 +24,21 @@ structure Stream :> STREAM = struct | NONE => pos ^ ":" ^ %line end - type t = fileId * string * fileOffset * string - fun convert (fid, fname, _, contents) = (fid, fname, contents) - fun calcFilePos s offset = + fun calcFilePos (startOff, startPos) contents destOff = let - fun calc s cur offset (line, col) = - if cur = offset then + fun calc offset (line, col) = + if offset = destOff then (line, col) else - calc s (cur + 1) offset - (if String.sub (s, cur) = #"\n" then (line + 1, 1) - else (line, col + 1)) + calc (offset + 1) (if String.sub (contents, offset) = #"\n" + then (line + 1, 1) else (line, col + 1)) in - calc s 0 offset (1, 1) + calc startOff startPos end - fun printPos (_, fname, contents) (_, pos) = - let - val (line, col) = calcFilePos contents pos - val line = Int.toString line - val col = Int.toString col - in - print $ fname ^ ":" ^ line ^ ":" ^ col ^ ": " - end + val calcFilePosFromStart = calcFilePos (0, (1, 1)) fun getchar (S as (fid, fname, off, contents)) = if off < String.size contents then @@ -62,7 +59,7 @@ structure Stream :> STREAM = struct raise InvalidFileInfo else let - val (line, col) = calcFilePos contents pos + val (line, col) = calcFilePosFromStart contents pos in (fname, line, SOME col) end @@ -105,4 +102,23 @@ structure Stream :> STREAM = struct in returnToNL (offset - 1) end + + fun pposCacheInit (id, fname, contents) = + { id, fname, contents, offset = 0, line = 1, col = 1 } + + fun pposCacheAdvance (id, pos) (cache: pposCache) = + if id <> #id cache then + raise Unreachable + else + let + fun ` f = f cache + val p as (line, col) = calcFilePos (` #offset, (` #line, ` #col)) + (` #contents) pos + in + (p, { id = ` #id, fname = ` #fname, contents = ` #contents, + offset = pos, line, col }) + end + + fun pposCacheGetLine (cache: pposCache) = #line cache + fun pposCacheGetFname (cache: pposCache) = #fname cache end diff --git a/tokenizer.fun b/tokenizer.fun index 5cca203..4cb5d1d 100644 --- a/tokenizer.fun +++ b/tokenizer.fun @@ -29,6 +29,7 @@ struct kwConst | kwContinue | kwDefault | + kwDo | kwDouble | kwElse | kwEnum | @@ -36,6 +37,7 @@ struct kwFloat | kwFor | kwGoto | + kwIf | kwInt | kwLong | kwRegister | @@ -43,6 +45,7 @@ struct kwShort | kwSigned | kwSizeof | + kwStatic | kwStruct | kwSwitch | kwTypedef | @@ -50,6 +53,7 @@ struct kwUnsigned | kwVoid | kwVolatile | + kwWhile | LParen | RParen | @@ -121,7 +125,7 @@ struct CppError | CppPragma - val kwPrefix = #"@" + val kwPrefix = #"`" val cppPrefix = #"$" type fullToken = S.pos * token @@ -153,6 +157,7 @@ struct (kwConst, &"const"), (kwContinue, &"continue"), (kwDefault, &"default"), + (kwDo, &"do"), (kwDouble, &"double"), (kwElse, &"else"), (kwEnum, &"enum"), @@ -161,12 +166,14 @@ struct (kwFor, &"for"), (kwGoto, &"goto"), (kwInt, &"int"), + (kwIf, &"if"), (kwLong, &"long"), (kwRegister, &"register"), (kwReturn, &"return"), (kwShort, &"short"), (kwSigned, &"signed"), (kwSizeof, &"sizeof"), + (kwStatic, &"static"), (kwStruct, &"struct"), (kwSwitch, &"switch"), (kwTypedef, &"typedef"), @@ -174,6 +181,7 @@ struct (kwUnsigned, &"unsigned"), (kwVoid, &"void"), (kwVolatile, &"volatile"), + (kwWhile, &"while"), (LParen, "("), (RParen, ")"), @@ -271,7 +279,7 @@ struct getSfxRepr sfx buf (fn () => raise SuffixWithoutRepr) val token2str = fn - Id s => "id:" ^ s + Id s => s | Num (IntConst (it, str, sfx)) => let val intType = @@ -280,10 +288,10 @@ struct | ItOct => "0" | ItHex => "0x" in - intType ^ str ^ "`" ^ getSfxReprSimple sfx intSuffixRepr ^ "`" + intType ^ str ^ getSfxReprSimple sfx intSuffixRepr end | Num (FloatConst (str, sfx)) => - str ^ "`" ^ getSfxReprSimple sfx floatSuffixRepr ^ "`" + str ^ getSfxReprSimple sfx floatSuffixRepr | CharConst (repr, _) => repr | StringConst s => "\"" ^ s ^ "\"" @@ -860,6 +868,7 @@ struct | NONE => raise ExpectedCppDir end | formCppDir kwElse = CppElse + | formCppDir kwIf = CppIf | formCppDir _ = raise ExpectedCppDir fun handleCppDir tk prevPos stream = diff --git a/tokenizer.sig b/tokenizer.sig index c9626e0..d34f934 100644 --- a/tokenizer.sig +++ b/tokenizer.sig @@ -26,6 +26,7 @@ signature TOKENIZER = sig kwConst | kwContinue | kwDefault | + kwDo | kwDouble | kwElse | kwEnum | @@ -33,6 +34,7 @@ signature TOKENIZER = sig kwFloat | kwFor | kwGoto | + kwIf | kwInt | kwLong | kwRegister | @@ -40,6 +42,7 @@ signature TOKENIZER = sig kwShort | kwSigned | kwSizeof | + kwStatic | kwStruct | kwSwitch | kwTypedef | @@ -47,6 +50,7 @@ signature TOKENIZER = sig kwUnsigned | kwVoid | kwVolatile | + kwWhile | LParen | RParen | |