(* File: {PHYLUM}<DESRIVIERES>NLISP>FLAT-LISP in Gacha 10. *)

(* Last edited: Oct. 27, 1983 by Jim des Rivieres  *)

(* Uses: {PHYLUM}<LISP>LIBRARY>CMLSPECIALFORMS.DCOM *)

(* Processor for a non-reflective, non-meta-structural
   LISP.
*)

(globalvars global-env global-env-hash-array
    lambda-closure if-closure set-closure)

(defun normalise (exp env)
    (cond
      ((atom? exp) (binding (extract-atom exp) env))
      ((rail? exp)
       (if (empty? exp) then
           exp
        else
           (prep (normalise (first exp) env)
                 (normalise (rest exp) env)) ))
      ((pair? exp)
       (let ((proc! (normalise (pcar exp) env))
             (args (pcdr exp)))
          (cond
             ((not (closure? proc!))
               (error "1.9-LISP error " "not a procedure"))
             ((lambda? proc!)
              (if (or (not (rail? args))
                      (not (equal (rlength args) 2))) then
                  (error "1.9-LISP error in lambda" "malformed"))
              (ccons env
                  (first args)
                  (second args) ))
             ((if? proc!)
              (let ((premise! (normalise (first args)) ))
                  (cond 
                     ((equal premise! t)
                      (normalise (second args) env))
                     ((equal premise! nil)
                      (normalise (third args) env))
                     (t (error "1.9-LISP error in if"
                               "truth value expected"))) ))
             ((set? proc!)
              (rebind (first args) 
                  (normalise (second args) env)
                  env))          
             (t (let ((new-env
                         (bind (pattern proc!)
                           (normalise args env)
                           (environment proc!)) ))
                   (if (primitive? proc!) then
                       (do-primitive proc! args!)
                    else
                       (normalise (body proc!) new-env)))))))

      (t exp)) )


(defun read-normalise-print (stream)
   (prog ()
      rnp-loop
        (let ((command (prompt&read stream)))
           (let ((result (normalise command global-env)))
              (prompt&print result stream)
              (go rnp-loop)))))


STOP