340 likes | 457 Vues
Scheme. More MCE examples. Q1. new special form which defines global variables (static <variable> <value>) search the global environment Variable exists: does nothing, and just returns the symbol ‘ok. Otherwise, add the name <variable> as a new binding to the global environment
E N D
Scheme More MCE examples
Q1 • new special form which defines global variables • (static <variable> <value>) • search the global environment • Variable exists: • does nothing, and just returns the symbol ‘ok. • Otherwise, add the name <variable> as a new binding to the global environment • value returned from evaluating the expression <value> in the same environment where the static special form is evaluated.
Q1: Example >(define (f) (static x 1) x) > (define (g x) (static x (* 2 2)) x) > (g 7) 7 > (f) 4 > (set! x (+ x 1)) > (f) 5
Q1: Solution ((static? exp) (eval-static exp env)) (define (static? exp) (tagged-list? exp 'static)) (define (static-variable exp) (cadr exp)) (define (static-value exp) (caddr exp))
Q1: Solution (define (eval-static exp env) (let ((frame (first-frame the-global-environment)) (var (static-variable exp))) (define (scan vars) (cond ((null? vars) (add-binding-to-frame! var (mc-eval (static-value exp) env) frame)) ((eq? var (car vars)) 'ok) (else (scan (cdrvars))))) (scan (frame-variables frame)) ))
Q2 • (for <init-vars> <init-vals> <condition> <step> <body>) • Method of evaluation: • Bind <init-vars> to <init-vals> in a new environment <for-env>. • Evaluate <condition> in <for-env> • If <condition> evaluates to true: • evaluate <body> in <for-env> • Evaluate <step> in <for-env> • Go to 2 • Otherwise finish and return ‘done. Comment: Blank <body>, <step>, <init-vars>, <init-vals> can be supplied using ().
Q2: Example I ;;; M-Eval input: (define x 0) ;;; M-Eval value: ok ;;; M-Eval input: (for (i) (0) (< i 10) (set! i (+ i 1)) (set! x (+ x i))) ;;; M-Eval value: done ;;; M-Eval input: x ;;; M-Eval value: 45
Q2: Example II ;;; M-Eval input: (define x 0) ;;; M-Eval value: ok ;;; M-Eval input: (for (i j k) ((+ 0 0) (+ 0 1) (+ 0 2)) (< i 10) (begin (set! i (+ i 1)) (set! j (+ j 2)) (set! k (+ k 3))) (set! x (+ i j k))) ;;; M-Eval value: done ;;; M-Eval input: x ;;; M-Eval value: 57
Q2: Solution ((for? exp) (eval-for exp env)) Predicate: (define (for? exp) (tagged-list? exp 'for)) Selectors: (define (for-init-vars exp) (cadr exp)) (define (for-init-vals exp) (caddr exp)) (define (for-condition exp) (cadddr exp)) (define (for-step exp) (list-ref exp 4)) (define (for-body exp) (list-ref exp 5))
Q2: Solution (define (eval-for exp env) (let* ((init-vars (for-init-vars exp)) (init-vals (map (lambda (e) (mc-eval e env)) (for-init-vals exp))) (for-env (extend-environment init-vars init-vals env)) (for-cond (for-condition exp)) (for-step (for-step exp)) (for-body (for-body exp))) (define loop …) (loop)))
Q2 cont’d (let* ……. (define (loop) (if (mc-eval for-cond for-env) (begin (if (not (eq? for-body '())) (mc-eval for- body for-env)) (if (not (eq? for-step '())) (mc-eval for-step for-env)) (loop)) 'done)) (loop)))
Q3 • When applying a procedure Dr. scheme evaluates the arguments from left to right (LTR). Change the evaluator so that parameters are evaluated right to left (RTL)
Q3 ;;; M-Eval input: (+ (begin (display 1) (newline) 1) (begin (display 2) (newline) 2)) 2 1 ;;; M-Eval value: 3 Example LTR evaluator: ;;; M-Eval input: (+ (begin (display 1) (newline) 1) (begin (display 2) (newline) 2)) 1 2 ;;; M-Eval value: 3
Q3 (define LTR #f) (define (list-of-values expsenv) (define (helper ops) (if (no-operands? ops) '() (cons (mc-eval (first-operand ops) env) (helper (rest-operands ops))))) (if LTR (helper exps) (reverse (helper (reverse exps)))) )
Q4 • Suppose you are using an unknown evaluator and you want to check the evaluation order. • Write a function (check-dir) that checks the direction of evaluation. • If the function is called inside a LTR evaluator it will return ‘LTR otherwise it will return ‘RTL.
Q4 (define (check-dir) (define x 0) (define (f a b) x) (f (begin (set! x 'RTL) 'RTL) (begin (set! x 'LTR) 'LTR)) )
Q5 (let <name> ((<v1> <e1>) … (<vn> <en>)) <body>) <name> is optional. If it is not supplied, named let works just like an ordinary let. When <name> is supplied then in the scope of <body>, a variable named <name> is bound to a procedure whose arguments are v1…vn and its body is <body>, as if the following was defined: (define (<name> v1 v2 … vn) <body>)).
Q5: Example (let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))))
Q5: Solution ((let? Exp) (mc-eval (namedlet->combination exp) env)) Selectors: (define (namedlet-name exp) (cadr exp)) (define (namedlet-bindings exp) (caddr exp)) (define (namedlet-body exp) (cdddr exp)) (define (namedlet-variables exp) (map car (namedlet-bindings exp))) (define (namedlet-expressions exp) (map cadr (namedlet-bindings exp)))
Q5: Solution (define (namedlet->combination exp) (make-combination (make-lambda null (list (make-definition (namedlet-name exp) (make-lambda (namedlet-variables exp) (namedlet-body exp))) (make-combination (namedlet-name exp) (namedlet-expressions exp)))) null))
Q6 • Change the meta-circular evaluator so that every application of compound procedure is memoized. • Each application of compound procedure to a given set of arguments should only occur once. • The second time the compound procedure is applied with the same parameters, the value from the previous calculation is returned rather than the original one.
Q6: Example > (define count 0) ok > (define (id x) (set! count (+ count 1)) x) ok > (id 1) 1 > count 1 > (id 2) 2 > count 2 > (id 2) 2 > count 2 > (id 1) 1 > count 2
Q6: Solution (define (find-index obj lst) (define (helper index lst) (cond ((null? lst) -1) ((equal? obj (car lst)) index) (else (helper (+ index 1) (cdr lst))))) (helper 0 lst))
Q6: Solution (define (make-procedure parameters body env) (list 'procedure parameters body envnull null)) (define (procedure-memo-args p) (list-ref p 4)) (define (procedure-memo-vals p) (list-ref p 5)) (define (procedure-memo-add p argsval) (set-car! (cddddr p) (cons args (car (cddddr p)))) (set-car! (cdr (cddddr p)) (cons val (cadr (cddddr p)))))
Q6: Solution (define (mc-apply procedure arguments) (cond ((primitive-procedure? procedure) ……… ((compound-procedure? procedure) (let ((ind (find-index arguments (procedure-memo-args procedure)))) (if (>= ind 0) (list-ref (procedure-memo-vals procedure) ind) (let ((result (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure))))) (procedure-memo-add procedure arguments result) result)))) (else ….error……))))
Q7 • (lambda (<formal args> <optional args>) (<body>)) • <formal args> is a list of names v1 … vn representing mandatory parameters (just like we have in the standard evaluator) • <optional args> is a list of paired names and expressions (similar to let expression): (<o1> <e1>)…(<om> <em>)
Q7 • Each optional parameter oi that has no bound argument (i>k-n), is bound to the value resulting from the evaluation of ei, the expression that was supplied in the parameter declaration. • The expression ei is evaluated in the environment that is pointed to by the lambda expression.
Q7: Example (define (func m1 m2 (o1 1) (o2 2)) (+ m1 m2 o1 o2)) Ok > (func 1 2) 6 ; Similar to calling (func 1 2 1 2). The expressions e1=1 and e2=2 are evaluated in the global environment. > (func 1 2 3) 8 ; Similar to calling (func 1 2 3 2).
Q7: Example > (func 1 2 3 4) 10 > (func 1 2 3 4 5) # error: too many arguments supplied > (func 1) # error: too few arguments supplied
Q7: Solution (define (optional-parameter? p) (pair? p)) (define (parameter-name p) (if (optional-parameter? p) (car p) p)) (define (first-parameter parameters) (car parameters)) (define (rest-parameters parameters) (cdr parameters)) (define (has-expression? p) (not (null? (cdr p)))) (define (parameter-expression p) (cadr p))
Q7: Solution (define (make-procedure parameters body env) ; test the parameters definition (define (test-parameters parameters opt) …) (test-parameters parameters #f) (list 'procedure parameters body env))
Q7: Solution (define (test-parameters parameters opt) (cond ((null? parameters) 'ok) ((optional-parameter? (first-parameter parameters)) (if (not (has-expression? (first-parameter parameters))) (error "Missing expression for optional parameter") (test-parameters (rest-parameters parameters) #t))) (opt (error "Optional parameters must be placed after formal parameters")) (else (test-parameters (rest-parameters parameters) opt))))
Q7: Solution (define (procedure-args arguments parameters env) (cond ((null? parameters) (if (not (null? arguments)) (error "Too many arguments supplied“) null)) ((null? arguments) (let ((param (first-parameter parameters))) (if (optional-parameter? param) (cons (mc-eval (parameter-expression param) env) (procedure-args arguments (rest-parameters parameters) env)) (error "Too few arguments supplied")))) (else (cons (car arguments) (procedure-args (cdr arguments) (rest-parameters parameters) env)))))
Q7: Solution (define (mc-apply procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (map parameter-name (procedure-parameters procedure)) (procedure-args arguments (procedure-parameters procedure) (procedure-environment procedure)) (procedure-environment procedure)))) (else (error "Unknown procedure type -- MC-APPLY" procedure))))