Object-like macros

1 files changed, 0 insertions, 286 deletions

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