;;; CS 61A project 4 solutions


;;; Problem A1    variable arg counts

;; Modifications to eval-prefix shown in capital letters

(define (eval-prefix line-obj env)
  (define (eval-helper paren-flag)
    (let ((token (ask line-obj 'next)))
      (cond ((self-evaluating? token) token)
	    ...
            (else
	     (let ((proc (lookup-procedure token)))
	       (if (not proc) (error "I don't know how to" token))
	       (IF (LIST? (ARG-COUNT PROC))
	       	   (LOGO-APPLY PROC
			       (CONS ENV
				     (COLLECT-N-ARGS (CAR (ARG-COUNT PROC))
						     LINE-OBJ
						     ENV))
			       ENV)
	       	   (LOGO-APPLY PROC
		       	       (COLLECT-N-ARGS (IF PAREN-FLAG
						   (ARG-COUNT PROC)
						   (ABS (ARG-COUNT PROC)))
					       LINE-OBJ
					       ENV)
		       	       ENV)) )) )))
  (eval-helper #f))

;; Also, some of the primitives need their arg-counts modified:

(add-prim 'word -2 word)
(add-prim 'sentence -2 se)
(add-prim 'se -2 se)
(add-prim 'list -2 list)
(add-prim 'sum -2 (make-logo-arith +))
(add-prim 'product -2 (make-logo-arith *))



;;; Problem A2   handle-infix


(define (handle-infix value line-obj env)
  (if (ask line-obj 'empty?)
      value
      (let ((token (ask line-obj 'next)))
	(if (memq token '(+ - * / = < >))
	    (handle-infix ((text (lookup-procedure (de-infix token)))
			   value
			   (eval-prefix line-obj env) )
			  line-obj
			  env)
	    (begin
	     (ask line-obj 'put-back token)
	     value)))))



;;; Problem B1    variables

;;; data abstraction procedures

(define (variable? exp)
  (and (symbol? exp) (eq? (first exp) ':)))

(define (variable-name exp)
  (bf exp))

;; Now, about the implementation of MAKE.  Here is the relevant code
;; from the original Scheme evaluator (meta.scm):

;; There are two procedures here, one that Scheme uses for SET! and
;; one that it uses for DEFINE.

;; (define (set-variable-value! var val env)
;;   (define (env-loop env)
;;     (define (scan vars vals)
;;       (cond ((null? vars)
;;              (env-loop (enclosing-environment env)))
;;             ((eq? var (car vars))
;;              (set-car! vals val))
;;             (else (scan (cdr vars) (cdr vals)))))
;;     (if (eq? env the-empty-environment)
;;         (error "Unbound variable -- SET!" var)
;;         (let ((frame (first-frame env)))
;;           (scan (frame-variables frame)
;;                 (frame-values frame)))))
;;   (env-loop env))
;; 
;; (define (define-variable! var val env)
;;   (let ((frame (first-frame env)))
;;     (define (scan vars vals)
;;       (cond ((null? vars)
;;              (add-binding-to-frame! var val frame))
;;             ((eq? var (car vars))
;;              (set-car! vals val))
;;             (else (scan (cdr vars) (cdr vals)))))
;;     (scan (frame-variables frame)
;;           (frame-values frame))))

;; My solution was to combine these two procedures into one that does
;; exactly what we want for Logo.  It's mostly like SET-VARIABLE-VALUE!
;; except for the change noted below:

(define (define-variable! var val env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
        (ADD-BINDING-TO-FRAME! VAR VAL (FIRST-FRAME THE-GLOBAL-ENVIRONMENT))
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))

;; Then my actual MAKE procedure in logo.scm is a trivial invocation
;; of this modified metacircular evaluator procedure:

(define (make env var val)          ; Note order of arguments, env first.
  (define-variable! var val env)
  '=no-value=)


;;; Problem B2    eval-definition

(define (eval-definition line-obj)
  (define (parse-formal token)
    (if (eq? (first token) ':)
	(bf token)
	(error "Bad input name format in TO" token)))
  (define (get-formals)
    (if (ask line-obj 'empty?)
	'()
	(let ((token (ask line-obj 'next)))
	  (cons (parse-formal token) (get-formals)))))

  (define (get-body)
    (prompt "-> ")
    (let ((line (logo-read)))
      (if (equal? line '(end))
	  '()
	  (cons line (get-body)))))

  (let ((name (ask line-obj 'next)))
    (let ((formals (get-formals)))
      (set! the-procedures
	    (cons (list name
			'compound
			(length formals)
			(cons formals (get-body)))
		  the-procedures))))
  '=no-value=)


;;; Problem 3    eval-sequence

(define (eval-sequence exps env)
  (if (null? exps)
      '=no-value=
      (let ((value (eval-line (make-line-obj (car exps)) env)))
	(cond ((eq? value '=stop=) '=no-value=)
	      ((and (pair? value) (eq? (car value) '=output=))
	       (cdr value))
	      ((not (eq? value '=no-value=))
	       (error "You don't say what to do with" value))
	      (else (eval-sequence (cdr exps) env))))))



;;; Problem 4		static variables

;;; One part of the problem is to modify the eval-definition that
;;; you wrote in B2 to accept the STATIC keyword.  Changes are
;;; shown in capital letters:

(define (eval-definition line-obj)
  (define (parse-formal token)
    (if (eq? (first token) ':)
	(bf token)
	(error "Bad input name format in TO" token)))
  (define (get-formals)
    (if (ask line-obj 'empty?)
	'()
	(let ((token (ask line-obj 'next)))
	  (IF (EQ? TOKEN 'STATIC)		;; added for problem 6
	      '()				;; ...
	      (cons (parse-formal token) (get-formals))))))

;;; The following procedure is added for problem 4.
  (DEFINE (GET-STATICS)
    (IF (ASK LINE-OBJ 'EMPTY?)
	(MAKE-FRAME '() '())
	(LET ((VARIABLE (PARSE-FORMAL (ASK LINE-OBJ 'NEXT))))
	  (LET ((VALUE (LOGO-EVAL LINE-OBJ THE-GLOBAL-ENVIRONMENT)))
	    (LET ((FRAME (GET-STATICS)))
	      (ADD-BINDING-TO-FRAME! VARIABLE VALUE FRAME)
	      FRAME)))))
;;; End of problem 4 addition.

  (define (get-body)
    (prompt "-> ")
    (let ((line (logo-read)))
      (if (equal? line '(end))
	  '()
	  (cons line (get-body)))))
  (let ((name (ask line-obj 'next)))
    (let ((formals (get-formals)))
      (LET ((STATICS (IF (ASK LINE-OBJ 'EMPTY?)   ;; added for problem 6
			 (MAKE-FRAME '() '())     ;; ...
			 (GET-STATICS))))	  ;; ...
	(set! the-procedures
	      (cons (list name
			  'compound
			  (length formals)
			  (cons formals (get-body))
			  STATICS)		  ;; added for problem 6
		  the-procedures)))))
  '=no-value=)


;; Then, we have to include the statics in the new environment
;; when we invoke a procedure, by modifying logo-apply:

(define (logo-apply procedure arguments env)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedure procedure arguments))
        ((compound-procedure? procedure)
         (eval-sequence (procedure-body procedure)
                        (extend-environment
                         (parameters procedure)
                         arguments
			 (ADJOIN-FRAME
			  (STATICS-FRAME PROCEDURE)
			  env))))
        (else
         (error "Unknown procedure type -- LOGO-APPLY" procedure))))

;; This uses a new selector that we must add to the ADT for procedures:

(define (statics-frame proc) (car (cddddr proc)))

;; and a new constructor for environments:

(define adjoin-frame cons)