;;;;;;;; VRAAG 1 ;;;;;;;;;;;;;;;;;

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (text-of-quotation exp))
        ((assignment? exp) (eval-assignment exp env))
        ((definition? exp) (eval-definition exp env))
        ((if? exp) (eval-if exp env))
        ((lambda? exp)
         (make-procedure (lambda-parameters exp)
                         (lambda-body exp)
                         env))
        ((begin? exp) 
         (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval (cond->if exp) env))


        ;((cas? exp)
        ; (eval-cas exp env))
        ((cas? exp)
         (eval (cas->derived-application exp) env))
        

        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
         (error "Unknown expression type -- EVAL" exp))))

(define (cas? exp)
  (tagged-list? exp 'cas))

(define (cas-var exp)
  (cadr exp))
(define (cas-expected exp)
  (caddr exp))
(define (cas-new exp)
  (cadddr exp))

(define (eval-cas exp env)
  (let ((var (eval (cas-var exp) env))
        (new-exp (cas-new exp))
        (expected-exp (cas-expected exp)))
    (if (eq? var (eval expected-exp env))
        (let ((new-var (eval new-exp env)))
          (eval (list 'set! (cas-var exp) new-var) env)
          var)
        var)))

(define (make-application procedure arguments)
  (cons procedure arguments))

(define (cas->derived-application exp)
  (make-if (list '= (cas-var exp) (cas-expected exp))
           (make-application
            (make-lambda (list 'new-var 'old-var) (list (list 'set! (cas-var exp) 'new-var) 'old-var))
            (list (cas-new exp) (cas-var exp)))
           (cas-var exp)))

;;;;;;;; VRAAG 2 ;;;;;;;;;;;;;;;;;
a.
(and (product ?n ?l ?p)
     (lisp-value > ?p 2.5))

b. 
(assert! (rule (element ?first (?first . ?rest))))

(assert! (rule (element ?el (?first . ?rest))
                 (element ?el ?rest)))

(assert! (rule (product-met-allergenen ?prod)
               (and (product ?prod ?list ?price)
                    (bevat-allergeen ?ingred ?allergie)
                    (element ?ingred ?list)))
c.

(assert! (rule (pmmb ?p1)
               (and (product ?p1 ?l1 ?pr1)
                    (not (and (product ?p2 ?l2 ?pr2)
                              (list> ?l1 ?l2))))))


(assert! (rule (list> (?el1 . ?rest1) ())))

(assert! (rule (list> (?e1 . ?cdr)(?e2 . ?cdr2))
               (list> ?cdr ?cdr2)))
;;;;;;;; VRAAG 3 ;;;;;;;;;;;;;;;;;

Test in relocate-old-result-in-new
=> of old,old-car, old-cdr kleiner zijn dan barrier, ja => doe niets
Initialiseer free en gc-loop op barrier


-niet zeker-

;;;;;;;; VRAAG 4 ;;;;;;;;;;;;;;;;;;

(let ((collatz-machine
       (make-machine
        '(cont res v1 v2)
        ops
        
        '(start
          ;(assign v1 (const 10))
          (assign cont (label stop))
          (goto (label collatz-start))
          
          even-start
          (test (op =) (reg v1) (const 0))
          (branch (label is-even))
          (test (op =) (reg v1) (const 1))
          (branch (label is-uneven))
          (assign v1 (op -) (reg v1) (const 2))
          (goto (label even-start))
          is-even
          (assign res (const 1))
          (goto (reg cont))
          is-uneven
          (assign res (const 0))
          (goto (reg cont))
          
          collatz-start
          (assign v2 (const 0))
          (save cont)
          (goto (label collatz-loop))
          
          collatz-loop
          (test (op =) (reg v1) (const 1))
          (branch (label collatz-end))
          
          (save v1)
          (assign cont (label collatz-dc))
          (goto (label even-start))
          
          collatz-dc
          (restore v1)
          (test (op =) (reg res) (const 1))
          (branch (label divide))
          (assign v1 (op *) (reg v1) (const 3))
          (assign v1 (op +) (reg v1) (const 1))
          (goto (label end-dc))
          
          divide
          (assign v1 (op /) (reg v1) (const 2))
          (goto (label end-dc))
          
          end-dc
          (assign v2 (op +) (reg v2) (const 1))
          (goto (label collatz-loop))
          
          
          collatz-end
          (assign res (reg v2))
          (restore cont)
          (goto (reg cont))
          
          stop))))
  (display "(collatz 11): " )
  (set-register-contents! collatz-machine 'v1 11)
  (start collatz-machine)
  (display (get-register-contents collatz-machine 'res))
  (newline))

;;;;;;;; VRAAG 5 ;;;;;;;;;;;;
Codelijn 31-33 -> geval 1 => resultaat moet in val en linkage is next aangezien we continue in hetzelfde stuk machine code (de continue naar label 3)

Argumenten: (if (if (p 1) false 4) (q) false) 'val 'next