| … | |
… | |
| 719 | ; compatibility functions added by schmorp@schmorp.de |
719 | ; compatibility functions added by schmorp@schmorp.de |
| 720 | (macro (defmacro dform) |
720 | (macro (defmacro dform) |
| 721 | (let ((name (cadr dform)) (formals (caddr dform)) (body (cdddr dform))) |
721 | (let ((name (cadr dform)) (formals (caddr dform)) (body (cdddr dform))) |
| 722 | `(define-macro (,name . ,formals) ,@body))) |
722 | `(define-macro (,name . ,formals) ,@body))) |
| 723 | |
723 | |
|
|
724 | ;; simple syntax-rules |
|
|
725 | |
|
|
726 | ;; values/call-with-values |
|
|
727 | ;(load "simple-syntax-rules/values.scm") |
|
|
728 | ;; (hash-)table |
|
|
729 | ;(load "simple-syntax-rules/table.scm") |
|
|
730 | ;; "the real stuff" |
|
|
731 | ;(load "simple-syntax-rules/usual.scm") |
|
|
732 | ;(load "simple-syntax-rules/rules.scm") |
|
|
733 | ;(load "simple-syntax-rules/memo.scm") |
|
|
734 | ;(load "simple-syntax-rules/syntax.scm") |
|
|
735 | ;(load "simple-syntax-rules/ev.scm") |
|
|
736 | ;(load "simple-syntax-rules/ex.scm") |
|
|
737 | ;(macro (define-syntax form) (expand form top-level-env)) |
|
|
738 | |
|
|
739 | ;(load "macros/expand.scm") |
|
|
740 | ;(load "macros/misc.scm") |
|
|
741 | ;(load "macros/prefs.scm") |
|
|
742 | ;(load "macros/syntaxenv.scm") |
|
|
743 | ;(load "macros/syntaxrules.scm") |
|
|
744 | ;(load "macros/usual.scm") |
|
|
745 | |
| 724 | ;; r7rs |
746 | ;; r7rs |
| 725 | ; char library |
747 | ; char library |
| 726 | ; string-upcase |
748 | ; string-upcase |
| 727 | ; string-downcase |
749 | ; string-downcase |
| 728 | ; string-foldcase |
750 | ; string-foldcase |
| … | |
… | |
| 743 | |
765 | |
| 744 | (load "srfi-1.scm") |
766 | (load "srfi-1.scm") |
| 745 | |
767 | |
| 746 | ;; end of init |
768 | ;; end of init |
| 747 | |
769 | |
| 748 | (load "test.scm") |
770 | ;(load "test.scm") |
| 749 | |
771 | |
|
|
772 | (define $sc-put-cte #f) |
|
|
773 | (define sc-expand #f) |
|
|
774 | (define $make-environment #f) |
|
|
775 | ;(define environment? #f) |
|
|
776 | ;(define interaction-environment #f) |
|
|
777 | (define identifier? #f) |
|
|
778 | (define syntax->list #f) |
|
|
779 | (define syntax-object->datum #f) |
|
|
780 | (define datum->syntax-object #f) |
|
|
781 | (define generate-temporaries #f) |
|
|
782 | (define free-identifier=? #f) |
|
|
783 | (define bound-identifier=? #f) |
|
|
784 | (define literal-identifier=? #f) |
|
|
785 | (define syntax-error #f) |
|
|
786 | (define $syntax-dispatch #f) |
|
|
787 | |
|
|
788 | (define void (lambda () (if #f #f))) |
|
|
789 | |
|
|
790 | (define andmap |
|
|
791 | (lambda (f first . rest) |
|
|
792 | (or (null? first) |
|
|
793 | (if (null? rest) |
|
|
794 | (let andmap ((first first)) |
|
|
795 | (let ((x (car first)) (first (cdr first))) |
|
|
796 | (if (null? first) |
|
|
797 | (f x) |
|
|
798 | (and (f x) (andmap first))))) |
|
|
799 | (let andmap ((first first) (rest rest)) |
|
|
800 | (let ((x (car first)) |
|
|
801 | (xr (map car rest)) |
|
|
802 | (first (cdr first)) |
|
|
803 | (rest (map cdr rest))) |
|
|
804 | (if (null? first) |
|
|
805 | (apply f (cons x xr)) |
|
|
806 | (and (apply f (cons x xr)) (andmap first rest))))))))) |
|
|
807 | |
|
|
808 | (define ormap |
|
|
809 | (lambda (proc list1) |
|
|
810 | (and (not (null? list1)) |
|
|
811 | (or (proc (car list1)) (ormap proc (cdr list1)))))) |
|
|
812 | |
|
|
813 | (load "psyntax.pp") |
