From 52a6f8656e8a600a2c59fa2802fb46fafb30de45 Mon Sep 17 00:00:00 2001 From: Vladimir Azarov Date: Mon, 12 May 2025 01:51:27 +0200 Subject: Object-like macros --- cpp.fun | 286 ---------------------------------------------------------------- 1 file changed, 286 deletions(-) delete mode 100644 cpp.fun (limited to 'cpp.fun') diff --git a/cpp.fun b/cpp.fun deleted file mode 100644 index 8884a59..0000000 --- a/cpp.fun +++ /dev/null @@ -1,286 +0,0 @@ -functor Cpp(T: TOKENIZER): CPP = struct - - structure T = T - - type tkPos = T.S.pos - type t = - { streams: T.S.t list, fileInfo: T.S.fileInfo list, - lastPos: tkPos option, firstId: T.S.fileId, - incDirs: string list } - - datatype tkExp = - Tk of T.token | - Id | - NumConst | - StrLiteral | - UnOp | - BinOp | - Op - - type tkExpectedVal = string * tkExp list - - exception StreamTooOld - exception TkExpected of tkExpectedVal - - type tkErrorVal = string * string - exception TkError of tkErrorVal - - fun create fname incDirs = - let - val stream = T.S.create fname - val info = T.S.convert stream - in - { streams = [stream] , fileInfo = [info], lastPos = NONE, - firstId = #1 info, incDirs } - end - - fun getLastPos ({ lastPos = NONE, ... }: t) = raise Unreachable - | getLastPos { lastPos = SOME p, ... } = p - - fun getTopFileInfo ({ streams = top :: _, ... }: t) = T.S.convert top - | getTopFileInfo _ = raise Unreachable - - val tkExp2str = fn - (Tk tk) => T.token2str tk - | Id: tkExp => "identifier" - | NumConst => "numeric constant" - | StrLiteral => "string literal" - | UnOp => "unary operator" - | BinOp => "binary operator" - | Op => "operator" - - fun tkPos2str stream (id, pos) = - let - val fileInfo = - case List.find (fn (id', _, _) => id' = id) $ #fileInfo stream of - NONE => raise StreamTooOld - | SOME fileInfo => fileInfo - in - T.S.ppos2str $ T.S.pos2pposWithFI (id, pos) fileInfo - end - - fun prepTkError stream pos msg = raise TkError (tkPos2str stream pos, msg) - fun prepLastTkError stream = prepTkError stream (getLastPos stream) - - fun prepTkExpected (stream: t) pos expList = - raise TkExpected (tkPos2str stream pos, expList) - fun prepLastTkExpected stream = prepTkExpected stream - (getLastPos stream) - - 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 tkErrorPrint (pos, msg) = printLn $ pos ^ ": " ^ msg - - exception EmptyPath - - fun getDirOfCurFile ({ streams = top :: _, ... }: t) = - OS.Path.getParent $ T.S.getFname top - | getDirOfCurFile _ = raise Unreachable - - - (* TODO: properly handle Size and Path exceptions from concat *) - fun findPath _ "" _ = raise EmptyPath - | findPath stream fname true = - let - val path = OS.Path.concat (getDirOfCurFile stream, fname) - in - (path, TextIO.openIn path) - end - | findPath stream fname false = - let - fun try (dir :: tail) = - let - val fname = OS.Path.concat (dir, fname) - in - SOME (fname, TextIO.openIn fname) handle _ => try tail - end - | try [] = NONE - - val instream = try (#incDirs stream) - in - case instream of - NONE => findPath stream fname true - | SOME pair => pair - end - - fun predSkip stream pred = - let - val (c, stream) = T.S.getchar stream - in - case c of - NONE => (NONE, stream) - | SOME c => - if c = #"\n" then - (NONE, stream) - else if pred c then - (SOME $ #2 $ T.S.getPosAfterCharRead stream, stream) - else - predSkip stream pred - end - - fun tryCollect stream = - let - val top = hd $ #streams stream - - fun x f = f stream - - fun returnBack top = { - streams = top :: tl (#streams stream), - fileInfo = x#fileInfo, - lastPos = x#lastPos, - firstId = x#firstId, - incDirs = x#incDirs - } - - val (start, s) = - case predSkip top (fn c => c = #"<") of - (NONE, _) => raise Unreachable - | (SOME p, s) => (p, s) - - val (res, s) = predSkip s (fn c => c = #">") - in - case res of - NONE => (NONE, stream) - | SOME endOff => - (SOME $ T.S.getSubstr (start + 1) endOff s, returnBack s) - end - - fun getToken - ({ streams = stream :: tail, fileInfo, lastPos, firstId, incDirs }: t) = - let - val (tk, stream) = T.getToken stream - in - case tk of - NONE => getToken { streams = tail, fileInfo, lastPos, firstId, incDirs } - | SOME (pos, tk) => - if tk = T.CppInclude then - handleInclude { streams = stream :: tail, fileInfo, - lastPos, firstId, incDirs } - else - (tk, { streams = stream :: tail, fileInfo, - lastPos = SOME pos, firstId, incDirs }) - end - | getToken - { streams = [], fileInfo, lastPos = SOME lastPos, firstId, incDirs } = - let - val pos = SOME (#1 lastPos, ~1) (* EOF *) - in - (T.EOS, {streams = [], fileInfo, lastPos = pos, firstId, incDirs }) - end - | getToken { streams = [], fileInfo, lastPos = NONE, firstId, incDirs } = - (T.EOS, { streams = [], fileInfo, - lastPos = SOME (firstId, ~1), firstId, incDirs }) - - and handleInclude (stream: t) = - let - val (tk, streamNew) = getToken stream - - fun die () = - prepLastTkError streamNew - "#include with macro argument is not implemented" - in - case tk of - T.StringConst path => includeFile streamNew path true - | T.EOS => die () - | tk => - if String.sub (T.token2str tk, 0) = #"<" then - let - val (path, stream) = tryCollect stream - in - case path of - SOME path => includeFile stream path false - | NONE => die () - end - else - die () - end - - and includeFile stream fname localhdr = - let - val (fname, instream) = findPath stream fname localhdr - handle EmptyPath => - prepLastTkError stream "#include path can not be empty" - val newStream = T.S.createFromInstream fname instream - val newFileInfo = T.S.convert newStream - in - getToken { - streams = newStream :: #streams stream, - fileInfo = newFileInfo :: #fileInfo stream, - lastPos = #lastPos stream, - firstId = #firstId stream, - incDirs = #incDirs stream - } - end - - - fun debugPrintToken cache tk (line, col) printLineRegardless = - let - val ` = Int.toString - in - if printLineRegardless orelse T.S.pposCacheGetLine cache <> line then - print $ "\n" ^ T.S.pposCacheGetFname cache ^ ":" ^ `line ^ "\n\t" - else - (); - print $ `col ^ ":" ^ T.token2str tk ^ " " - end - - fun adjustCacheStack (s as (top :: rest)) pos stream = - let - fun idMatches cache = T.S.pposCacheGetId cache = #1 pos - fun metBefore [] = NONE - | metBefore (c :: cs) = - if idMatches c then - SOME (c :: cs) - else - metBefore cs - in - if idMatches top then - (false, s) - else - (true, case metBefore rest of - NONE => T.S.pposCacheInit (getTopFileInfo stream) :: s - | SOME stack => stack) - end - | adjustCacheStack _ _ _ = raise Unreachable - - fun debugPrint' cacheStack stream first = - let - val (tk, stream) = getToken stream - in - case tk of - T.NewLine => debugPrint' cacheStack stream first - | T.EOS => () - | tk => - let - val pos = getLastPos stream - val (stackChanged, cacheStack) = - adjustCacheStack cacheStack pos stream - - val oldTop = hd cacheStack - val (pair, top) = T.S.pposCacheAdvance pos oldTop - in - debugPrintToken oldTop tk pair (first orelse stackChanged); - debugPrint' (top :: tl cacheStack) stream false - end - end - - fun debugPrint stream = - let - val cache = T.S.pposCacheInit $ hd $ #fileInfo stream - in - debugPrint' [cache] stream true; - print "\n" - end -end -- cgit v1.2.3