(*
 * 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;