(*
 * Further development of a Lisp value datatype, including alternative 
 * implementations of basic operations car, cdr, cons, and print.
 *)
datatype 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 *)

(*
 * Function valType returns a string-valued type tag for a given lispVal.
 *)
fun valType(T) = "T" |
    valType(NIL) = "NIL" |
    valType(N(x)) = "N" |
    valType(S(x)) = "S" |
    valType(A(x)) = "A" |
    valType(L(x)) = "L";

(*
 * The isX functions are are lispVal type predicates.
 *)
fun isT(x) = valType(x) = "T";
fun isNIL(x) = valType(x) = "NIL";
fun isN(x) = valType(x) = "N";
fun isS(x) = valType(x) = "S";
fun isA(x) = valType(x) = "A";
fun isL(x) = valType(x) = "L";

(*
 * The getX functions are lispVal component selectors.
 *)
fun getN(N(x)) = x;
fun getS(S(x)) = x;
fun getA(A(x)) = x;
fun getL(L(x)) = x;


(*
 * Structure nonPatternLispFuns implements car, cdr, and cons in terms of the
 * isL predicate and getL selector, without using pattern-based definitions.
 *)
structure nonPatternLispFuns = struct

    fun car(l) =
        if isL(l) then
            hd(getL(l))
        else
            (print("You idiot, you can only apply car to a list.\n"); NIL);

    fun cdr(l) =
        if isL(l) then
            L(tl(getL(l)))
        else
            (print("You idiot, you can only apply cdr to a list.\n"); NIL);

    fun cons(l1,l2) =
        if isL(l2) then
            L(l1::getL(l2))
        else
           (print("Sorry, no dotted pairs -- 2nd arg of cons must be list.\n");
            NIL);
end;

(*
 * Structure PatternLispFuns implements car, cdr, cons, and print using
 * pattern-based function defs.
 *)
structure patternLispFuns = struct

    local
      fun car1(L(x)) = hd(x);
    in
      fun car(x) = car1(x)
          handle Match =>
              (print("You idiot, you can only apply car to a list.\n"); NIL);
    end

    local
      fun cdr1(L(x)) = L(tl(x));
    in
      fun cdr(x) = cdr1(x)
          handle Match =>
              (print("You idiot, you can only apply cdr to a list.\n"); NIL);
    end

    local
      fun cons1(x,L(y)) = L(x::y);
    in
      fun cons(x,y) = cons1(x,y)
          handle Match =>
              (print("You idiot, you can only apply cdr to a list.\n"); NIL);
    end

    fun printLispVal1(nil) = print("") |
        printLispVal1(x::nil) = printLispVal(x) |
        printLispVal1(x::xs) = (printLispVal(x); print(" "); printLispVal1(xs))
      and
        printLispVal(T) = print("T") |
        printLispVal(NIL) = print("NIL") |
        printLispVal(N(x)) = print(x) |
        printLispVal(S(x)) = (print("\""); print(x); print("\"")) |
        printLispVal(A(x)) = print(x) |
        printLispVal(L(x)) = (print("("); printLispVal1(x); print(")"));
end;

(*
 * Using this datatype, the following Lisp list
 *
 *     ( 10 20 'x "hi there" t 'y (30 40 50 (60 70)) nil 80 )
 *
 * is represented by the following ML value:
 *
 *)
val l =
       L[N(10), N(20), A("x"), S("hi there"), T, A("y"),
           L[N(30), N(40), N(50), L[N(60), N(70)]], NIL, N(80)];

open patternLispFuns;

(*
 * Here is some testing of car, cons, and cdr.
 *)
car(l);
cdr(l);
cons(car(l), cdr(l)) = l;
car(cdr(car(cdr(cdr(cdr(car(cdr(cdr(cdr(cdr(cdr(cdr(l)))))))))))));