uni/inf2810/hw3.b/oppgave.scm

(load "evaluator.scm")
(set! the-global-environment (setup-environment))

;;;;;;;
;; 1 ;;
;;;;;;;

;; a

;; (foo 2 square)
;;   -> 0
;; foo er en funksjon som tar to argumenter.
;; Hvis det første argumentet er 2, returnerer den 0.
;; Det første argumentet er her 2.

;; (foo 4 square)
;;   -> 16
;; Hvis det første argumentet til foo ikke er 2,
;; kjører den funksjonen gitt som det andre argumentet
;; med det første argumentet og returnerer resultatet.

;; (cond ((= cond 2) 0) (else (else 4)))
;;   -> 2
;; I mc-eval sjekker vi om uttrykket er en special form før vi sjekker
;; om det er et funksjonskall ("application"). Siden uttrykket starter med
;; symbolet cond, blir det tolket som en special form, og ikke et kall på
;; variabelen som heter cond.
;;
;; I ((= cond 2) 0) blir cond brukt som en variabel, siden vi vet at det
;; ikke er en special form (lista den er i starter med '=, ikke 'cond).
;; Siden cond er satt til 3, og 3 != 2, fortsetter vi til else-grenen
;; (cond ser ikke etter et funksjonskall her - `((else` hadde blitt tolket
;; som et funksjonskall, mens `(else` blir tolket som else-grenen).
;; I else-grenen er kallet på funksjonen else, med 4 som argument.
;; Siden else-funksjonen deler tallet på seg selv, returneres 4 / 2, eller 2.

;;;;;;;
;; 2 ;;
;;;;;;;

;; a

(define-variable! '1+
                  (list 'primitive
                        (lambda (num) (+ num 1)))
                  the-global-environment)

(define-variable! '1-
                  (list 'primitive
                        (lambda (num) (- num 1)))
                  the-global-environment)

;; b

(define (install-primitive! name proc)
  (define-variable! name
                    (list 'primitive proc)
                    the-global-environment))

(install-primitive! 'square (lambda (x) (* x x)))

;;;;;;;
;; 3 ;;
;;;;;;;

;; Legger modifikasjoner som er nødvendig for deloppgavene her
;; Jeg har valgt å ikke modifisere evaluator.scm, og heller
;; redefinere de prosedyrene som må endres.

;; Modifisert special-form? fra evaluator.scm
(define (special-form? exp)
  (cond ((quoted? exp) #t)
        ((assignment? exp) #t)
        ((definition? exp) #t)
        ((if? exp) #t)
        ((lambda? exp) #t)
        ((begin? exp) #t)
        ((cond? exp) #t)
        ((and? exp) #t)
        ((or? exp) #t)
        ((let? exp) #t)
        ((while? exp) #t)
        (else #f)))

;; Modifisert eval-special-form fra evaluator.scm
(define (eval-special-form exp env)
  (cond ((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) (mc-eval (cond->if exp) env))
        ((or? exp) (eval-or exp env))
        ((and? exp) (eval-and exp env))
        ((let? exp) (eval-let exp env))
        ((while? exp) (eval-while exp env))))

;; a

(define (and? exp)
  (tagged-list? exp 'and))
(define (or? exp)
  (tagged-list? exp 'or))

(define (eval-and exp env)
  (define (iter exps)
    (cond ((null? exps) #t)
          ((null? (cdr exps)) (mc-eval (car exps) env))
          ((false? (mc-eval (car exps) env)) #f)
          (else (iter (cdr exps)))))
  (iter (cdr exp)))

(define (eval-or exp env)
  (define (iter exps)
    (cond ((null? exps) #f)
          (else
           (let ((res (mc-eval (car exps) env)))
             (if (true? res)
                 res
                 (iter (cdr exps)))))))
  (iter (cdr exp)))

;; b

;; Modifisert eval-if fra evaluator.scm
(define (eval-if exp env)
  (define (tag exps) (car exps))
  (define (if-pred exps) (cadr exps))
  (define (if-then exps) (caddr exps))
  (define (if-conseq exps) (cadddr exps))
  (define (if-next exps) (cddddr exps))
  (define (else-conseq exps) (cadr exps))

  (define (iter-find-else exps)
    (cond ((null? exps) #f)
          ((eq? (tag exps) 'else) #t)
          (else (iter-find-else (if-next exps)))))

  (define (iter exps)
    (cond ((null? exps) #f)
          ((or (eq? (tag exps) 'if)
               (eq? (tag exps) 'elsif))
           (let ((pred (if-pred exps))
                 (conseq (if-conseq exps)))
             (if (eq? 'then (if-then exps))
                 (if (true? (mc-eval pred env))
                     (mc-eval conseq env)
                     (iter (if-next exps)))
                 (error "Expected 'then', got:" (if-then exps)))))
          ((eq? (tag exps) 'else)
           (mc-eval (else-conseq exps) env))
          (else (error "Expected 'if', 'elsif', or 'else', got:" (tag exps)))))

  (if (iter-find-else exp)
      (iter exp)
      (error "Expected 'else' branch in if")))

;; c

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

(define (let->lambda exp)
  (define (get-param-names params)
    (if (null? params)
        '()
        (cons (caar params) (get-param-names (cdr params)))))

  (let ((names (get-param-names (cadr exp)))
        (body (cddr exp)))
    (make-lambda names body)))

(define (eval-let exp env)
  (define (get-param-vals params)
    (if (null? params)
        '()
        (cons (mc-eval (cadar params) env)
              (get-param-vals (cdr params)))))

  (let ((vals (get-param-vals (cadr exp))))
    (mc-apply (mc-eval (let->lambda exp) env)
              vals)))

;; d
;; Dette overskriver let fra oppgave c, kommenter ut for å bekrefte
;; at oppgave c virker.

(define (eval-let exp env)
  (define (let-name exps) (car exps))
  (define (let-equals exps) (cadr exps))
  (define (let-val exps) (caddr exps))
  (define (let-action exps) (cadddr exps))
  (define (let-next exps) (cddddr exps))

  (define names '())
  (define vals '())
  (define body '())

  (define (parse exps)
    (if (eq? (let-equals exps) '=)
        (begin
          (set! names (cons (let-name exps) names))
          (set! vals (cons (mc-eval (let-val exps) env)
                           vals))
          (cond ((eq? (let-action exps) 'and)
                 (parse (let-next exps)))
                ((eq? (let-action exps) 'in)
                 (set! body (let-next exps)))
                (else (error "Expected 'and' or 'in', got:" (let-action exps)))))

        (error "Expected '=', got:" (let-equals exps))))

  (parse (cdr exp))
  (let ((names names)
        (vals vals)
        (body body))
    (mc-apply (mc-eval (make-lambda names body) env)
              vals)))

;; e

;; Eksempel: (while (= 1 1) (display "hello") (newline))
;; eller:
;; (define i 0)
;; (while (not (= i 10))
;;        (display "i is ")
;;        (display i)
;;        (newline)
;;        (set! i (+ i 1)))

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

(define (eval-while exp env)
  (define pred (cadr exp))
  (define body (mc-eval (make-lambda '() (cddr exp)) env))

  (define (iter)
    (if (mc-eval pred env)
        (begin
          (mc-apply body '())
          (iter))))
  (iter))

(read-eval-print-loop)