(*
* Abstype lispVal is a complete data abstration for Lisp values. It has a
* hidden rep, with alternatives for the atomic Lisp types, and a recursive rep
* component for Lisp lists. It provides public ops for the Lisp basics,
* including car, cdr, cons, and more.
*)
use "streams.ml";
abstype lispVal =
T | (* Lisp t as an ML enumeration literal *)
NIL | (* Lisp nil as an ML enumeration literal *)
N of int | (* Lisp number as an ML int (who cares about reals)*)
S of string | (* Lisp string as an ML string *)
A of string | (* Lisp symbolic atom as an ML string *)
L of lispVal list (* Lisp list as an ML list *)
with
(*
* Lisp nil is called "lnil" to avoid conflict with ML's nil.
*)
val lnil = NIL
(*
* Basic Lisp ops follow. I.e., car, cdr, cons, etc.
*)
fun car(L(x)) = hd(x) |
car(x) = lnil
fun cdr(L(x::y)) = L(y) |
cdr(x) = lnil
fun cons(x, L(y)) = L(x::y) |
cons(x, y) = lnil
fun caar(x) = car(car(x))
fun cadr(x) = car(cdr(x))
fun caddr(x) = car(cdr(cdr(x)))
fun cadddr(x) = car(cdr(cdr(cdr(x))))
fun cddr(x) = cdr(cdr(x))
fun cdddr(x) = cdr(cdr(cdr(x)))
fun cddddr(x) = cdr(cdr(cdr(cdr(x))))
fun eq(x:lispVal, y) = x = y
fun lnull(NIL) = true | (* as with nil, we prefix to avoid redef *)
lnull(x) = false
fun numberp(N(x)) = true |
numberp(x) = false
fun stringp(S(x)) = true |
stringp(x) = false
fun atom(A(x)) = true |
atom(x) = false
fun list(x) = L(x)
fun assoc(name, alist) =
if lnull(alist) then
lnil
else if eq(name, caar(alist)) then
car(alist)
else
assoc(name, cdr(alist))
fun plus(N(x), N(y)) = N(x + y) |
plus(x, y) = NIL
fun minus(N(x), N(y)) = N(x - y) |
minus(x, y) = NIL
fun terpri() = print("\n")
fun princ1(nil) = print("") |
princ1(x::nil) = princ(x) |
princ1(x::xs) = (princ(x); print(" "); princ1(xs))
and
princ(T) = print("T") |
princ(NIL) = print("NIL") |
princ(N(x)) = print(x) |
princ(S(x)) = (print("\""); print(x); print("\"")) |
princ(A(x)) = print(x) |
princ(L(x)) = (print("("); princ1(x); print(")"))
(*
princ(L(A("quote")::x)) = (print("'"); princ1(x)) |
princ(L(A(a)::x)) = (print(a); print(" "); princ1(x)) |
princ(L(x::nil)) = (print("("); princ(x); print(")")) |
princ(L(x::y)) = (print("("); princ(x); princ1(y); print(")"))
*)
fun lprint(x) =
(terpri();
princ(x))
fun saneprint(x) =
(princ(x);
terpri())
(***
* From here to the end of the abstype is the reader and its aux functions.
*)
(*
* One of the following exceptions may occur during lispVal read. Their
* names are pretty self-explanatory.
*)
exception MissingDoubleQuote
exception TooManyRightParens
exception TooFewRightParens
(*
* Check if a char is a whitespace char, i.e., blank, tab, or newline.
*)
fun iswhite(c) =
(c = " ") orelse (c = "\t") orelse (c = "\n")
(*
* Check if a char is a break char, i.e., whitespace or a paren.
*)
fun isbreak(c) =
iswhite(c) orelse (c = "(") orelse (c = ")")
(*
* Check if a char is a digit, i.e., "0" - "9".
*)
fun isdigit(c) =
let
val d = ord(c) - 48
in
(d >= 0) andalso (d <= 9)
end
(*
* Advance the given stream past any leading whitespace. "Advance" means
* return a new stream that is n tails of the given stream, where n is the
* number of leading whitespace chars, for 0<=n.
*)
fun moveOverWhitespace(l) =
if snull(l) then
snil
else if iswhite(shd(l)) then
moveOverWhitespace(stl(l))
else
l
(*
* Read a Lisp string from the given stream, assuming a string is present.
* I.e., it is the caller's responsibility to have recognized (and
* consumed) the leading '"' char of a string. It is also the caller's
* responsibility to call sreadstring with an initial empty string. Given
* this, sreadstring will advance through the given stream, concatenating
* each successive char onto the result string, until the next '"' is
* reached. The advanced stream and the resulting string are returned as a
* tuple. If no '"' is seen, the MissingDoubleQuote exception is raised.
*)
fun sreadstring(l, result) =
if snull(l) then
raise MissingDoubleQuote
else if shd(l) = "\"" then
(stl(l), result)
else
sreadstring(stl(l), result ^ shd(l))
(*
* Junior partner of sreadatom, which advances to the next break char, or
* the end-of-stream, building both a numeric and symbolic atoms in
* parallel, while necessary. The numeric value is in num, the symbolic
* value in str, and isnum is a flag that indicates whether the num result
* is still valid. Isnum stays true as long as only digits have been seen
* so far. As soon as the first non-digit atom char is seen, isnum goes
* false, and the numeric result computation is abandoned. The advanced
* stream, num, str, and isnum are returned in a 4-tuple.
*)
fun sreadatom1(l, num, str, isnum, isstr) =
if (snull(l)) orelse (isbreak(shd(l))) then
(l, num, str, isnum)
else
let
val char = shd(l)
val rest = stl(l)
in
if isdigit(char) then
sreadatom1(rest,
num * 10 + (ord(char) - 48), str ^ char,
true andalso (not isstr), isstr)
else
sreadatom1(rest, 0, str ^ char, false, true)
end
(*
* Read a Lisp atom from the given stream, assuming an atom is present.
* I.e., it is the caller's responsibility to have recognized (but not
* consumed) the leading alphanumeric char of an atom. The bulk of the
* scanning work is done by the junior partner, sreadatom1. Upon return
* therefrom, sreadatom sorts out the four major atom types: T, NIL,
* number, or symbolic atom. The advanced stream and appropriate type of
* atom are returned in a tuple.
*)
fun sreadatom(l) =
let
val (l, num, str, isnum) = sreadatom1(l, 0, "", true, false)
in
if isnum then
(l, N(num))
else
if (str = "t") orelse (str = "T") then
(l, T)
else if (str = "nil") orelse (str = "NIL") then
(l, NIL)
else
(l, A(str))
end
(*
* Read a single Lisp sexpr from the given stream. The sexpr and advanced
* stream are returned, where the sexpr is a lispVal. The bulk of the
* scanning work is done by the companion reading functions. Sread1 is the
* top-level controller, that recognizes the leading prefixes for the
* different types of lispVal's, and parsels out the work. Viz:
*
* Leading Char Work Doer
* =====================================================
* snil No one -- we're at the end of stream,
* so we return.
*
* ' quoteit
*
* " sreadstring
*
* ( sreadlist
*
* otherwise sreadatom.
*
* Each of these subfunctions is sent the entering stream, and if
* appropriate, a starting result. The subfunctions then advance through
* the stream, returning it and an appropriate result value as a tuple.
*
* Sread1 finishes the work by constructing an approprate lispVal item, if
* necessary. The advanced stream and result lispVal are returned as a
* tuple.
*
* If an errant right paren is seen by sread1, the TooManyRightParens
* exception is raised. All properly matching right parens are consumed by
* sreadlist.
*)
fun sread1(l) =
let
val l = moveOverWhitespace(l)
in
if snull(l) then
(snil, NIL)
else if shd(l) = "'" then
quoteit(stl(l))
else if shd(l) = "\"" then
let
val (l, result) = sreadstring(stl(l), "")
in
(l, S(result))
end
else if shd(l) = "(" then
let
val (l, result) = sreadlist(stl(l), nil)
in
(l, L(result))
end
else if shd(l) = ")" then
raise TooManyRightParens
else
sreadatom(l)
end
(*
* Quote (i.e., Lisp quote) the subsequent lisp value on the given stream.
* Sread1 is called recursively to grab the next lispVal from the stream.
* The advanced stream and quoted lispVal are returned in a tuple, where
* the quoted lispVal is simply L[A("quote"), result].
*)
and quoteit(l) =
let
val (l, result) = sread1(l)
in
(l, L[A("quote"), result])
end
(*
* Read a Lisp list from the given stream, assuming a list is present.
* I.e., it is the caller's responsibility to have recognized (and
* consumed) the leading '(' char of a list. It is also the caller's
* responsibility to call sreadlist with an initial nil result. Given
* this, sreadlist will advance through the given stream, appending each
* successive lispVal onto the result list, until the next ')' is reached.
* Whitespace is consumed in front of each list element. The advanced
* stream and the resulting lispVal list are returned as a tuple. If no
* '"' is seen, the TooFewRightParens exception is raised.
*
* Note that sreadlist returns an ML list, not a Lisp list. Sread1 will
* decorate the return result of sreadlist with the necessary L[...].
*)
and sreadlist(l, result) =
if snull(l) then
raise TooFewRightParens
else if iswhite(shd(l)) then
sreadlist(moveOverWhitespace(l), result)
else if shd(l) = ")" then
(stl(l), result)
else
let
val (l, newresult) = sread1(l)
in
sreadlist(l, result @ [newresult])
end
(*
* Read zero or more lispVal's from the given stream. It is the caller's
* responsibiltiy to have initialized the stream, and to pass in an initial
* nil result. Sread0 simply calls sread1 repeatedly, and appends each
* successive result to a result list. The fully advanced stream (i.e.,
* snil), and the lispVal list are returned as a tuple.
*
* Note: sread0 is the entry point if the caller wants to read a stream of
* zero or more lisp values, each separated by whitespace. To read zero or
* exactly one lisp value from a stream, sread1 can be used directly.
*)
fun sread0(l, result) =
if snull(l) then
(l, result)
else
let
val (l, newresult) = sread1(l)
in
sread0(l, result @ [newresult])
end
(*
* Convert a whitespace-separated string of Lisp values into a list of
* lispVals. E.g., convert
*
* "a 10 \"x\" (a b c) t"
*
* into
*
* [ A("a"), N(10), S("x"), L[A("a"), A("b"), A("c")], T ]
*
* Sread streamifies the given string, whence sread0 does all the real
* work.
*)
fun sread(s: string): lispVal list =
#2(sread0(sstream(s), nil))
(*
* Read an entire file into a string list, a la sread.
*)
fun fread(filename): lispVal list =
#2(sread0(fstream(filename), nil))
(*
* Here's Lisp's actual read, i.e., read a Lisp val from stdin.
*)
fun read() =
#2(sread1(stl(std_in_stream)))
end;