| … | |
… | |
| 793 | default |
793 | default |
| 794 | (car data))) |
794 | (car data))) |
| 795 | |
795 | |
| 796 | (load "srfi-1.scm") |
796 | (load "srfi-1.scm") |
| 797 | |
797 | |
| 798 | ;(load "srfi-55.scm") |
|
|
| 799 | |
|
|
| 800 | ;(register-extension '(srfi 1) (lamba () (load "srfi-1.scm"))) |
|
|
| 801 | ;(register-extension '(srfi 23) (lamba () ())) ; error builtin |
|
|
| 802 | ;(register-extension '(srfi 55) (lamba () ())) ; always available |
|
|
| 803 | |
|
|
| 804 | ;; end of init |
|
|
| 805 | |
|
|
| 806 | ;(load "test.scm") |
|
|
| 807 | |
|
|
| 808 | ;; macros-by-example |
798 | ;; macros-by-example |
| 809 | |
799 | |
| 810 | (define append! |
800 | (define append! |
| 811 | (lambda args |
801 | (lambda args |
| 812 | (cond ((null? args) '()) |
802 | (cond ((null? args) '()) |
| 813 | ((null? (cdr args)) (car args)) |
803 | ((null? (cdr args)) (car args)) |
| 814 | ((null? (car args)) (apply comlist:nconc (cdr args))) |
804 | ((null? (car args)) (apply append! (cdr args))) |
| 815 | (else |
805 | (else |
| 816 | (set-cdr! (last-pair (car args)) |
806 | (set-cdr! (last-pair (car args)) |
| 817 | (apply comlist:nconc (cdr args))) |
807 | (apply append! (cdr args))) |
| 818 | (car args))))) |
808 | (car args))))) |
| 819 | |
809 | |
| 820 | (define (some pred lst . rest) |
810 | (define (some pred lst . rest) |
| 821 | (cond ((null? rest) |
811 | (cond ((null? rest) |
| 822 | (let mapf ((lst lst)) |
812 | (let mapf ((lst lst)) |
| … | |
… | |
| 835 | (else (let mapf ((lst lst) (rest rest)) |
825 | (else (let mapf ((lst lst) (rest rest)) |
| 836 | (or (null? lst) |
826 | (or (null? lst) |
| 837 | (and (apply pred (car lst) (map car rest)) |
827 | (and (apply pred (car lst) (map car rest)) |
| 838 | (mapf (cdr lst) (map cdr rest)))))))) |
828 | (mapf (cdr lst) (map cdr rest)))))))) |
| 839 | |
829 | |
|
|
830 | ;;;@ From: hugh@ear.mit.edu (Hugh Secker-Walker) |
|
|
831 | (define (nreverse rev-it) |
|
|
832 | ;;; Reverse order of elements of LIST by mutating cdrs. |
|
|
833 | (cond ((null? rev-it) rev-it) |
|
|
834 | ((not (list? rev-it)) |
|
|
835 | (error "nreverse: Not a list in arg1" rev-it)) |
|
|
836 | (else (do ((reved '() rev-it) |
|
|
837 | (rev-cdr (cdr rev-it) (cdr rev-cdr)) |
|
|
838 | (rev-it rev-it rev-cdr)) |
|
|
839 | ((begin (set-cdr! rev-it reved) (null? rev-cdr)) rev-it))))) |
|
|
840 | |
| 840 | (load "mbe.scm") |
841 | (load "mbe.scm") |
| 841 | |
842 | |
|
|
843 | (load "srfi-55.scm") |
|
|
844 | |
|
|
845 | (register-extension '(srfi 1) (lambda () ())) ; list library, always loaded |
|
|
846 | (register-extension '(srfi 8) (lambda () ())) ; receive always available |
|
|
847 | ;(register-extension '(srfi 9) (lambda () (load "srfi-9.scmx"))) |
|
|
848 | (register-extension '(srfi 11) (lambda () (load "srfi-11.scm"))) ; let-values |
|
|
849 | (register-extension '(srfi 13) (lambda () (load "srfi-13.scm"))) ; string library |
|
|
850 | (register-extension '(srfi 16) (lambda () (load "srfi-16.scm"))) ; casd-lambda |
|
|
851 | (register-extension '(srfi 23) (lambda () ())) ; error builtin |
|
|
852 | (register-extension '(srfi 42) (lambda () (load "srfi-42.scm"))) ; eager list comprehensions |
|
|
853 | (register-extension '(srfi 55) (lambda () ())) ; extension mechanism, always available |
|
|
854 | (register-extension '(srfi 61) (lambda () (load "srfi-61.scm"))) ; more general cond (=>) |
|
|
855 | |
|
|
856 | ;; end of init |
|
|
857 | |
|
|
858 | ;(load "test.scm") |
|
|
859 | |
| 842 | (load "test.scm") |
860 | (load "test.scm") |
| 843 | |
861 | |
| 844 | (gc-verbose #f) |
862 | (gc-verbose #f) |
|
|
863 | |
