|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250 |
- (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
- ;; 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)
|