Changeset 10439 in project
- Timestamp:
- 04/14/08 06:38:02 (13 years ago)
- Location:
- chicken/branches/beyond-hope
- Files:
-
- 1 added
- 1 deleted
- 25 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/branches/beyond-hope/chicken-more-macros.scm
r10426 r10439 31 31 ;;; Non-standard macros: 32 32 33 #;(define-macro (define-record name . slots)34 (##sys#check-syntax 'define-record name 'symbol)35 (##sys#check-syntax 'define-record slots '#(symbol 0))36 (let ([prefix (symbol->string name)]37 [setters (memq #:record-setters ##sys#features)]38 [nsprefix (##sys#qualified-symbol-prefix name)] )39 `(begin40 (define ,(##sys#string->qualified-symbol nsprefix (string-append "make-" prefix))41 (lambda ,slots (##sys#make-structure ',name ,@slots)) )42 (define ,(##sys#string->qualified-symbol nsprefix (string-append prefix "?"))43 (lambda (x) (##sys#structure? x ',name)) )44 ,@(let mapslots ((slots slots) (i 1))45 (if (eq? slots '())46 slots47 (let* ((slotname (symbol->string (##sys#slot slots 0)))48 (setr (##sys#string->qualified-symbol nsprefix (string-append prefix "-" slotname "-set!")))49 (getr (##sys#string->qualified-symbol nsprefix (string-append prefix "-" slotname)) ) )50 (cons51 `(begin52 (define ,setr53 (lambda (x val)54 (##core#check (##sys#check-structure x ',name))55 (##sys#block-set! x ,i val) ) )56 (define ,getr57 ,(if setters58 `(getter-with-setter59 (lambda (x)60 (##core#check (##sys#check-structure x ',name))61 (##sys#block-ref x ,i) )62 ,setr)63 `(lambda (x)64 (##core#check (##sys#check-structure x ',name))65 (##sys#block-ref x ,i) ) ) ) )66 (mapslots (##sys#slot slots 1) (fx+ i 1)) ) ) ) ) ) ) )67 68 33 (##sys#extend-macro-environment 69 34 'receive … … 74 39 (%let (r 'let))) 75 40 (##sys#check-syntax 'receive form '(_ _ . #(_ 1))) 76 (cond ((null? (cd r form))41 (cond ((null? (cddr form)) 77 42 `(##sys#call-with-values (,%lambda () ,@(cdr form)) ##sys#list) ) 78 43 (else 79 44 (##sys#check-syntax 'receive form '(_ lambda-list exp . _)) 80 45 (let ((vars (cadr form)) 81 (rest (cddr form))) 46 (exp (caddr form)) 47 (rest (cdddr form))) 82 48 (if (and (pair? vars) (null? (cdr vars))) 83 `(,%let (,(car vars) ,(car rest)) 84 ,@(cddr rest)) 49 `(,%let ((,(car vars) ,exp)) ,@rest) 85 50 `(##sys#call-with-values 86 (,%lambda () , (car rest))87 (,%lambda ,vars ,@ (cdr rest)) ) ) ) ) )))))51 (,%lambda () ,exp) 52 (,%lambda ,vars ,@rest)) ) ) ) ) )))) 88 53 89 54 (##sys#extend-macro-environment … … 420 385 'define-inline "invalid substitution form - must be lambda" 421 386 name) ) 422 (list (list (r 'quote) name)val) ) ) ] )387 (list name val) ) ) ] ) 423 388 `(##core#define-inline ,@(quotify-proc args 'define-inline)))) ) ) ) 424 425 (##sys#extend-macro-environment426 'define-constant '()427 (##sys#er-transformer428 (lambda (form r c)429 (##sys#check-syntax 'define-constant form '(_ variable _))430 `(##core#define-constant (,(r 'quote) ,(cadr form)) ,(caddr form)))))431 389 432 390 (##sys#extend-macro-environment … … 1073 1031 (if ##sys#enable-runtime-macros 1074 1032 `(,(r 'define) ,name ,body) 1075 '( ,(r 'begin)) ) )))))1033 '(##sys#void))))))) 1076 1034 1077 1035 -
chicken/branches/beyond-hope/chicken-setup.scm
r10414 r10439 318 318 (map smooth explist) ) ) 319 319 320 (define-macro (run . explist) 321 `(run:execute (list ,@(map (lambda (x) (list 'quasiquote x)) explist))) ) 322 323 (define-macro (compile . explist) 324 `(run (csc ,@explist) ) ) 325 320 (cond-expand 321 (hygienic-macros 322 323 (define-syntax run 324 (syntax-rules () 325 ((_ exp ...) 326 (run:execute (list `exp ...))))) 327 328 (define-syntax compile 329 (syntax-rules () 330 ((_ exp ...) 331 (run (csc exp ...))))) 332 333 )(else)) ;*** deliberately not included before bootstrap 326 334 327 335 ;;; "make" functionality … … 446 454 argv) ) ) ) ) 447 455 448 (define-macro (make spec #!optional (argv ''())) 449 (let ((form-error (lambda (s . p) (apply error s spec p)))) 450 (and (or (list? spec) (form-error "illegal specification (not a sequence)")) 451 (or (pair? spec) (form-error "empty specification")) 452 (every 453 (lambda (line) 454 (and (or (and (list? line) (>= (length line) 2)) 455 (form-error "clause does not have at least 2 parts" line)) 456 (let ((name (car line))) 457 (or (list? (cadr line)) 458 (make:line-error "second part of clause is not a sequence" (cadr line) name))))) 459 spec)) 460 `(make/proc (list ,@(map (lambda (line) 461 `(list ,(car line) 462 (list ,@(cadr line)) 463 ,@(let ((l (cddr line))) 464 (if (null? l) 465 '() 466 `((lambda () 467 ,@l)))))) 468 spec)) 469 ,argv))) 470 456 (cond-expand 457 (hygienic-macros 458 459 (define-syntax make 460 (lambda (form r c) 461 (##sys#check-syntax 'make form '(_ spec . #(_ 0 1))) 462 (let ((spec (cadr form)) 463 (argv (optional argv ''())) 464 (%list (r 'list)) 465 (%lambda (r 'lambda))) 466 (let ((form-error (lambda (s . p) (apply error s spec p)))) 467 (and (or (list? spec) (form-error "illegal specification (not a sequence)")) 468 (or (pair? spec) (form-error "empty specification")) 469 (every 470 (lambda (line) 471 (and (or (and (list? line) (>= (length line) 2)) 472 (form-error "clause does not have at least 2 parts" line)) 473 (let ((name (car line))) 474 (or (list? (cadr line)) 475 (make:line-error "second part of clause is not a sequence" (cadr line) name))))) 476 spec)) 477 `(,(r 'make/proc) 478 (list ,@(map (lambda (line) 479 `(,%list ,(car line) 480 (,%list ,@(cadr line)) 481 ,@(let ((l (cddr line))) 482 (if (null? l) 483 '() 484 `((,%lambda () 485 ,@l)))))) 486 spec)) 487 ,argv))))) 488 489 )(else)) ;*** s.a. 471 490 472 491 ;;; Create new repository file -
chicken/branches/beyond-hope/compiler.scm
r10426 r10439 109 109 ; (foreign-safe-lambda* <type> ({(<type> <var>)})) {<string>}) 110 110 ; (foreign-primitive <type> ({(<type> <var>)}) {<string>}) 111 ; ( ##core#define-inline (quote <name>)<exp>)112 ; ( ##core#define-constant (quote <name>)<exp>)111 ; (define-inline <name> <exp>) 112 ; (define-constant <name> <exp>) 113 113 ; (##core#foreign-callback-wrapper <name> <qualifiers> <type> ({<type>}) <exp>) 114 114 ; (##core#define-external-variable (quote <name>) (quote <type>) (quote <bool>)) … … 705 705 (##sys#er-transformer 706 706 (eval/meta (caddr x)))) 707 (walk '(##core#undefined) se dest)) 707 (walk 708 (if ##sys#enable-runtime-macros 709 `(##sys#extend-macro-environment 710 ',(cadr x) 711 (##sys#current-environment) 712 (##sys#er-transformer 713 ,(caddr x))) ;*** possibly wrong se? 714 '(##core#undefined) ) 715 se dest)) 708 716 709 717 ((##core#named-lambda) … … 889 897 dest) ) ) ) 890 898 891 (( ##core#define-inline)892 (let* ([name ( cadr (second x))]899 ((define-inline) 900 (let* ([name (second x)] 893 901 [val (third x)] ) 894 902 (receive (val2 mlist) … … 904 912 se #f) ) ) ) 905 913 906 (( ##core#define-constant)907 (let* ([name ( cadr (second x))]914 ((define-constant) 915 (let* ([name (second x)] 908 916 [valexp (third x)] 909 917 [val (handle-exceptions ex -
chicken/branches/beyond-hope/distribution/manifest
r10378 r10439 108 108 chicken-ffi-macros.scm 109 109 chicken-more-macros.scm 110 chicken-sys-macros.scm111 110 chicken-profile.1 112 111 chicken-profile.scm -
chicken/branches/beyond-hope/eval.scm
r10426 r10439 39 39 (apply print arg1 more))) 40 40 41 (define-macro (d . _) '(void)) 41 (cond-expand 42 (hygienic-macros 43 (define-syntax d (syntax-rules () ((_ . _) (void)))) ) 44 (else 45 (define-macro (d . _) '(void)))) ;*** remove later 42 46 43 47 #> … … 91 95 ##sys#expand-0) ) ] ) 92 96 93 (cond-expand 94 [unsafe 95 (eval-when (compile) 96 (define-macro (##sys#check-structure . _) '(##core#undefined)) 97 (define-macro (##sys#check-range . _) '(##core#undefined)) 98 (define-macro (##sys#check-pair . _) '(##core#undefined)) 99 (define-macro (##sys#check-list . _) '(##core#undefined)) 100 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 101 (define-macro (##sys#check-string . _) '(##core#undefined)) 102 (define-macro (##sys#check-char . _) '(##core#undefined)) 103 (define-macro (##sys#check-exact . _) '(##core#undefined)) 104 (define-macro (##sys#check-port . _) '(##core#undefined)) 105 (define-macro (##sys#check-number . _) '(##core#undefined)) 106 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 107 [else 108 (declare (emit-exports "eval.exports"))]) 109 97 (include "unsafe-declarations.scm") 98 99 (cond-expand 100 ((not unsafe) (declare (emit-exports "eval.exports"))) 101 (else)) 110 102 111 103 (define-foreign-variable install-egg-home c-string "C_INSTALL_EGG_HOME") … … 662 654 (compile '(##core#undefined) e #f tf cntr se) ] 663 655 664 [( ##core#define-inline ##core#define-constant)665 (compile `(,(rename ' set! se) ,(cadadr x) ,@(cddr x)) e #f tf cntr se) ]656 [(define-inline define-constant) 657 (compile `(,(rename 'define se) ,@(cdr x)) e #f tf cntr se) ] 666 658 667 659 [(##core#primitive ##core#inline ##core#inline_allocate ##core#foreign-lambda … … 1132 1124 (values 1133 1125 (if comp? 1134 `(##core#declare '(uses ,id))1126 `(##core#declare (uses ,id)) 1135 1127 `(load-library ',id) ) 1136 1128 #t) ) … … 1142 1134 ,@(if s `((##core#require-for-syntax ',id)) '()) 1143 1135 ,(if comp? 1144 `(##core#declare '(uses ,id))1136 `(##core#declare (uses ,id)) 1145 1137 `(load-library ',id) ) ) 1146 1138 #t) ) ) -
chicken/branches/beyond-hope/expand.scm
r10427 r10439 43 43 (apply print arg1 more))) 44 44 45 (define-macro (d . _) '(void)) 45 (cond-expand 46 (hygienic-macros 47 (define-syntax d (syntax-rules () ((_ . _) (void))))) 48 (else (define-macro (d . _) '(void)))) ;*** 46 49 47 50 -
chicken/branches/beyond-hope/extras.scm
r9587 r10439 81 81 hash-table-canonical-length hash-table-rehash) ) 82 82 83 (include "unsafe-declarations.scm") 84 83 85 (cond-expand 84 [unsafe 85 (eval-when (compile) 86 (define-macro (##sys#check-closure . _) '(##core#undefined)) 87 (define-macro (##sys#check-inexact . _) '(##core#undefined)) 88 (define-macro (##sys#check-structure . _) '(##core#undefined)) 89 (define-macro (##sys#check-range . _) '(##core#undefined)) 90 (define-macro (##sys#check-pair . _) '(##core#undefined)) 91 (define-macro (##sys#check-list . _) '(##core#undefined)) 92 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 93 (define-macro (##sys#check-string . _) '(##core#undefined)) 94 (define-macro (##sys#check-char . _) '(##core#undefined)) 95 (define-macro (##sys#check-exact . _) '(##core#undefined)) 96 (define-macro (##sys#check-port . _) '(##core#undefined)) 97 (define-macro (##sys#check-number . _) '(##core#undefined)) 98 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 99 [else 100 (declare (emit-exports "extras.exports")) ] ) 86 ((not unsafe) 87 (declare (emit-exports "extras.exports")) ) 88 (else)) 101 89 102 90 (register-feature! 'extras) … … 105 93 ;;; Unbound Value: 106 94 107 ;; This only works because of '(no-bound-checks)' 108 109 (define-macro ($unbound-value) 110 '(##sys#slot '##sys#arbitrary-unbound-symbol 0) ) 95 (define-inline ($unbound-value) 96 (##sys#slot '##sys#arbitrary-unbound-symbol 0)) 111 97 112 98 (define unbound-value-thunk (lambda () ($unbound-value))) 113 99 114 (define- macro($unbound? ?val)115 `(eq? ($unbound-value) ,?val) )100 (define-inline ($unbound? ?val) 101 (eq? ($unbound-value) ?val) ) 116 102 117 103 118 104 ;;; Core Inlines: 119 105 120 (define- macro($quick-flonum-truncate ?flo)121 `(##core#inline "C_quickflonumtruncate" ,?flo) )122 123 (define- macro($fix ?wrd)124 `(##core#inline "C_fix" ,?wrd) )125 126 (define- macro($block? ?obj)127 `(##core#inline "C_blockp" ,?obj) )128 129 (define- macro($special? ?obj)130 `(##core#inline "C_specialp" ,?obj) )131 132 (define- macro($port? ?obj)133 `(##core#inline "C_portp" ,?obj) )134 135 (define- macro($byte-block? ?obj)136 `(##core#inline "C_byteblockp" ,?obj) )137 138 (define- macro($hash-string ?str)139 `(##core#inline "C_hash_string" ,?str) )140 141 (define- macro($hash-string-ci ?str)142 `(##core#inline "C_hash_string_ci" ,?str) )106 (define-inline ($quick-flonum-truncate ?flo) 107 (##core#inline "C_quickflonumtruncate" ?flo) ) 108 109 (define-inline ($fix ?wrd) 110 (##core#inline "C_fix" ?wrd) ) 111 112 (define-inline ($block? ?obj) 113 (##core#inline "C_blockp" ?obj) ) 114 115 (define-inline ($special? ?obj) 116 (##core#inline "C_specialp" ?obj) ) 117 118 (define-inline ($port? ?obj) 119 (##core#inline "C_portp" ?obj) ) 120 121 (define-inline ($byte-block? ?obj) 122 (##core#inline "C_byteblockp" ?obj) ) 123 124 (define-inline ($hash-string ?str) 125 (##core#inline "C_hash_string" ?str) ) 126 127 (define-inline ($hash-string-ci ?str) 128 (##core#inline "C_hash_string_ci" ?str) ) 143 129 144 130 145 131 ;;; 146 132 147 (define- macro($immediate? ?obj)148 `(not ($block? ,?obj)) )133 (define-inline ($immediate? ?obj) 134 (not ($block? ?obj)) ) 149 135 150 136 -
chicken/branches/beyond-hope/library.scm
r10420 r10439 347 347 (##core#inline "C_i_check_closure" x) ) ) 348 348 349 (cond-expand 350 [unsafe 351 (eval-when (compile) 352 (define-macro (##sys#check-closure . _) '(##core#undefined)) 353 (define-macro (##sys#check-structure . _) '(##core#undefined)) 354 (define-macro (##sys#check-range . _) '(##core#undefined)) 355 (define-macro (##sys#check-pair . _) '(##core#undefined)) 356 (define-macro (##sys#check-list . _) '(##core#undefined)) 357 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 358 (define-macro (##sys#check-string . _) '(##core#undefined)) 359 (define-macro (##sys#check-char . _) '(##core#undefined)) 360 (define-macro (##sys#check-exact . _) '(##core#undefined)) 361 (define-macro (##sys#check-port . _) '(##core#undefined)) 362 (define-macro (##sys#check-port* . _) '(##core#undefined)) 363 (define-macro (##sys#check-port-mode . _) '(##core#undefined)) 364 (define-macro (##sys#check-number . _) '(##core#undefined)) 365 (define-macro (##sys#check-special . _) '(##core#undefined)) 366 (define-macro (##sys#check-blob . _) '(##core#undefined)) 367 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 368 [else] ) 349 (include "unsafe-declarations.scm") 369 350 370 351 (define (##sys#force promise) -
chicken/branches/beyond-hope/lolevel.scm
r8361 r10439 62 62 ##sys#vector->closure! ##sys#error ##sys#signal-hook ##sys#address->pointer ##sys#pointer->address) ) ] ) 63 63 64 (include "unsafe-declarations.scm") 65 64 66 (cond-expand 65 [unsafe 66 (eval-when (compile) 67 (define-macro (##sys#check-structure . _) '(##core#undefined)) 68 (define-macro (##sys#check-range . _) '(##core#undefined)) 69 (define-macro (##sys#check-pair . _) '(##core#undefined)) 70 (define-macro (##sys#check-list . _) '(##core#undefined)) 71 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 72 (define-macro (##sys#check-string . _) '(##core#undefined)) 73 (define-macro (##sys#check-char . _) '(##core#undefined)) 74 (define-macro (##sys#check-exact . _) '(##core#undefined)) 75 (define-macro (##sys#check-port . _) '(##core#undefined)) 76 (define-macro (##sys#check-number . _) '(##core#undefined)) 77 (define-macro (##sys#check-pointer . _) '(##core#undefined)) 78 (define-macro (##sys#check-special . _) '(##core#undefined)) 79 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 80 [else 81 (declare (emit-exports "lolevel.exports"))] ) 67 ((not unsafe) 68 (declare (emit-exports "lolevel.exports"))) 69 (else)) 82 70 83 71 (register-feature! 'lolevel) -
chicken/branches/beyond-hope/manual/Acknowledgements
r9418 r10439 62 62 ; Olin Shivers : implementation of {{let-optionals[*]}} and reference implementations of SRFI-1, SRFI-13 and SRFI-14. 63 63 ; Andrew Wilcox : queues. 64 ; Andrew Wright : pattern matcher.65 64 ; [[http://chicken.wiki.br/Alex Shinn|Alex Shinn]] : {{scheme-complete.el}} emacs tab-completion 66 65 -
chicken/branches/beyond-hope/posixunix.scm
r9331 r10439 483 483 canonical-path) ) ] ) 484 484 485 (include "unsafe-declarations.scm") 486 485 487 (cond-expand 486 [unsafe 487 (eval-when (compile) 488 (define-macro (##sys#check-structure . _) '(##core#undefined)) 489 (define-macro (##sys#check-range . _) '(##core#undefined)) 490 (define-macro (##sys#check-pair . _) '(##core#undefined)) 491 (define-macro (##sys#check-list . _) '(##core#undefined)) 492 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 493 (define-macro (##sys#check-string . _) '(##core#undefined)) 494 (define-macro (##sys#check-char . _) '(##core#undefined)) 495 (define-macro (##sys#check-exact . _) '(##core#undefined)) 496 (define-macro (##sys#check-port . _) '(##core#undefined)) 497 (define-macro (##sys#check-number . _) '(##core#undefined)) 498 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 499 [else 500 (declare (emit-exports "posix.exports")) ] ) 488 ((not unsafe) 489 (declare (emit-exports "posix.exports")) ) 490 (else)) 501 491 502 492 (register-feature! 'posix) -
chicken/branches/beyond-hope/posixwin.scm
r9325 r10439 925 925 ##sys#peek-fixnum ##sys#make-structure ##sys#check-structure ##sys#enable-interrupts) ) ] ) 926 926 927 (include "unsafe-declarations.scm") 928 927 929 (cond-expand 928 [unsafe 929 (eval-when (compile) 930 (define-macro (##sys#check-structure . _) '(##core#undefined)) 931 (define-macro (##sys#check-range . _) '(##core#undefined)) 932 (define-macro (##sys#check-pair . _) '(##core#undefined)) 933 (define-macro (##sys#check-list . _) '(##core#undefined)) 934 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 935 (define-macro (##sys#check-string . _) '(##core#undefined)) 936 (define-macro (##sys#check-char . _) '(##core#undefined)) 937 (define-macro (##sys#check-exact . _) '(##core#undefined)) 938 (define-macro (##sys#check-port . _) '(##core#undefined)) 939 (define-macro (##sys#check-number . _) '(##core#undefined)) 940 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 941 [else 942 (declare (emit-exports "posix.exports"))] ) 930 ((not unsafe) 931 (declare (emit-exports "posix.exports"))) 932 (else)) 943 933 944 934 (register-feature! 'posix) -
chicken/branches/beyond-hope/private-namespace.scm
r8361 r10439 26 26 27 27 28 (define-macro (private . args) 29 (let ((namespace (car args)) 30 (vars (cdr args))) 31 (##sys#check-symbol namespace 'private) 32 (let* ((str (symbol->string namespace)) 33 (prefix (string-append 34 (string (integer->char (string-length str))) 35 (symbol->string namespace)))) 36 (for-each 37 (lambda (var) 38 (put! 39 var 'c:namespace 40 (##sys#string->qualified-symbol prefix (symbol->string var)))) 41 vars) 42 '(void) ) ) ) 28 (cond-expand 29 (hygienic-macros 30 (define-syntax private 31 (lambda (form r c) 32 (let ((namespace (cadr form)) 33 (vars (cddr args))) 34 (##sys#check-symbol namespace 'private) 35 (let* ((str (symbol->string namespace)) ; somewhat questionable (renaming) 36 (prefix (string-append 37 (string (integer->char (string-length str))) 38 (symbol->string namespace)))) 39 (for-each 40 (lambda (var) 41 (put! 42 var 'c:namespace 43 (##sys#string->qualified-symbol prefix (symbol->string var)))) 44 vars) 45 '(##sys#void) ) ) ) ) ) 46 (else 47 (define-macro (private . args) 48 (let ((namespace (car args)) 49 (vars (cdr args))) 50 (##sys#check-symbol namespace 'private) 51 (let* ((str (symbol->string namespace)) 52 (prefix (string-append 53 (string (integer->char (string-length str))) 54 (symbol->string namespace)))) 55 (for-each 56 (lambda (var) 57 (put! 58 var 'c:namespace 59 (##sys#string->qualified-symbol prefix (symbol->string var)))) 60 vars) 61 '(void) ) ) ) ) ) 43 62 44 63 (set! ##sys#alias-global-hook -
chicken/branches/beyond-hope/regex.scm
r10377 r10439 68 68 (no-procedure-checks-for-usual-bindings) ) ] ) 69 69 70 (include "unsafe-declarations.scm") 71 70 72 (cond-expand 71 [unsafe 72 (eval-when (compile) 73 (define-macro (##sys#check-chardef-table . _) '(##core#undefined)) 74 (define-macro (##sys#check-integer . _) '(##core#undefined)) 75 (define-macro (##sys#check-blob . _) '(##core#undefined)) 76 (define-macro (##sys#check-vector . _) '(##core#undefined)) 77 (define-macro (##sys#check-structure . _) '(##core#undefined)) 78 (define-macro (##sys#check-range . _) '(##core#undefined)) 79 (define-macro (##sys#check-pair . _) '(##core#undefined)) 80 (define-macro (##sys#check-list . _) '(##core#undefined)) 81 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 82 (define-macro (##sys#check-string . _) '(##core#undefined)) 83 (define-macro (##sys#check-char . _) '(##core#undefined)) 84 (define-macro (##sys#check-exact . _) '(##core#undefined)) 85 (define-macro (##sys#check-port . _) '(##core#undefined)) 86 (define-macro (##sys#check-number . _) '(##core#undefined)) 87 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 88 [else 73 ((not unsafe) 89 74 (define (##sys#check-chardef-table x loc) 90 75 (unless (regex-chardef-table? x) … … 97 82 (export 98 83 ##sys#check-chardef-table ) 99 (emit-exports "regex.exports") ) ] ) 84 (emit-exports "regex.exports") ) ) 85 (else)) 100 86 101 87 -
chicken/branches/beyond-hope/rules.make
r10377 r10439 816 816 $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) LICENSE $(DESTDIR)$(IDOCDIR) 817 817 $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) chicken-more-macros.scm $(DESTDIR)$(IDATADIR) 818 $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) chicken-ffi-macros.scm $(DESTDIR)$(IDATADIR)819 $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) chicken-sys-macros.scm $(DESTDIR)$(IDATADIR)820 818 $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) *.exports $(DESTDIR)$(IDATADIR) 821 819 -$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) chicken.info $(DESTDIR)$(IINFODIR) … … 893 891 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ 894 892 895 ulibrary.c: library.scm version.scm banner.scm 896 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 897 ueval.c: eval.scm 898 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 899 uextras.c: extras.scm private-namespace.scm 893 ulibrary.c: library.scm version.scm banner.scm unsafe-declarations.scm 894 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 895 ueval.c: eval.scm unsafe-declarations.scm 896 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 897 uextras.c: extras.scm private-namespace.scm unsafe-declarations.scm 900 898 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ -extend private-namespace.scm 901 ulolevel.c: lolevel.scm 902 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 903 utcp.c: tcp.scm 904 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 905 usrfi-1.c: srfi-1.scm 906 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 907 usrfi-4.c: srfi-4.scm 908 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 909 usrfi-13.c: srfi-13.scm 910 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 911 usrfi-14.c: srfi-14.scm 912 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 913 usrfi-18.c: srfi-18.scm 914 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 915 uutils.c: utils.scm 916 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 917 uposixunix.c: posixunix.scm 918 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 919 uposixwin.c: posixwin.scm 920 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 921 uregex.c: regex.scm 899 ulolevel.c: lolevel.scm unsafe-declarations.scm 900 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 901 utcp.c: tcp.scm unsafe-declarations.scm 902 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 903 usrfi-1.c: srfi-1.scm unsafe-declarations.scm 904 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 905 usrfi-4.c: srfi-4.scm unsafe-declarations.scm 906 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 907 usrfi-13.c: srfi-13.scm unsafe-declarations.scm 908 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 909 usrfi-14.c: srfi-14.scm unsafe-declarations.scm 910 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 911 usrfi-18.c: srfi-18.scm unsafe-declarations.scm 912 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 913 uutils.c: utils.scm unsafe-declarations.scm 914 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 915 uposixunix.c: posixunix.scm unsafe-declarations.scm 916 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 917 uposixwin.c: posixwin.scm unsafe-declarations.scm 918 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 919 uregex.c: regex.scm unsafe-declarations.scm 922 920 $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_PCRE_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ 923 921 … … 1003 1001 .PHONY: check fullcheck compiler-check 1004 1002 1005 check: all1003 check: $(CHICKEN_SHARED_EXECUTABLE)$(EXE) $(CSI_SHARED_EXECUTABLE)$(EXE) $(CSC_PROGRAM)$(EXE) 1006 1004 cd tests; sh runtests.sh 1007 1005 -
chicken/branches/beyond-hope/scheduler.scm
r8361 r10439 88 88 89 89 90 (define-macro (dbg . args) #f) 91 #;(define-macro (dbg . args) 92 `(print "DBG: " ,@args) ) 90 (cond-expand 91 (hygienic-macros 92 (define-syntax dbg 93 (syntax-rules () 94 ((_ . _) #f))) ) 95 (else 96 (define-macro (dbg . args) #f) 97 #;(define-macro (dbg . args) 98 `(print "DBG: " ,@args) ) ) ) 93 99 94 100 -
chicken/branches/beyond-hope/srfi-1.scm
r1186 r10439 41 41 (no-bound-checks) ) ] ) 42 42 43 (include "unsafe-declarations.scm") 44 43 45 (cond-expand 44 [unsafe 45 (eval-when (compile) 46 (define-macro (##sys#check-structure . _) '(##core#undefined)) 47 (define-macro (##sys#check-range . _) '(##core#undefined)) 48 (define-macro (##sys#check-pair . _) '(##core#undefined)) 49 (define-macro (##sys#check-list . _) '(##core#undefined)) 50 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 51 (define-macro (##sys#check-string . _) '(##core#undefined)) 52 (define-macro (##sys#check-char . _) '(##core#undefined)) 53 (define-macro (##sys#check-exact . _) '(##core#undefined)) 54 (define-macro (##sys#check-port . _) '(##core#undefined)) 55 (define-macro (##sys#check-number . _) '(##core#undefined)) 56 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 57 [else 58 (declare (emit-exports "srfi-1.exports"))] ) 46 ((not unsafe) 47 (declare (emit-exports "srfi-1.exports"))) 48 (else)) 59 49 60 50 (register-feature! 'srfi-1) 61 62 (eval-when (compile eval)63 (define-macro (:optional arg default)64 (let ([var (gensym)])65 `(let ((,var ,arg))66 (if (null? ,var)67 ,default68 (car ,var) ) ) ) ) )69 51 70 52 … … 337 319 (##sys#check-number count 'iota) 338 320 (if (< count 0) (##sys#error 'iota "Negative step count" iota count)) 339 (let ((start (:optional maybe-start+step 0)) 340 (step (if (pair? maybe-start+step) 341 (:optional (cdr maybe-start+step) 1) 342 1) ) ) 321 (let-optionals maybe-start+step ((start 0) ; Olin, I'm tired of fixing your stupid bugs - why didn't 322 (step 1) ) ; you use your own macros, then? 343 323 (##sys#check-number start 'iota) 344 324 (##sys#check-number step 'iota) … … 878 858 ; (check-arg procedure? f unfold-right) 879 859 ; (check-arg procedure? g unfold-right) 880 (let lp ((seed seed) (ans ( :optional maybe-tail '())))860 (let lp ((seed seed) (ans (optional maybe-tail '()))) 881 861 (if (p seed) ans 882 862 (lp (g seed) … … 1276 1256 1277 1257 (define (delete x lis . maybe-=) 1278 (let ((= ( :optional maybe-= equal?)))1258 (let ((= (optional maybe-= equal?))) 1279 1259 (filter (lambda (y) (not (= x y))) lis))) 1280 1260 1281 1261 (define (delete! x lis . maybe-=) 1282 (let ((= ( :optional maybe-= equal?)))1262 (let ((= (optional maybe-= equal?))) 1283 1263 (filter! (lambda (y) (not (= x y))) lis))) 1284 1264 1285 1265 ;;; Extended from R4RS to take an optional comparison argument. 1286 1266 (define (member x lis . maybe-=) 1287 (let ((= ( :optional maybe-= equal?)))1267 (let ((= (optional maybe-= equal?))) 1288 1268 (find-tail (lambda (y) (= x y)) lis))) 1289 1269 … … 1305 1285 1306 1286 (define (delete-duplicates lis . maybe-=) 1307 (let ((elt= ( :optional maybe-= equal?)))1287 (let ((elt= (optional maybe-= equal?))) 1308 1288 ; (check-arg procedure? elt= delete-duplicates) 1309 1289 (let recur ((lis lis)) … … 1315 1295 1316 1296 (define (delete-duplicates! lis . maybe-=) 1317 (let ((elt= ( :optional maybe-= equal?)))1297 (let ((elt= (optional maybe-= equal?))) 1318 1298 ; (check-arg procedure? elt= delete-duplicates!) 1319 1299 (let recur ((lis lis)) … … 1330 1310 ;;; Extended from R4RS to take an optional comparison argument. 1331 1311 (define (assoc x lis . maybe-=) 1332 (let ((= ( :optional maybe-= equal?)))1312 (let ((= (optional maybe-= equal?))) 1333 1313 (find (lambda (entry) (= x (car entry))) lis))) 1334 1314 … … 1340 1320 1341 1321 (define (alist-delete key alist . maybe-=) 1342 (let ((= ( :optional maybe-= equal?)))1322 (let ((= (optional maybe-= equal?))) 1343 1323 (filter (lambda (elt) (not (= key (car elt)))) alist))) 1344 1324 1345 1325 (define (alist-delete! key alist . maybe-=) 1346 (let ((= ( :optional maybe-= equal?)))1326 (let ((= (optional maybe-= equal?))) 1347 1327 (filter! (lambda (elt) (not (= key (car elt)))) alist))) 1348 1328 -
chicken/branches/beyond-hope/srfi-13.scm
r9254 r10439 45 45 (no-bound-checks) ) ] ) 46 46 47 (include "unsafe-declarations.scm") 48 47 49 (cond-expand 48 [unsafe 49 (eval-when (compile) 50 (define-macro (##sys#check-structure . _) '(##core#undefined)) 51 (define-macro (##sys#check-range . _) '(##core#undefined)) 52 (define-macro (##sys#check-pair . _) '(##core#undefined)) 53 (define-macro (##sys#check-list . _) '(##core#undefined)) 54 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 55 (define-macro (##sys#check-string . _) '(##core#undefined)) 56 (define-macro (##sys#check-char . _) '(##core#undefined)) 57 (define-macro (##sys#check-exact . _) '(##core#undefined)) 58 (define-macro (##sys#check-port . _) '(##core#undefined)) 59 (define-macro (##sys#check-number . _) '(##core#undefined)) 60 (define-macro (##sys#check-bytevector . _) '(##core#undefined)) ) ] 61 [else 62 (declare (emit-exports "srfi-13.exports"))] ) 50 ((not unsafe) 51 (declare (emit-exports "srfi-13.exports"))) 52 (else)) 63 53 64 54 (register-feature! 'srfi-13) -
chicken/branches/beyond-hope/srfi-14.scm
r1186 r10439 24 24 (no-bound-checks) ) ] ) 25 25 26 (include "unsafe-declarations.scm") 27 26 28 (cond-expand 27 [unsafe 28 (eval-when (compile) 29 (define-macro (##sys#check-structure . _) '(##core#undefined)) 30 (define-macro (##sys#check-range . _) '(##core#undefined)) 31 (define-macro (##sys#check-pair . _) '(##core#undefined)) 32 (define-macro (##sys#check-list . _) '(##core#undefined)) 33 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 34 (define-macro (##sys#check-string . _) '(##core#undefined)) 35 (define-macro (##sys#check-char . _) '(##core#undefined)) 36 (define-macro (##sys#check-exact . _) '(##core#undefined)) 37 (define-macro (##sys#check-port . _) '(##core#undefined)) 38 (define-macro (##sys#check-number . _) '(##core#undefined)) 39 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 40 [else 41 (declare (emit-exports "srfi-14.exports"))] ) 29 ((not unsafe) 30 (declare (emit-exports "srfi-14.exports"))) 31 (else)) 42 32 43 33 (register-feature! 'srfi-14) -
chicken/branches/beyond-hope/srfi-18.scm
r8361 r10439 51 51 ##sys#delq ##sys#compute-time-limit ##sys#fudge) ) ] ) 52 52 53 (include "unsafe-declarations.scm") 54 53 55 (cond-expand 54 [unsafe 55 (eval-when (compile) 56 (define-macro (##sys#check-structure . _) '(##core#undefined)) 57 (define-macro (##sys#check-range . _) '(##core#undefined)) 58 (define-macro (##sys#check-pair . _) '(##core#undefined)) 59 (define-macro (##sys#check-list . _) '(##core#undefined)) 60 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 61 (define-macro (##sys#check-string . _) '(##core#undefined)) 62 (define-macro (##sys#check-char . _) '(##core#undefined)) 63 (define-macro (##sys#check-exact . _) '(##core#undefined)) 64 (define-macro (##sys#check-port . _) '(##core#undefined)) 65 (define-macro (##sys#check-number . _) '(##core#undefined)) 66 (define-macro (##sys#check-byte-vector . _) '(##core#undefined)) ) ] 67 [else 68 (declare (emit-exports "srfi-18.exports"))] ) 56 ((not unsafe) 57 (declare (emit-exports "srfi-18.exports"))) 58 (else)) 69 59 70 60 (register-feature! 'srfi-18) 71 61 72 (define-macro (dbg . args) #f) 73 #;(define-macro (dbg . args) 74 `(print "DBG: " ,@args) ) 62 (cond-expand 63 (hygienic-macros 64 (define-syntax dbg 65 (syntax-rules () 66 ((_ . _) #f))) ) 67 (else 68 (define-macro (dbg . args) #f) 69 #;(define-macro (dbg . args) 70 `(print "DBG: " ,@args) ) ) ) 75 71 76 72 -
chicken/branches/beyond-hope/srfi-4.scm
r8361 r10439 80 80 ##sys#not-a-proper-list-error ##sys#print ##sys#allocate-vector) ) ] ) 81 81 82 (include "unsafe-declarations.scm") 83 82 84 (cond-expand 83 [unsafe 84 (eval-when (compile) 85 (define-macro (##sys#check-structure . _) '(##core#undefined)) 86 (define-macro (##sys#check-range . _) '(##core#undefined)) 87 (define-macro (##sys#check-pair . _) '(##core#undefined)) 88 (define-macro (##sys#check-list . _) '(##core#undefined)) 89 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 90 (define-macro (##sys#check-string . _) '(##core#undefined)) 91 (define-macro (##sys#check-char . _) '(##core#undefined)) 92 (define-macro (##sys#check-exact . _) '(##core#undefined)) 93 (define-macro (##sys#check-port . _) '(##core#undefined)) 94 (define-macro (##sys#check-number . _) '(##core#undefined)) 95 (define-macro (##sys#check-bytevector . _) '(##core#undefined)) ) ] 96 [else 97 (declare (emit-exports "srfi-4.exports"))] ) 85 ((not unsafe) 86 (declare (emit-exports "srfi-4.exports"))) 87 (else)) 98 88 99 89 -
chicken/branches/beyond-hope/tcp.scm
r9040 r10439 87 87 ) ) 88 88 89 (include "unsafe-declarations.scm") 90 89 91 (register-feature! 'tcp) 90 92 91 93 (cond-expand 92 (unsafe 93 (eval-when (compile) 94 (define-macro (##sys#check-structure x y . _) '(##core#undefined)) 95 (define-macro (##sys#check-range x y z) '(##core#undefined)) 96 (define-macro (##sys#check-pair x) '(##core#undefined)) 97 (define-macro (##sys#check-list x) '(##core#undefined)) 98 (define-macro (##sys#check-symbol x) '(##core#undefined)) 99 (define-macro (##sys#check-string x) '(##core#undefined)) 100 (define-macro (##sys#check-char x) '(##core#undefined)) 101 (define-macro (##sys#check-exact x . _) '(##core#undefined)) 102 (define-macro (##sys#check-port x . _) '(##core#undefined)) 103 (define-macro (##sys#check-number x) '(##core#undefined)))) 104 (else 105 (declare (emit-exports "tcp.exports"))) ) 94 ((not unsafe) 95 (declare (emit-exports "tcp.exports"))) 96 (else)) 106 97 107 98 (define-foreign-variable errno int "errno") -
chicken/branches/beyond-hope/tests/path-tests.scm
r4232 r10439 1 1 (use utils) 2 (define-macro (test x) `(printf "~s\t=> ~s~%" ',x ,x)) 2 (define-syntax test 3 (syntax-rules () 4 ((_ x) `(printf "~s\t=> ~s~%" ',x ,x)))) 3 5 (test (pathname-directory "/")) 4 6 (test (pathname-directory "/abc")) -
chicken/branches/beyond-hope/tests/srfi-18-tests.scm
r1713 r10439 3 3 (cond-expand (dribble 4 4 (define-for-syntax count 0) 5 6 (define-macro (trail loc expr) 7 (set! count (add1 count))8 `(begin 9 (print "(" ,count ") " ,loc ": " ',expr ": get: " (##sys#slot get-mutex 5) ", put: " (##sys#slot put-mutex 5))10 (let ((xxx ,expr))11 (print "(" ,count ") " ,loc ": " ',expr ": get: " (##sys#slot get-mutex 5) ", put: " (##sys#slot put-mutex 5))12 xxx) ))13 )(else 14 (define-macro (trail loc expr) expr)15 ))5 (define-syntax trail 6 (lambda (form r c) ; doesn't bother much with renaming 7 (let ((loc (cadr form)) 8 (expr (caddr form))) 9 (set! count (add1 count)) 10 `(,(r 'begin) 11 (print "(" ,count ") " ,loc ": " ',expr ": get: " (##sys#slot get-mutex 5) ", put: " (##sys#slot put-mutex 5)) 12 (let ((xxx ,expr)) 13 (print " (" ,count ") " ,loc ": " ',expr ": get: " (##sys#slot get-mutex 5) ", put: " (##sys#slot put-mutex 5)) 14 xxx) ) )))) 15 (else (define-syntax trail (syntax-rules () ((_ loc expr) expr))))) 16 16 17 17 (define (tprint . x) -
chicken/branches/beyond-hope/utils.scm
r10119 r10439 51 51 (no-bound-checks))] ) 52 52 53 (include "unsafe-declarations.scm") 54 53 55 (cond-expand 54 [unsafe 55 (eval-when (compile) 56 (define-macro (##sys#check-structure . _) '(##core#undefined)) 57 (define-macro (##sys#check-range . _) '(##core#undefined)) 58 (define-macro (##sys#check-pair . _) '(##core#undefined)) 59 (define-macro (##sys#check-list . _) '(##core#undefined)) 60 (define-macro (##sys#check-symbol . _) '(##core#undefined)) 61 (define-macro (##sys#check-string . _) '(##core#undefined)) 62 (define-macro (##sys#check-char . _) '(##core#undefined)) 63 (define-macro (##sys#check-exact . _) '(##core#undefined)) 64 (define-macro (##sys#check-port . _) '(##core#undefined)) 65 (define-macro (##sys#check-number . _) '(##core#undefined)))] 66 [else 67 (declare (emit-exports "utils.exports"))] ) 56 ((not unsafe) 57 (declare (emit-exports "utils.exports"))) 58 (else)) 68 59 69 60 (register-feature! 'utils)
Note: See TracChangeset
for help on using the changeset viewer.