1 / 32

Scheme

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.

Download Presentation

Scheme

An Image/Link below is provided (as is) to download presentation Download Policy: Content on the Website is provided to you AS IS for your information and personal use and may not be sold / licensed / shared on other websites without getting consent from its author. Content is provided to you AS IS for your information and personal use only. Download presentation by click this link. While downloading, if for some reason you are not able to download a presentation, the publisher may have deleted the file from their server. During download, if you can't get a presentation, the file might be deleted by the publisher.

E N D

Presentation Transcript


  1. Scheme More MCE examples

  2. 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.

  3. Q1-cont’d >(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

  4. Q1 cont’d ((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))

  5. Q1 cont’d (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)) ))

  6. Q2 (for <init-vars> <init-vals> <condition> <step> <body>) Method of evaluation: 1 Bind <init-vars> to <init-vals> in a new environment <for-env>. 2 Evaluate <condition> in <for-env> 3 If <condition> evaluates to true: evaluate <body> in <for-env>. Otherwise finish and return ‘Done. 4 Evaluate <step> in <for-env> • Go to 2. Blank <body>, <step>, <init-vars>, <init-vals> can be supplied using ().

  7. Q2 cont’d ;;; 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

  8. Q2 cont’d ;;; 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

  9. Q2 ((for? exp) (eval-for exp env)) (define (for? exp) (tagged-list? exp 'for)) (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))

  10. Q2 (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-valsenv)) (for-cond (for-condition exp)) (for-step (for-step exp)) (for-body (for-body exp))) (define loop …) (loop)))

  11. 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)

  12. 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)

  13. 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

  14. 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)))) )

  15. 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. That is if the function is called inside a LTR evaluator it will return ‘LTR otherwise it will return ‘RTL.

  16. Q4 (define (check-dir) (define x 0) (define (f a b) (if (eq? x a) a b)) (f (begin (set! x 'RTL) 'RTL) (begin (set! x 'LTR) 'LTR)) )

  17. 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>)).

  18. Q5 (let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))))

  19. Q5 ((let? exp) (mc-eval (namedlet->combination exp) env)) (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)))

  20. Q5 (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))

  21. Q6 Change the meta-circular evaluator so the every application of compound procedure is memoized. Each application of compound procedure to a given set of arguments should only occur once (e.g. 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.

  22. Q6 > (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

  23. Q6 (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))

  24. Q6 (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)))))

  25. Q6 (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……))))

  26. 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>)

  27. 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.

  28. Q7 (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 inthe global environment. > (func 1 2 3) 8 ; Similar to calling (func 1 2 3 2). > (func 1 2 3 4) 10 > (func 1 2 3 4 5) # error: too many arguments supplied > (func 1) # error: too few arguments supplied

  29. Q7 (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))

  30. Q7 (define (make-procedure parameters body env) ; test the parameters definition (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))) ((and opt (not (optional-parameter? (first-parameter parameters)))) (error "Optional parameters must be placed after formal parameters")) (else (test-parameters (rest-parameters parameters) opt)))) (test-parameters parameters #f) (list 'procedure parameters body env))

  31. Q7 (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)))))

  32. Q7 (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))))

More Related