src/sml/reader.sml~

   1 (* Reader *)
   2
   3 datatype Sexpr = Void
   4            | Nil
   5            | Pair of Sexpr * Sexpr
   6            | Vector of Sexpr list
   7            | Symbol of string
   8            | String of string
   9            | Number of int
  10            | Bool of bool
  11            | Char of char;
  12
  13 signature READER =
  14 sig
  15     val stringToSexpr : string -> Sexpr;
  16     val stringToSexprs : string -> Sexpr list;
  17 end;
  18
  19 (* *********************************************************** Reader *)
  20
  21 exception ErrorNoSexprAfterQuote;
  22 exception ErrorNoClosingRparen;
  23 exception ErrorMissingSexprAfterDot;
  24 exception ErrorInvalidPairSyntax;
  25 exception ErrorCannotReadAllSexprs of (Sexpr list) * (SchemeToken list);
  26 exception ErrorMoreThanOneSexpr;
  27
  28 structure Reader : READER =
  29 struct
  30 fun getSexpr([], retSexprAndTokens, retNone) = retNone()
  31
  32   | getSexpr(IntToken(value) :: tokens, retSexprAndTokens, retNone) =
  33     retSexprAndTokens(Number(value), tokens)
  34
  35   | getSexpr(BoolToken(value) :: tokens, retSexprAndTokens, retNone) =
  36     retSexprAndTokens(Bool(value), tokens)
  37
  38   | getSexpr(CharToken(value) :: tokens, retSexprAndTokens, retNone) =
  39     retSexprAndTokens(Char(value), tokens)
  40
  41   | getSexpr(StringToken(value) :: tokens, retSexprAndTokens, retNone) =
  42     retSexprAndTokens(String(value), tokens)
  43
  44   | getSexpr(SymbolToken(value) :: tokens, retSexprAndTokens, retNone) =
  45     retSexprAndTokens(Symbol(value), tokens)
  46
  47   | getSexpr(QuoteToken :: tokens, retSexprAndTokens, retNone) =
  48     (* tokens; ' rest-toks *)
  49     getSexpr(tokens,
  50         (fn (quotedSE,restToks) =>
  51             retSexprAndTokens(Pair(Symbol "quote",Pair(quotedSE,Nil)),restToks)
  52         ),
  53         (fn () =>
  54             (* tokens: ' .
  55                    or: ' )
  56               or just: ' *)
  57             raise ErrorNoSexprAfterQuote))
  58
  59   | getSexpr(VectorToken :: tokens, retSexprAndTokens, retNone) =
  60     (* tokens: #( rest-toks *)
  61     getSexprs(tokens,
  62         (fn (sExprs,RparenToken :: restToks) =>
  63             (* tokens: #( se_1 ... se_k ) rest-toks *)
  64             retSexprAndTokens (Vector(sExprs), restToks)
  65
  66           | (_,DotToken :: restToks) =>
  67             (* tokens: #( zero-or-more-sexpr . rest-toks *)
  68             raise ErrorInvalidPairSyntax
  69
  70           | (_,_) =>
  71             raise ErrorNoClosingRparen))
  72
  73   | getSexpr(LparenToken :: tokens, retSexprAndTokens, retNone) =
  74     (* tokens were: ( rest-toks *)
  75     getSexprs(tokens,
  76         (fn (sExprs,RparenToken :: restToks) =>
  77             (* tokens were: ( se_1 se_2 ... se_k ) rest-toks *)
  78             retSexprAndTokens (MLListToScheme(sExprs), restToks)
  79
  80           | ([],DotToken :: restToks) =>
  81             (* tokens were: ( . rest-toks *)
  82             raise ErrorInvalidPairSyntax
  83
  84           | (sExprs,DotToken :: restToks) =>
  85             (* tokens were: ( se_1 se_2 ... se_k . rest-toks
  86                then rest-toks should contain EXACTLY ONE sexpr *)
  87             getSexpr(restToks,
  88                 (fn (lastSE,RparenToken :: restToks) =>
  89                     (* tokens were: ( se_1 ... se_k . se ) rest-toks *)
  90                     retSexprAndTokens(
  91                         combine(MLListToScheme(sExprs),lastSE), restToks)
  92
  93                   | (lastSE,[]) =>
  94                     (* tokens were: ( se_1 ... se_k . se
  95                        then fail: no matching RparenToken *)
  96                     raise ErrorNoClosingRparen
  97
  98                   | (lastSE,_) =>
  99                     (* tokens were: ( se_1 ... se_k . se rest-toks
 100                        then fail: MORE THAN ONE sexpr after dot *)
 101                     raise ErrorInvalidPairSyntax),
 102                 (fn () =>
 103                     (* ZERO expressions after DotToken *)
 104                     raise ErrorMissingSexprAfterDot))
 105
 106           | (sExprs, _) =>
 107             (* tokens were: ( sexpr-list
 108                then fail: no matching RparenToken *)
 109             raise ErrorNoClosingRparen))
 110
 111   | getSexpr(RparenToken :: tokens, retSexprAndTokens, retNone) = retNone()
 112   | getSexpr(DotToken :: tokens, retSexprAndTokens, retNone) = retNone()
 113
 114 and getSexprs(tokens, retSexprsAndTokens) =
 115     getSexpr(tokens,
 116         (fn (se,[]) =>
 117             (* tokens were: se
 118                EXACTLY ONE sexpr *)
 119             retSexprsAndTokens([se],[])
 120
 121           | (se,restToks) =>
 122             (* tokens were: se rest-toks
 123                there is more to read *)
 124             getSexprs(restToks,
 125                 (fn (sExprs,restToks) =>
 126                     retSexprsAndTokens(se :: sExprs,restToks)))),
 127         (fn () =>
 128             (* there was no s-expr in tokens *)
 129             retSexprsAndTokens([],tokens)))
 130
 131 and tokensToSexprs(tokens) =
 132     getSexprs(tokens,
 133                 (fn (es, []) =>
 134                     (* no remaining tokens - all fine *)
 135                     es
 136
 137                   | (es, tokens) =>
 138                     (* some tokens remained *)
 139                     raise ErrorCannotReadAllSexprs(es, tokens)))
 140
 141 and stringToSexprs(string) =
 142     tokensToSexprs(Scanner.stringToTokens string)
 143 and stringToSexpr(string) =
 144     case (stringToSexprs string) of
 145         [sexpr] => sexpr
 146       | _ => raise ErrorMoreThanOneSexpr;
 147 end; (* of structure Reader *)