File ``environment.scm''

;;--------------------------------------------------------------------------
;; AriNET Project in Informatics IA by Dominique Guinard
;; dominique.guinard@unifr.ch
;;--------------------------------------------------------------------------
;; Environment
;;--------------------------------------------------------------------------

; ------------------------------------------------------------
; ABSTRACT:
; *********
; This file contains the model of environment. 
; It is used as the background where
; to evaluate the expressions 
; and variables within AriNET.
; ------------------------------------------------------------

;(load "errormsg.scm")

; ------------------------------------------------------------
; 1. Bindings
; ------------------------------------------------------------

; ------------------------------------------------------------
; Constructors
; ------------------------------------------------------------

(define (make-binding var val)
  (cons var val))

(define (set-binding-value! binding new-value)
  (set-cdr! binding new-value))

; ------------------------------------------------------------
; Selectors
; ------------------------------------------------------------

(define (binding-variable binding)
  (car binding))

(define (binding-value binding)
  (cdr binding))

; tests :
;(define b1 (make-binding 'a 8))
;(binding-variable b1)
;(binding-value b1)
;(set-binding-value! b1 7)
;(binding-value b1)

; ------------------------------------------------------------
; 2. Frames
; ------------------------------------------------------------

; ------------------------------------------------------------
; Constructors
; ------------------------------------------------------------

(define (make-frame variables values)
  (if (null? variables)
      '()
      (cons (cons (car variables)
                  (car values))
            (make-frame (cdr variables)
                        (cdr values)))))

(define (add-binding-to-frame new-binding frame)
  (cons new-binding frame))

; tests :
;(define f1 (make-frame '(a b c) '(1 2 3)))
;(define b2 (make-binding 'x 100))
;(add-binding-to-frame b2 f1)

; ------------------------------------------------------------
; Selectors
; ------------------------------------------------------------

(define (binding-in-frame? var frame)
  (cond ((null? frame) #f)
        ((equal? (binding-variable (car frame)) var)
         (car frame))
        (else
         (binding-in-frame? var (cdr frame)))))

; tests :
;(binding-in-frame? 'b f1)
;(binding-in-frame? 'z f1)
;(binding-in-frame? 'x f1)

; ------------------------------------------------------------
; 3. Environment
; ------------------------------------------------------------

; ------------------------------------------------------------
; Constructors
; ------------------------------------------------------------

(define the-empty-environment '())

(define (set-first-frame! env new-frame)
  (set-car! env new-frame))


(define (lookup-variable-value var env)
  (if (null? env)
      (ErrorMsg (string-append 
                 "No such variable in the environment : "
                 (symbol->string var))
                 'user)
      (let ((binding (binding-in-frame? var (car env))))
        (if binding
            (binding-value binding)
            (lookup-variable-value var (cdr env))))))

          
(define (extend-environment vars vals env)
  (if (= (length vars) (length vals))
      (cons (make-frame vars vals) env)
      (if (< (length vars) (length vals))
          (ErrorMsg "Too many arguments supplied" 'code)
          (ErrorMsg "Too few arguments supplied" 'code))))


(define (set-variable-value! var val env)
  (if (null? env)
      (ErrorMsg "No such variable in the environment" 'code)
      (let ((binding (binding-in-frame? var (car env))))
        (if binding
            (set-binding-value! binding val)
            (set-variable-value! var val (cdr env))))))

(define (define-variable! var val env)
  (let* ((firstframe (car env))
        (bindingOrFalse (binding-in-frame? var firstframe)))
    (if bindingOrFalse
        ;if the binding is already in the first frame
        ;then updates the variable
        (set-variable-value! (car bindingOrFalse)
                             val
                             env)
        ;else set the first frame with the old one and the new binding
        (set-first-frame! env (add-binding-to-frame
                              (make-binding var val)
                              firstframe)))))



; tests :
;(define e1 (extend-environment '(a b c) '(1 2 3) the-empty-environment))
;(define f1 (make-frame '(f g) '(8 9)))
;(set-first-frame! e1 f1)
;(define-variable! 'a 100 e1)
;(define-variable! 'z 100 e1)
;(define e2 (extend-environment '(a b) '(1 2) the-empty-environment))
;(define e3 (extend-environment '() '() e2))
;(define-variable! 'a 100 e3)

; ------------------------------------------------------------
; end of environment
; ------------------------------------------------------------