proj4b - ; CS 61A project 4 part II solutions ; Problem A5...

Info iconThis preview shows pages 1–5. Sign up to view the full content.

View Full Document Right Arrow Icon
Sheet1 Page 1 (define (handle-infix value line-obj env) (if (ask line-obj 'empty?) value (let ((token (ask line-obj 'next))) (if (memq token '(+ - * / = < >)) (handle-infix ((text (lookup-procedure (de-infix token))) value (eval-prefix line-obj env) ) line-obj env) (begin (ask line-obj 'put-back token) value))))) (define (eval-definition line-obj) (define (parse-formal token) (if (eq? (first token) ':) (bf token) (error "Bad input name format in TO" token))) (define (get-formals) (if (ask line-obj 'empty?) '() (let ((token (ask line-obj 'next))) (cons (parse-formal token) (get-formals))))) (define (get-body) (prompt "-> ") (let ((line (logo-read))) (if (equal? line '(end)) '() (cons line (get-body))))) (let ((name (ask line-obj 'next))) (let ((formals (get-formals))) (set! the-procedures (cons (list name 'compound (length formals) (cons formals (get-body))) the-procedures)))) '=no-value=)
Background image of page 1

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
Sheet1 Page 2 (define (eval-sequence exps env) (if (null? exps) '=no-value= (let ((value (eval-line (make-line-obj (car exps)) env))) (cond ((eq? value '=stop=) '=no-value=) ((and (pair? value) (eq? (car value) '=output=)) (cdr value)) ((not (eq? value '=no-value=)) (error "You don't say what to do with" value)) (else (eval-sequence (cdr exps) env)))))) (define (mc-apply procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (EXTEND-ENVIRONMENT (PROCEDURE-PARAMETERS PROCEDURE) ARGUMENTS (PROCEDURE-ENVIRONMENT PROCEDURE)))) (else (error "Unknown procedure type -- APPLY" procedure)))) (define (logo-apply procedure arguments ENV) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (parameters procedure) arguments ENV)))
Background image of page 2
Sheet1 Page 3 (else (error "Unknown procedure type -- LOGO-APPLY" procedure)))) (define (eval-prefix line-obj env) (define (eval-helper paren-flag) (let ((token (ask line-obj 'next))) (cond ((self-evaluating? token) token) ... (else (let ((proc (lookup-procedure token))) (if (null? proc) (error "i don't know how to" token)) (if (list? (arg-count proc)) (logo-apply proc (cons env (collect-n-args (car (arg-count proc)) line-obj env)) ENV) (logo-apply proc (collect-n-args (if paren-flag (arg-count proc) (abs (arg-count proc))) line-obj env) ENV)) )) ))) (eval-helper #f)) (define (stepped? proc) (cadr (cddddr proc))) (define (set-stepped?! proc tf) (set-car! (cdr (cddddr proc)) tf))
Background image of page 3

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
Sheet1 Page 4 (define (eval-definition line-obj) ... (let ((name (ask line-obj 'next))) (let ((formals (get-formals))) (set! the-procedures (cons (list name 'compound (length formals) (cons formals (get-body)) #F) the-procedures)))) '=no-value=) (add-prim 'step 1 (lambda (name) (let ((proc (lookup-procedure name))) (if proc (set-stepped?! proc #t))) '=no-value=)) (add-prim 'unstep 1 (lambda (name)
Background image of page 4
Image of page 5
This is the end of the preview. Sign up to access the rest of the document.

This note was uploaded on 03/11/2009 for the course CS 61A taught by Professor Harvey during the Fall '08 term at University of California, Berkeley.

Page1 / 40

proj4b - ; CS 61A project 4 part II solutions ; Problem A5...

This preview shows document pages 1 - 5. Sign up to view the full document.

View Full Document Right Arrow Icon
Ask a homework question - tutors are online