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