API tools faq
paste
timothy235

sicp-4-2-2-lazy-repl-program

timothy235
Mar 18th, 2017 (edited)
766
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Racket 19.29 KB | None | 0 0
raw download clone embed print report
  1. #lang racket
  2. (require racket/mpair)
  3. (provide (all-defined-out))
  4.  
  5. ;; This is the repl program for section 4.2.2.  It is the same as the repl program
  6. ;; from section 4.1.4, only updated to use lazy evaluation.  In particular, this repl
  7. ;; program does not separate syntactic analysis from evaluation, nor does it
  8. ;; implement letrec, like the repl program from section 4.1.7 does.  Use
  9. ;; "4-2-2-repl-test.rkt" to test basic functionality.
  10.  
  11. ;; NOTES:
  12.  
  13. ;; 1. Thunks, like environments, are mutable lists.  Other lists are immutable.
  14. ;; 2. tagged-list? must be changed to work on both mutable and immutable lists.
  15.  
  16. ;; PROGRAM SECTIONS:
  17.  
  18. ;; 1. my-eval and my-apply
  19. ;; 2. eval procedures
  20. ;; 3. self-evaluating expressions, variables, and quotations
  21. ;; 4. definition and assignment
  22. ;; 5. thunks, lambdas, procedures and applications
  23. ;; 6. sequences and begin expressions
  24. ;; 7. boolean expressions
  25. ;; 8. if and cond expressions
  26. ;; 9. let, let*, and named-let
  27. ;; 10. environment and frames
  28. ;; 11. primitive procedures and the global environment
  29. ;; 12. repl operations
  30.  
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. ;; 1. MY-EVAL AND MY-APPLY  ;;
  33. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  34.  
  35. (define (my-eval expr env)
  36.   (cond [(self-evaluating? expr) expr]
  37.         [(variable? expr) (lookup-variable-value expr env)]
  38.         [(quoted? expr) (text-of-quotation expr)]
  39.         [(definition? expr) (eval-definition expr env)]
  40.         [(assignment? expr) (eval-assignment expr env)]
  41.         [(if? expr) (eval-if expr env)]
  42.         [(cond? expr) (my-eval (cond->if expr) env)]
  43.         [(begin? expr) (eval-sequence (begin-actions expr) env)]
  44.         [(and? expr) (eval-and expr env)]
  45.         [(or? expr) (eval-or expr env)]
  46.         [(let? expr) (my-eval (let->combination expr) env)]
  47.         [(let*? expr) (my-eval (let*->nested-lets expr) env)]
  48.         [(named-let? expr) (my-eval (named-let->sequence expr) env)]
  49.         [(lambda? expr)
  50.          (make-procedure (lambda-parameters expr)
  51.                          (lambda-body expr)
  52.                          env)]
  53.         [(application? expr)
  54.          (my-apply (actual-value (operator expr) env)
  55.                    (operands expr)
  56.                    env)]
  57.         [else (error "Unknown expression type -- MY-EVAL" expr)]))
  58.  
  59. (define (my-apply procedure arguments env)
  60.   (cond [(primitive-procedure? procedure)
  61.          (apply-primitive-procedure
  62.            procedure
  63.            (list-of-arg-values arguments env))]
  64.         [(compound-procedure? procedure)
  65.          (eval-sequence
  66.            (procedure-body procedure)
  67.            (extend-environment
  68.              (procedure-parameters procedure)
  69.              (list-of-delayed-args arguments env)
  70.              (procedure-environment procedure)))]
  71.         [else (error "Unknown procedure type -- APPLY" procedure)]))
  72.  
  73. ;;;;;;;;;;;;;;;;;;;;;;;;;
  74. ;; 2. EVAL PROCEDURES  ;;
  75. ;;;;;;;;;;;;;;;;;;;;;;;;;
  76.  
  77. (define (eval-definition expr env)
  78.   (define-variable! (definition-variable expr)
  79.                     (my-eval (definition-value expr) env)
  80.                     env)
  81.   'ok)
  82. (define (eval-assignment expr env)
  83.   (set-variable-value! (assignment-variable expr)
  84.                        (my-eval (assignment-value expr) env)
  85.                        env)
  86.   'ok)
  87. (define (list-of-values exprs env)
  88.   (if (no-operands? exprs)
  89.     empty
  90.     (cons (my-eval (first-operand exprs) env)
  91.           (list-of-values (rest-operands exprs) env))))
  92. (define (eval-sequence exprs env)
  93.   (cond [(last-exp? exprs) (my-eval (first-exp exprs) env)]
  94.         [else (my-eval (first-exp exprs) env)
  95.               (eval-sequence (rest-exps exprs) env)]))
  96. (define (eval-if expr env)
  97.   (if (true? (actual-value (if-predicate expr) env))
  98.     (my-eval (if-consequent expr) env)
  99.     (my-eval (if-alternative expr) env)))
  100. (define (eval-and expr env)
  101.   (define ops (and-operands expr))
  102.   (cond [(empty? ops) 'true] ; (and) should be true
  103.         [else
  104.           (define val (my-eval (first ops) env))
  105.           (define rest-ops (rest ops))
  106.           (cond [(empty? rest-ops) val] ; (and x) should be x
  107.                 [(false? val) false]
  108.                 [else
  109.                   (eval-and (make-and rest-ops) env)])]))
  110. (define (eval-or expr env)
  111.   (define ops (or-operands expr))
  112.   (cond [(empty? ops) 'false] ; (or) should be false
  113.         [else
  114.           (define val (my-eval (first ops) env))
  115.           (define rest-ops (rest ops))
  116.           (cond [(empty? rest-ops) val] ; (or x) should be x
  117.                 [(not (false? val)) val]
  118.                 [else
  119.                   (eval-or (make-or rest-ops) env)])]))
  120.  
  121. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  122. ;; 3. SELF-EVALUATING EXPRESSIONS, VARIABLES, AND QUOTATIONS  ;;
  123. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  124.  
  125. (define (tagged-list? expr tag)
  126.   (or (and (pair? expr) (eq? (first expr) tag))
  127.       (and (mpair? expr) (eq? (mcar expr) tag))))
  128.  
  129. ;; Only numbers and strings are self-evaluating.
  130. (define (self-evaluating? expr)
  131.   (cond [(number? expr) true]
  132.         [(string? expr) true]
  133.         [else false]))
  134.  
  135. (define (variable? expr)
  136.   (symbol? expr))
  137.  
  138. ;; Quotations have the form:  (quote <text-of-quotation>)
  139. (define (quoted? expr)
  140.   (tagged-list? expr 'quote))
  141. (define (text-of-quotation expr)
  142.   (second expr))
  143.  
  144. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  145. ;; 4. DEFINITION AND ASSIGNMENT  ;;
  146. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  147.  
  148. ;; Variable definitions have the form:  (define <var> <value>)
  149.  
  150. ;; Procedure definitions have the form:
  151. ;; (define (<var> <parameter-1> ... <parameter-n>) <body>)
  152. ;; which is equivalent to:
  153. ;; (define <var> (lambda (<parameter-1> ... <parameter-n>) <body>))
  154.  
  155. (define (definition? expr) (tagged-list? expr 'define))
  156. (define (definition-variable expr)
  157.   (if (symbol? (second expr))
  158.     (second expr)
  159.     (first (second expr))))
  160. (define (definition-value expr)
  161.   (if (symbol? (second expr))
  162.     (third expr)
  163.     (make-lambda (rest (second expr)) ; formal parameters
  164.                  (drop expr 2))))
  165.  
  166. ;; Assignments have the form:  (set! <var> <value>)
  167. (define (assignment? expr)
  168.   (tagged-list? expr 'set!))
  169. (define (assignment-variable expr) (second expr))
  170. (define (assignment-value expr) (third expr))
  171.  
  172. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  173. ;; 5. THUNKS, LAMBDAS, PROCEDURES AND APPLICATIONS  ;;
  174. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  175.  
  176. (define (thunk? obj) (tagged-list? obj 'thunk))
  177. (define (thunk-exp my-thunk) (mcar (mcdr my-thunk)))
  178. (define (thunk-env my-thunk) (mcar (mcdr (mcdr my-thunk))))
  179. (define (delay-it expr env)
  180.   (mlist 'thunk expr env))
  181. (define (evaluated-thunk? obj) (tagged-list? obj 'evaluated-thunk))
  182. (define (thunk-value evaluated-thunk) (mcar (mcdr evaluated-thunk)))
  183. (define (force-it obj)
  184.   (cond [(thunk? obj)
  185.          (define result (actual-value (thunk-exp obj) (thunk-env obj)))
  186.          (set-mcar! obj 'evaluated-thunk)
  187.          (set-mcar! (mcdr obj) result)
  188.          (set-mcdr! (mcdr obj) empty)
  189.          result]
  190.         [(evaluated-thunk? obj) (thunk-value obj)]
  191.         [else obj]))
  192.  
  193. ;; NON-MEMOIZING FORCE-IT:
  194. ;; (define (force-it obj)
  195.   ;; (if (thunk? obj)
  196.     ;; (actual-value (thunk-exp obj) (thunk-env obj))
  197.     ;; obj))
  198.  
  199. ;; Lambda expressions have the form:
  200. ;; (lambda (<parameters>) <body>)
  201. (define (lambda? expr) (tagged-list? expr 'lambda))
  202. (define (lambda-parameters expr) (second expr))
  203. (define (lambda-body expr) (drop expr 2))
  204. (define (make-lambda parameters body)
  205.   (cons 'lambda (cons parameters body)))
  206.  
  207. ;; Procedures:
  208. (define (make-procedure parameters body env)
  209.   (list 'procedure parameters body env))
  210. (define (compound-procedure? p)
  211.   (tagged-list? p 'procedure))
  212. (define (procedure-parameters p) (second p))
  213. (define (procedure-body p) (third p))
  214. (define (procedure-environment p) (fourth p))
  215.  
  216. ;; Procedure applications have the from:
  217. ;; (<var> <parameter> ...)
  218. (define (application? expr) (pair? expr))
  219. (define (operator expr) (first expr))
  220. (define (operands expr) (rest expr))
  221. (define (no-operands? ops) (empty? ops))
  222. (define (first-operand ops) (first ops))
  223. (define (rest-operands ops) (rest ops))
  224. (define (actual-value expr env)
  225.   (force-it (my-eval expr env)))
  226. (define (list-of-arg-values exprs env)
  227.   (if (no-operands? exprs)
  228.     empty
  229.     (cons (actual-value (first-operand exprs) env)
  230.           (list-of-arg-values (rest-operands exprs)
  231.                               env))))
  232. (define (list-of-delayed-args exprs env)
  233.   (if (no-operands? exprs)
  234.     empty
  235.     (cons (delay-it (first-operand exprs) env)
  236.           (list-of-delayed-args (rest-operands exprs)
  237.                                 env))))
  238.  
  239. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  240. ;; 6. SEQUENCES AND BEGIN EXPRESSIONS  ;;
  241. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  242.  
  243. ;; Begin has the form:  (begin <actions>)
  244. (define (begin? expr) (tagged-list? expr 'begin))
  245. (define (begin-actions expr) (rest expr))
  246. (define (last-exp? seq) (empty? (rest seq)))
  247. (define (first-exp seq) (first seq))
  248. (define (rest-exps seq) (rest seq))
  249. (define (sequence->exp seq)
  250.   (cond [(empty? seq) seq]
  251.         [(last-exp? seq) (first-exp seq)]
  252.         [else (make-begin seq)]))
  253. ;; begin constructor used by cond->if
  254. (define (make-begin seq) (cons 'begin seq))
  255.  
  256. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  257. ;; 7. BOOLEAN EXPRESSIONS  ;;
  258. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  259.  
  260. (define (true? x) (not (false? x)))
  261. (define (and? expr) (tagged-list? expr 'and))
  262. (define (and-operands expr) (rest expr))
  263. (define (make-and sequence) (cons 'and sequence))
  264. (define (or? expr) (tagged-list? expr 'or))
  265. (define (or-operands expr) (rest expr))
  266. (define (make-or sequence) (cons 'or sequence))
  267.  
  268. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  269. ;; 8. IF AND COND EXPRESSIONS  ;;
  270. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  271.  
  272. ;; Conditionals have the form:  (if <predicate> <consequent> <alternative>)
  273. ;; If no alternative, use false.
  274. (define (if? expr) (tagged-list? expr 'if))
  275. (define (if-predicate expr) (second expr))
  276. (define (if-consequent expr) (third expr))
  277. (define (if-alternative expr)
  278.   (if (not (empty? (drop expr 3)))
  279.     (fourth expr)
  280.     'false))
  281. (define (make-if predicate consequent alternative)
  282.   (list 'if predicate consequent alternative))
  283.  
  284. ;; Cond has the form:
  285. ;; (cond ((<predicate> <actions>)
  286.        ;; (else <actions>))) ; if no else, assume (else false) clause
  287. (define (cond? expr) (tagged-list? expr 'cond))
  288. (define (cond-clauses expr) (rest expr))
  289. ;; regular cond clause
  290. (define (cond-predicate clause) (first clause))
  291. (define (cond-actions clause) (rest clause))
  292. ;; alternate test clause
  293. (define (cond-alternate-clause? clause)
  294.   (eq? (second clause) '=>))
  295. (define (cond-test clause) (first clause))
  296. (define (cond-recipient clause) (third clause))
  297. ;; else clause
  298. (define (cond-else-clause? clause)
  299.   (eq? (cond-predicate clause) 'else))
  300. ;; derive cond from if
  301. (define (cond->if expr)
  302.   (expand-clauses (cond-clauses expr)))
  303. (define (expand-clauses clauses)
  304.   (cond [(empty? clauses) 'false] ; no else clause
  305.         [else
  306.           (define first-clause (first clauses))
  307.           (define rest-clauses (rest clauses))
  308.           (cond [(cond-else-clause? first-clause)
  309.                  (if (empty? rest-clauses)
  310.                    (sequence->exp (cond-actions first-clause))
  311.                    (error "ELSE clause isn't last -- COND->IF" clauses))]
  312.                 [(cond-alternate-clause? first-clause)
  313.                  (define test (cond-test first-clause)) ; gets evaluated twice
  314.                  (make-if test
  315.                           (list (cond-recipient first-clause)
  316.                                 test)
  317.                           (expand-clauses rest-clauses))]
  318.                 [else
  319.                   (make-if (cond-predicate first-clause)
  320.                            (sequence->exp (cond-actions first-clause))
  321.                            (expand-clauses rest-clauses))])]))
  322.  
  323. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  324. ;; 9. LET, LET*, AND NAMED-LET  ;;
  325. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  326.  
  327. ;; Let has the form:  (let (<bindings>) <body>)
  328. (define (let? expr)
  329.   (and (tagged-list? expr 'let)
  330.        (list? (second expr))))
  331. (define (let-bindings expr) (second expr))
  332. (define (let-parameters expr) (map first (let-bindings expr)))
  333. (define (let-expressions expr) (map second (let-bindings expr)))
  334. (define (let-body expr) (drop expr 2))
  335. (define (let->combination expr)
  336.   (cond [(empty? (let-bindings expr)) ; do not unnecessarily lambda wrap
  337.          (sequence->exp (let-body expr))]
  338.         [else
  339.           (cons (make-lambda (let-parameters expr)
  340.                              (let-body expr))
  341.                 (let-expressions expr))]))
  342. (define (make-let bindings body)
  343.   (cons 'let (cons bindings body)))
  344.  
  345. ;; Let* has the same form as let, but bindings are sequential.
  346. (define (let*? expr) (tagged-list? expr 'let*))
  347. (define (let*-bindings expr) (second expr))
  348. (define (let*-body expr) (drop expr 2))
  349. (define (make-let* bindings body)
  350.   (cons 'let* (cons bindings body)))
  351. (define (let*->nested-lets expr)
  352.   (define bindings (let*-bindings expr))
  353.   (cond [(empty? bindings)
  354.          (sequence->exp (let-body expr))]
  355.         [else
  356.           (list 'let
  357.                 (list (first bindings))
  358.                 (let*->nested-lets
  359.                   (make-let* (rest bindings)
  360.                              (let-body expr))))]))
  361.  
  362. ;; Named-let has the form:  (let <name> (<bindings>) <body>)
  363. (define (named-let? expr)
  364.   (and (tagged-list? expr 'let)
  365.        (not (list? (second expr)))))
  366. (define (named-let-name expr) (second expr))
  367. (define (named-let-bindings expr) (third expr))
  368. (define (named-let-parameters expr) (map first (named-let-bindings expr)))
  369. (define (named-let-expressions expr) (map second (named-let-bindings expr)))
  370. (define (named-let-body expr) (drop expr 3))
  371. (define (named-let->sequence expr)
  372.   (define bindings (named-let-bindings expr))
  373.   (cond [(empty? bindings)
  374.          (sequence->exp (named-let-body expr))]
  375.         [else
  376.           (list 'begin
  377.                 (cons 'define ; first define the named function
  378.                       (cons (cons (named-let-name expr)
  379.                                   (named-let-parameters expr))
  380.                             (named-let-body expr)))
  381.                 (cons (named-let-name expr) ; then apply it to the expressions
  382.                       (named-let-expressions expr)))]))
  383.  
  384. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  385. ;; 10. ENVIRONMENT AND FRAMES  ;;
  386. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  387.  
  388. ;; An environment is a mutable list of frames.  The enclosing environment is the mcdr
  389. ;; of the list.  A frame is a mutable list of bindings with a 'frame header.  A
  390. ;; binding is a var-val pair ie (mcons var val).
  391.  
  392. ;; Environments support four procedures:
  393.     ;; lookup-variable-value
  394.     ;; extend-environment
  395.     ;; define-variable
  396.     ;; set-variable-value
  397.  
  398. ;; Two helper functions support the environment procedures:
  399.     ;; find-binding-in-frame
  400.     ;; find-binding-in-environment
  401.  
  402. (define (enclosing-environment env) (mcdr env))
  403. (define (first-frame env) (mcar env))
  404. (define the-empty-environment empty)
  405. (define the-empty-frame (mlist 'frame))
  406. (define (empty-frame? frame)
  407.   (empty? (frame-bindings frame)))
  408. (define (make-frame vars vals)
  409.   (mcons 'frame
  410.          (mmap mcons
  411.                (list->mlist vars)
  412.                (list->mlist vals))))
  413. (define (frame-bindings frame) (mcdr frame))
  414. (define (frame-variables frame) (mmap mcar (frame-bindings frame)))
  415. (define (frame-values frame) (mmap mcdr (frame-bindings frame)))
  416.  
  417. (define (binding-variable binding) (mcar binding))
  418. (define (binding-value binding) (mcdr binding))
  419. (define (set-value! binding val) (set-mcdr! binding val))
  420. (define (add-binding-to-frame! var val frame)
  421.   (mappend! frame (mlist (mcons var val))))
  422. (define (find-binding-in-frame var frame)
  423.   ; Return the var-val pair if present else false.
  424.   (define (loop bindings)
  425.     (cond [(empty? bindings) false]
  426.           [else
  427.             (define b (mcar bindings))
  428.             (if (eq? var (binding-variable b))
  429.               b
  430.               (loop (mcdr bindings)))]))
  431.   (loop (frame-bindings frame)))
  432. (define (find-binding-in-env var env)
  433.   ; Return the closest binding for var if present else false.
  434.   (cond [(eq? env the-empty-environment) false]
  435.         [else
  436.           (define b (find-binding-in-frame var (first-frame env)))
  437.           (or b (find-binding-in-env var (enclosing-environment env)))]))
  438.  
  439. (define (lookup-variable-value var env)
  440.   (define b (find-binding-in-env var env))
  441.   (if b
  442.     (binding-value b)
  443.     (error "Unbound variable" var)))
  444. (define (extend-environment vars vals base-env)
  445.   (cond [(= (length vars) (length vals))
  446.          (mcons (make-frame vars vals) base-env)]
  447.         [else
  448.           (if (< (length vars) (length vals))
  449.             (error "Too many arguments supplied" vars vals)
  450.             (error "Too few arguments supplied" vars vals))]))
  451. (define (define-variable! var val env)
  452.   (define frame (first-frame env))
  453.   (define b (find-binding-in-frame var frame))
  454.   (if b
  455.     (set-value! b val)
  456.     (add-binding-to-frame! var val frame)))
  457. (define (set-variable-value! var val env)
  458.   (define b (find-binding-in-env var env))
  459.   (if b
  460.     (set-value! b val)
  461.     (error "Unbound variable -- SET!" var)))
  462.  
  463. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  464. ;; 11. PRIMITIVE PROCEDURES AND THE GLOBAL ENVIRONMENT  ;;
  465. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  466.  
  467. (define primitive-procedures
  468.   (list
  469.     (list 'cons cons)
  470.     (list 'car car)
  471.     (list 'cdr cdr)
  472.     (list '+ +)
  473.     (list '* *)
  474.     (list '- -)
  475.     (list '< <)
  476.     (list '> >)
  477.     (list '<= <=)
  478.     (list '>= >=)
  479.     (list '= =)
  480.     (list 'not not)
  481.     (list 'false? false?)
  482.     (list 'true? (lambda (x) (not (false? x))))
  483.     (list 'empty? empty?)
  484.     (list 'displayln displayln)
  485.     (list 'list list)
  486.     ))
  487. (define (primitive-procedure? proc)
  488.   (tagged-list? proc 'primitive))
  489. (define (primitive-implementation proc)
  490.   (second proc))
  491. (define (primitive-procedure-names)
  492.   (map first primitive-procedures))
  493. (define (primitive-procedure-objects)
  494.   (map (lambda (proc) (list 'primitive (second proc)))
  495.        primitive-procedures))
  496. (define apply-in-underlying-scheme apply)
  497. ;; The metacircular evaluator's apply is my-apply.
  498. (define (apply-primitive-procedure proc args)
  499.   (apply-in-underlying-scheme
  500.     (primitive-implementation proc) args))
  501.  
  502. (define (setup-environment)
  503.   (define initial-env
  504.     (extend-environment (primitive-procedure-names)
  505.                         (primitive-procedure-objects)
  506.                         the-empty-environment))
  507.   (define-variable! 'true true initial-env)
  508.   (define-variable! 'false false initial-env)
  509.   initial-env)
  510. (define the-global-environment (setup-environment))
  511.  
  512. ;;;;;;;;;;;;;;;;;;;;;;;;;;
  513. ;; 12. REPL OPERATIONS  ;;
  514. ;;;;;;;;;;;;;;;;;;;;;;;;;;
  515.  
  516. (define input-prompt ";;; L-Eval input:")
  517. (define output-prompt ";;; L-Eval value:")
  518. (define (driver-loop)
  519.   (prompt-for-input input-prompt)
  520.   (let* ([input (read)]
  521.          [output (actual-value input the-global-environment)])
  522.     (announce-output output-prompt)
  523.     (user-print output))
  524.   (driver-loop))
  525. (define prompt-for-input displayln)
  526. (define announce-output displayln)
  527. (define (user-print object)
  528.   (if (compound-procedure? object)
  529.     (displayln (list 'compound-procedure
  530.                    (procedure-parameters object)
  531.                    (procedure-body object)
  532.                    '<procedure-env>))
  533.     (displayln object)))
Advertisement
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!