home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / oct93 / develop / umbscheme.lha / UMBScheme / prelude.scheme < prev    next >
Text File  |  1992-08-04  |  16KB  |  653 lines
  1. ;  prelude.scheme -- UMB Scheme, standard primitives in Scheme.
  2. ;
  3. ;  Copyright 1988, 1991 University of Massachusetts
  4. ;
  5. ;  Author: William R Campbell, University of Massachusetts at Boston,
  6. ;
  7. ;  $Revision: 2.5 $
  8.  
  9. (gc-messages #f)
  10.  
  11.  
  12. ; PRIMITIVE  PROCEDURES
  13.  
  14. ; Pairs and lists.
  15.  
  16. ; car - cdr compositions  (caar pair) ... (cddddr pair)
  17.  
  18. (define (caar x) (car (car x)))
  19. (define (cadr x) (car (cdr x)))
  20. (define (cdar x) (cdr (car x)))
  21. (define (cddr x) (cdr (cdr x)))
  22.  
  23. (define (caaar x) (car (car (car x))))
  24. (define (caadr x) (car (car (cdr x))))
  25. (define (cadar x) (car (cdr (car x))))
  26. (define (caddr x) (car (cdr (cdr x))))
  27. (define (cdaar x) (cdr (car (car x))))
  28. (define (cdadr x) (cdr (car (cdr x))))
  29. (define (cddar x) (cdr (cdr (car x))))
  30. (define (cdddr x) (cdr (cdr (cdr x))))
  31.  
  32. (define (caaaar x) (car (car (car (car x)))))
  33. (define (caaadr x) (car (car (car (cdr x)))))
  34. (define (caadar x) (car (car (cdr (car x)))))
  35. (define (caaddr x) (car (car (cdr (cdr x)))))
  36. (define (cadaar x) (car (cdr (car (car x)))))
  37. (define (cadadr x) (car (cdr (car (cdr x)))))
  38. (define (caddar x) (car (cdr (cdr (car x)))))
  39. (define (cadddr x) (car (cdr (cdr (cdr x)))))
  40. (define (cdaaar x) (cdr (car (car (car x)))))
  41. (define (cdaadr x) (cdr (car (car (cdr x)))))
  42. (define (cdadar x) (cdr (car (cdr (car x)))))
  43. (define (cdaddr x) (cdr (car (cdr (cdr x)))))
  44. (define (cddaar x) (cdr (cdr (car (car x)))))
  45. (define (cddadr x) (cdr (cdr (car (cdr x)))))
  46. (define (cdddar x) (cdr (cdr (cdr (car x)))))
  47. (define (cddddr x) (cdr (cdr (cdr (cdr x)))))
  48.  
  49. ; (list obj ...)
  50.  
  51. (define (list . elems) elems)
  52.  
  53. ; (list? obj)  -- Defined below (after named lets are introduced).
  54.  
  55. ; (memq   obj list)
  56. ; (memv   obj list)
  57. ; (member obj list)
  58.  
  59.  
  60. (define (memq obj list)
  61.     (if (null? list) #f
  62.     (if (not (pair? list))
  63.         (error "2nd arg to memq not a list: " list)
  64.         (if (eq?  obj (car list)) list
  65.         (memq  obj (cdr list)) ))))
  66.  
  67.  
  68. (define (memv obj list)
  69.     (if (null? list) #f
  70.     (if (not (pair? list))
  71.         (error "2nd arg to memv not a list: " list)
  72.         (if (eqv?  obj (car list)) list
  73.         (memv  obj (cdr list)) ))))
  74.  
  75.  
  76. (define (member obj list)
  77.     (if (null? list) #f
  78.     (if (not (pair? list))
  79.         (error "2nd arg to member not a list: " list)
  80.         (if (equal?  obj (car list)) list
  81.         (member  obj (cdr list)) ))))
  82.  
  83.  
  84. ; (assq  obj alist)
  85. ; (assv  obj alist)
  86. ; (assoc obj alist)
  87.  
  88. (define (assq obj alist)
  89.     (if (null? alist) #f
  90.     (if (not (pair? alist))
  91.         (error "2nd argument to assq not a list: " alist)
  92.         (if (eq? (caar alist) obj) (car alist)
  93.         (assq obj (cdr alist))))))
  94.  
  95.  
  96. (define (assv obj alist)
  97.     (if (null? alist) #f
  98.     (if (not (pair? alist))
  99.         (error "2nd argument to assv not a list: " alist)
  100.         (if (eqv? (caar alist) obj) (car alist)
  101.         (assv obj (cdr alist))))))
  102.  
  103.  
  104. (define (assoc obj alist)
  105.     (if (null? alist) #f
  106.     (if (not (pair? alist))
  107.         (error "2nd argument to assoc not a list: " alist)
  108.         (if (equal? (caar alist) obj) (car alist)
  109.         (assoc obj (cdr alist))))))
  110.  
  111. ; Numbers
  112.  
  113. (define (number->string num . radix )
  114.     (#_number->string num (if (null? radix) 10 (car radix)) ))
  115.  
  116. (define (string->number str . radix )
  117.     (#_string->number str (if (null? radix) 0 (car radix)) ))
  118.  
  119. ; Strings
  120.  
  121. ; (make-string k)
  122. ; (make-string k char)
  123.  
  124. (define (make-string length . fill-char)
  125.     (if (null? fill-char)
  126.     (#_make-string length #\space)
  127.     (#_make-string length (car fill-char)) ) )
  128.  
  129. ; (string char ...)
  130.  
  131. (define (string . characters) (list->string characters))
  132.  
  133. ; Vectors
  134.  
  135. ; (make-vector k)
  136. ; (make-vector k fill)
  137.  
  138. (define (make-vector length . fill)     ; and extend it to handle default fill
  139.     (#_make-vector length (if (null? fill) (the-undefined-symbol) (car fill)) ))
  140.  
  141. ; (vector obj ...)
  142.  
  143. (define (vector . elems) (list->vector elems))
  144.  
  145.  
  146. ; Control Features
  147.  
  148. ; (apply proc args)
  149. ; (apply proc arg1 ... args)
  150.  
  151. (define (#_collect args)
  152.    (if (null? (cdr args)) (car args) (cons (car args) (#_collect (cdr args)))))
  153.  
  154. (define (apply proc arg1 . args)
  155.    (#_apply proc (if (null? args) arg1 (#_collect (cons arg1 args)))))
  156.  
  157.  
  158. ; (map proc list1 list2 ...)
  159.  
  160. (define (map fn list . lists)
  161.     (if (null? lists) (#_map1 fn list)
  162.     (#_mapn fn (cons list lists))))
  163.  
  164. (define (#_map1 fn list)
  165.     (if (null? list) '()
  166.     (cons (fn (car list)) (#_map1 fn (cdr list)))))
  167.  
  168. (define (#_mapn fn lists)
  169.     (if (null? (car lists)) '()
  170.     (cons (#_apply fn (#_map1 car lists))
  171.           (#_mapn fn (#_map1 cdr lists)) )))
  172.  
  173. ; (for-each proc list1 list2 ...)
  174.  
  175. (define (for-each proc list . lists)
  176.     (if (null? lists) (#_for-each1 proc list)
  177.     (#_for-eachn proc (cons list lists))))
  178.  
  179. (define (#_for-each1 proc list)
  180.     (if (null? list) '()
  181.     (begin (proc (car list))
  182.            (#_for-each1 proc (cdr list)))))
  183.  
  184. (define (#_for-eachn proc lists)
  185.     (if (null? (car lists)) '()
  186.     (begin (#_apply proc (#_map1 car lists))
  187.            (#_for-eachn proc (#_map1 cdr lists)) )))
  188.  
  189.  
  190. ; Input and output (Ports)
  191.  
  192. ; (call-with-input-file string proc)  DEFINED BELOW
  193. ; (call-with-output-file string proc) DEFINED BELOW
  194.  
  195. ; (read)
  196. ; (read port)
  197. ; (read-char)
  198. ; (read-char port)
  199. ; (peek-char)
  200. ; (peek-char port)
  201. ; (char-ready?)
  202. ; (char-ready? port)
  203.  
  204. (define (read . port)
  205.     (#_read (if (null? port) (current-input-port) (car port))))
  206.  
  207. (define (read-char . port)
  208.     (#_read-char (if (null? port) (current-input-port) (car port))))
  209.  
  210. (define (peek-char . port)
  211.     (#_peek-char (if (null? port) (current-input-port) (car port))))
  212.  
  213. (define (char-ready? . port)
  214.     (#_char-ready? (if (null? port) (current-input-port) (car port))))
  215.  
  216. ; (write)
  217. ; (write port)
  218. ; (newline)
  219. ; (newline port)
  220. ; (write-char)
  221. ; (write-char port)
  222.  
  223. (define (write obj . port)      ; and extend them to have default ports
  224.     (#_write obj (if (null? port) (current-output-port) (car port))))
  225.  
  226. (define (display obj . port)
  227.     (#_display obj (if (null? port) (current-output-port) (car port))))
  228.  
  229. (define (newline . port)
  230.     (if (null? port) (write-char #\newline (current-output-port))
  231.     (write-char #\newline (car port)) ))
  232.  
  233. (define (write-char obj . port)
  234.     (#_write-char obj (if (null? port) (current-output-port) (car port))))
  235.  
  236.  
  237. ; (with-input-from-file string thunk)   DEFINED BELOW
  238. ; (with-output-to-file string thunk)    DEFINED BELOW
  239.  
  240. ; DERIVED EXPRESSION TYPES
  241.  
  242. ; (quasi-quote <template>)
  243. ; `<template>  ==>  (quasiquote <template>) in (read)
  244.  
  245. (macro quasiquote
  246.     (lambda (form)
  247.     (#_quasiquote (cadr form))))
  248.  
  249. (define (#_quasiquote skel)
  250.    (if (vector? skel) (list 'list->vector (#_quasiquote (vector->list skel)))
  251.        (if (null? skel) ''()
  252.        (if (symbol? skel) (list 'quote skel)
  253.            (if (not (pair? skel)) skel
  254.            (if (eq? (car skel) 'unquote) (cadr skel)
  255.                (if (eq? (car skel) 'quasiquote)
  256.                (#_quasiquote (#_quasiquote (cadr skel)))
  257.                (if (if (pair? (car skel))
  258.                    (eq? (caar skel) 'unquote-splicing) #f)
  259.                 (list 'append (cadar skel)
  260.                           (#_quasiquote (cdr skel)))
  261.                 (#_combine-skels (#_quasiquote (car skel))
  262.                          (if (null? (cdr skel)) '()
  263.                              (#_quasiquote (cdr skel)))
  264.                          skel)
  265.                ))))))))
  266.  
  267.  
  268. (define (#_combine-skels lft rgt skel)
  269.     (if (if (#_isconst? lft) (#_isconst? rgt) #f) (list 'quote skel)
  270.     (if (null? rgt) (list 'list lft)
  271.         (if (if (pair? rgt) (eq? (car rgt) 'list) #f)
  272.         (cons 'list (cons lft (cdr rgt)))
  273.         (list 'cons lft rgt)
  274.         ))))
  275.  
  276.  
  277. (define (#_isconst? obj)
  278.     (if (pair? obj) (eq? (car obj) 'quote) #f))
  279.  
  280.  
  281. ; (defmacro (key name) ...) => (macro key (lambda (name) ...))
  282.  
  283. (macro defmacro
  284.     (lambda (x)
  285.     `(macro ,(caadr x) (lambda (,(cadadr x)) ,@(cddr x))) ))
  286.  
  287. (defmacro (let form)
  288.     (if (symbol? (cadr form))
  289.  
  290.     ; a named let
  291.     ; (let v0 ((v1 e1) ...) . body)
  292.     ;   =>
  293.     ; ((letrec ((v0 (lambda (v1 ...) . body)))
  294.     ;    v0)
  295.     ;  e1 ...)
  296.  
  297.     `((letrec ((,(cadr form) (lambda ,(#_map1 car (caddr form))
  298.                             ,@(cdddr form) )))
  299.         ,(cadr form))
  300.         ,@(#_map1 cadr (caddr form)) )
  301.  
  302.     ; a regular let
  303.     ; (let ((v1 e1) ...) . body)
  304.     ;   =>
  305.     ; ((lambda (v1 ...) . body) e1 ...)
  306.  
  307.     `(  (lambda ,(#_map1 car (cadr form)) ,@(cddr form))
  308.         ,@(#_map1 cadr (cadr form))) ))
  309.  
  310.  
  311. ; (and)           => #t
  312. ; (and e1)        => e1
  313. ; (and e1 e2 ...) =>
  314. ;    (let ((x e1)
  315. ;          (thunk (lambda()(and e2...))))
  316. ;        (if x (thunk) x))
  317.  
  318. (defmacro (and form)
  319.     (if (null? (cdr form)) #t
  320.     (if (null? (cddr form)) (cadr form)
  321.         (let ((x (gensym "_x"))
  322.           (thunk (gensym "_thunk")))
  323.         `(let ((,x ,(cadr form))
  324.                (,thunk (lambda ()
  325.               (and ,@(cddr form)))))
  326.             (if ,x (,thunk) ,x))
  327.         ))))
  328.  
  329.  
  330. ; (or)           => #f
  331. ; (or e1)        => e1
  332. ; (or e1 e2 ...) =>
  333. ;    (let ((x e1)
  334. ;          (thunk (lambda()(or e2...))))
  335. ;        (if x x (thunk)))
  336.  
  337.  
  338. (defmacro (or form)
  339.     (if (null? (cdr form)) #f
  340.     (if (null? (cddr form)) (cadr form)
  341.         (let ((x (gensym "_x"))
  342.           (thunk (gensym "_thunk")))
  343.         `(let ((,x ,(cadr form))
  344.                (,thunk (lambda ()
  345.                (or ,@(cddr form)))))
  346.             (if ,x ,x (,thunk)))
  347.         ))))
  348.  
  349. ; (cond) => '()
  350. ;
  351. ; (cond (else seq)) => (begin seq)
  352. ;
  353. ; (cond (e1) c2 ...) => (or e1 (cond c2 ...))
  354. ;
  355. ; (cond (e1 => recipient) c2 ...) =>
  356. ;   (let ((t e1)
  357. ;      (r (lambda() recipient))
  358. ;      (c (lambda() c2 ...)))
  359. ;    (if t ((r)t) (c)) )
  360. ;
  361. ; (cond (e1 seq1) c2 ...) =>
  362. ;    (if e1 (begin seq1)
  363. ;     (cond c2 ...))
  364.  
  365. (defmacro (cond form)
  366.     (if (null? (cdr form)) ''()
  367.     (let ((c1 (cadr form)))
  368.         (if (not (pair? c1))
  369.         (error "Bad cond syntax: " form)
  370.         (if (eq? (car c1) 'else)
  371.             `(begin ,@(cdr c1))
  372.         (if (null? (cdr c1))
  373.             `(or ,(car c1)
  374.              (cond ,@(cddr form)))
  375.         (if (eq? (cadr c1) '=>)
  376.           (let ((t (gensym "_t"))
  377.             (r (gensym "_r"))
  378.             (c (gensym "_c")))
  379.             `(let ((,t ,(car c1))
  380.                (,r (lambda () ,@(cddr c1)))
  381.                (,c (lambda () (cond ,@(cddr form)))))
  382.             (if ,t ((,r),t) (,c))) )
  383.           `(if ,(car c1)
  384.                (begin ,@(cdr c1))
  385.                (cond ,@(cddr form)))
  386.         )))))))
  387.  
  388.  
  389. ; (let* ((v1 e1) ...) body) =>  (let ((v1 e1)) (let* ( ... ) body))
  390. ;
  391. ; (let* () body) => (begin body)
  392.  
  393. (defmacro (let* form) ;
  394.     (if (not (pair? (cdr form)))
  395.     (error "Bad let* syntax: " form)
  396.     (if (null? (cadr form))
  397.         `(begin ,@(cddr form))
  398.         (if (and (pair? (cadr form)) (pair? (caadr form))
  399.                 (pair? (cdaadr form)))
  400.         `(let (( ,(caaadr form) ,(car (cdaadr form)) ))
  401.             (let* ,(cdadr form) ,@(cddr form)))
  402.         (error "Bad let* syntax: " form) ))))
  403.  
  404. ; (letrec ((var1 e1) ...)
  405. ;    body)
  406. ;
  407. ;  =>
  408. ;
  409. ; (let ((var1 #f) ...)
  410. ;     (let ((temp1 expression1) ...)
  411. ;      (set! var1 temp1) ...)
  412. ;     body)
  413. ;
  414. ; NB: We don't actually implement the inner let since it's not
  415. ;     strictly neccessary.
  416.  
  417. (defmacro (letrec form) ; form = (letrec ((v1 e1)...) . body)
  418.     (let ((vars  (#_map1 car (cadr form)))
  419.       (temps (#_map1 (lambda (x) (gensym "_temp")) (cadr form)))
  420.       (exprs (#_map1 cadr (cadr form)))
  421.       (body  (cddr form)) )
  422.     `(let (,@(#_map1 (lambda (x) `(,x #f)) vars))
  423.         (let (,@(map (lambda (x y) `(,x ,y)) temps exprs))
  424.         ,@(map (lambda (x y) `(set! ,x ,y)) vars temps)
  425.         ,@body ))  ))
  426.  
  427.  
  428. ; (case key
  429. ;     ((d1 ...) seq)
  430. ;     ...)
  431. ;
  432. ;  =>
  433. ;
  434. ; (let ((keyvar key))
  435. ;     (cond ((memv keyvar '(d1 ...)) seq)
  436. ;        ...)
  437. ;
  438. ; Note: the clause, (else seq) => (else seq)
  439.  
  440. (defmacro (case form)
  441.     (let ((keyvar  (gensym "_keyvar"))
  442.       (key     (cadr form))
  443.       (clauses (cddr form)))
  444.     `(let ((,keyvar ,key))
  445.         (cond
  446.         ,@(map (lambda (c)
  447.                 (if (eqv? (car c) 'else) c
  448.                 `((memv ,keyvar (quote ,(car c))) ,@(cdr c)) ))
  449.             clauses) ))  ))
  450.  
  451.  
  452. ; (do ((var1 init1 step1) ...)
  453. ;     (test seq)
  454. ;     cmd1 ...)
  455. ;
  456. ;   =>
  457. ;
  458. ; (letrec ((loop
  459. ;        (lambda (var1 ...)
  460. ;        (if test
  461. ;            (begin seq)
  462. ;            (begin cmd1
  463. ;               ...
  464. ;               (loop step1 ...))))))
  465. ;    (loop init1 ...))
  466.  
  467. (defmacro (do form)
  468.     (let  ((loop (gensym "_loop"))
  469.        (vars  (map car (cadr form)))
  470.        (inits (map cadr (cadr form)))
  471.        (steps (map (lambda (l) (if (= (length l) 3)
  472.                        (caddr l)
  473.                        (car l)))
  474.                (cadr form)))
  475.        (test  (caaddr form))
  476.        (seq   (cdaddr form))
  477.        (cmds  (cdddr form)))
  478.     `(letrec ((,loop
  479.            (lambda ,vars
  480.             (if ,test
  481.                 (begin ,@seq)
  482.                 (begin ,@cmds (,loop ,@steps))))))
  483.         (,loop ,@inits)) ))
  484.  
  485. ; PRIMITIVES requiring syntax defined above.
  486.  
  487. ; (list? obj)
  488.  
  489. (define (list? x)
  490.   (cond ((null? x) #t)
  491.     ((not (pair? x)) #f)
  492.     ((null? (cdr x)) #t)
  493.     ((not (pair? (cdr x))) #f)
  494.     (else (let loop ((fast (cddr x)) (slow (cdr x)))
  495.              (cond ((null? fast) #t)
  496.                ((or (not (pair? fast)) (eq? fast slow)) #f)
  497.                ((null? (cdr fast)) #t)
  498.                (else (loop (cddr fast) (cdr slow))))))))
  499.  
  500. ; (call-with-input-file string proc)
  501. ; (call-with-output-file string proc)
  502.  
  503. (define (call-with-input-file string proc )
  504.     (let* ((port (open-input-file string))
  505.        (result (proc port)))
  506.     (close-input-port port)
  507.     result))
  508.  
  509. (define (call-with-output-file string proc )
  510.     (let* ((port (open-output-file string))
  511.        (result (proc port)))
  512.     (close-output-port port)
  513.     result))
  514.  
  515. ; (with-input-from-file string thunk)
  516. ; (with-output-to-file string thunk)
  517.  
  518. (define (with-input-from-file string thunk)
  519.   (let ((save (current-input-port))
  520.     (port (open-input-file string)))
  521.     (set-current-input-port! port)
  522.     (let ((result (thunk)))
  523.       (close-input-port port)
  524.       (set-current-input-port! save)
  525.       result)))
  526.  
  527. (define (with-output-to-file string thunk)
  528.   (let ((save (current-output-port))
  529.     (port (open-output-file string)))
  530.     (set-current-output-port! port)
  531.     (let ((result (thunk)))
  532.       (close-output-port port)
  533.       (set-current-output-port! save)
  534.       result)))
  535.  
  536. ; ERROR HANDLING
  537.  
  538. (defmacro (break form)
  539.     (if (null? (cdr form))
  540.     '(#_break)
  541.     `(begin (display* ,@(cdr form)) (newline) (break)) ))
  542.  
  543. (define (error . args )
  544.     (newline)
  545.     (display "Error: ")
  546.     (apply display* args)
  547.     (newline)
  548.     (break) )
  549.  
  550. ; DEBUGGING
  551.  
  552. (define (trace . args ) (#_trace args)'())
  553.  
  554. (define (untrace . args) (#_untrace args)'())
  555.  
  556. (define (show-env . args)
  557.     (#_show-env (if (null? args)  20 (car args))))
  558.  
  559. (define (where . args)
  560.     (#_where (if (null? args)  20 (car args))))
  561.  
  562. (define (go arg . rest)
  563.      (if (null? rest) (#_go 0 arg) (#_go arg (car rest))))
  564.  
  565. (defmacro (how form)
  566.     `(#_how (quote ,(cadr form))))
  567.  
  568. ; EDITING
  569.  
  570. ; Define edit to remember the last file edited.
  571.  
  572. (define #_last-file-edited '())
  573.  
  574. ; (edit)
  575. ; (edit filename)
  576.  
  577. (define (edit . filestring)
  578.     (if (null? filestring)
  579.     (if (null? #_last-file-edited)
  580.         (error "(edit) not previously applied -- no file to remember.")
  581.         (#_edit #_last-file-edited))
  582.     (begin
  583.         (set! #_last-file-edited (car filestring))
  584.         (#_edit (car filestring))) ))
  585.  
  586. ; (edits)
  587. ; (edits filename)
  588.  
  589. (define (edits . filestring)
  590.     (if (null? filestring)
  591.     (if (null? #_last-file-edited)
  592.         (error "(edits) not previously applied -- no file to remember.")
  593.         (#_edits #_last-file-edited))
  594.     (begin
  595.         (set! #_last-file-edited (car filestring))
  596.         (#_edits (car filestring))) ))
  597.  
  598. ; UMB SPECIFIC
  599.  
  600. (define (write* first . rest)
  601.     (define port (if (output-port? first) first (current-output-port)))
  602.     (define (write** objs)
  603.     (if (pair? objs)
  604.         (begin (#_write (car objs) port) (write** (cdr objs)))))
  605.     (write** (if (output-port? first) rest (cons first rest))))
  606.  
  607.  
  608. (define (display* first . rest)
  609.     (define port (if (output-port? first) first (current-output-port)))
  610.     (define (display** objs)
  611.     (if (pair? objs)
  612.         (begin (#_display (car objs) port) (display** (cdr objs)))))
  613.     (display** (if (output-port? first) rest (cons first rest))))
  614.  
  615.  
  616.  
  617. ; PROCEDURES SUPPORTING THE ABLESON AND SUSSMAN TEXT
  618.  
  619. (defmacro (cons-stream form)
  620.     `(cons ,(cadr form) (delay ,(caddr form))))
  621.  
  622. (define head car)
  623. (define (tail stream) (force (cdr stream)))
  624.  
  625.  
  626. ; MAINTENANCE PROCEDURES
  627.  
  628. ; (expand-macro-call calling-form) -- code from expansion
  629.  
  630. (defmacro (expand-macro-call form)
  631.     `(expand-quoted-macro-call (quote ,(cadr form))))
  632.  
  633. ; (vi) -- edit this file
  634.  
  635. (define (vi) (edit "prelude.scheme"))
  636.  
  637. ; (factorial n) -- for demonstrating bignums
  638.  
  639. (define (factorial n)
  640.     (if (<= n 0) 1
  641.     (* n (factorial (- n 1))) ))
  642.  
  643.  
  644. (define (foo x y z)
  645.     (   (lambda (a b c) (+ (break) (+ x y z)))  z y x)  )
  646.  
  647. (define (divby x) (/ 100 x))
  648.  
  649. (define (goo n)
  650.     (if (= n 0) 1 (* 10 (goo (- n 1))) ))
  651.  
  652. (gc-messages #t)
  653.