structure Cpp:> CPP = struct type tkPos = Stream.pos type t = { streams: Stream.t list, fileInfo: Stream.fileInfo list, lastPos: tkPos option, firstId: Stream.fileId }; datatype tkExp = Tk of Tokenizer.token | Id | NumConst | StrLiteral | UnOp | BinOp | Op type tkExpectedValue = string * tkExp list exception StreamTooOld exception TkExpected of tkExpectedValue fun create fname = let val stream = Stream.create fname val info = Stream.convert stream in { streams = [stream] , fileInfo = [info], lastPos = NONE, firstId = #1 info } end fun getToken ({ streams = stream :: tail, fileInfo, lastPos, firstId }: t) = let val (tk, stream) = Tokenizer.getToken stream in case tk of NONE => getToken { streams = tail, fileInfo, lastPos, firstId } | SOME (pos, tk) => ( tk, { streams = stream :: tail, fileInfo, lastPos = SOME pos, firstId }) end | getToken { streams = [], fileInfo, lastPos = SOME lastPos, firstId } = let val pos = SOME (#1 lastPos, ~1) (* EOF *) in (Tokenizer.EOS, {streams = [], fileInfo, lastPos = pos, firstId }) end | getToken { streams = [], fileInfo, lastPos = NONE, firstId } = (Tokenizer.EOS, { streams = [], fileInfo, lastPos = SOME (firstId, ~1), firstId }) fun getLastPos ({ lastPos = NONE, ... }: t) = raise Unreachable | getLastPos { lastPos = SOME p, ... } = p val tkExp2str = fn (Tk tk) => Tokenizer.token2str tk | Id: tkExp => "identifier" | NumConst => "numeric constant" | StrLiteral => "string literal" | UnOp => "unary operator" | BinOp => "binary operator" | Op => "operator" fun prepAndRaise (stream: t) (id, pos) expList = let val fileInfo = case List.find (fn (id', _, _) => id' = id) $ #fileInfo stream of NONE => raise StreamTooOld | SOME fileInfo => fileInfo val pos = Stream.ppos2str $ Stream.pos2pposWithFI (id, pos) fileInfo in raise TkExpected (pos, expList) end fun tkExpectedPrint (pos, expList) = let fun tkExps2str [e] [] = tkExp2str e | tkExps2str [e] acc = (String.concatWith ", " acc ^ " or ") ^ tkExp2str e | tkExps2str (e :: ec) acc = tkExps2str ec (tkExp2str e :: acc) | tkExps2str [] _ = raise Unreachable in print pos; print ":expected "; printLn $ tkExps2str expList [] end fun debugPrint fname = let val stream = create fname in () end end