summaryrefslogtreecommitdiff
path: root/cpp.sml
blob: 91f7f820bbd77e1d5cc00b3e96152c4774d4967f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
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