src/sml/reader.sml

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