* added (r6rs syntax-case) library.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-09 12:54:57 -04:00
parent 457ed6aa4b
commit e157388176
4 changed files with 36 additions and 20 deletions

Binary file not shown.

View File

@ -840,6 +840,7 @@
645 list
|#
;;; FIXME: should handle (+ x k), (- x k) where k is a fixnum
(module (optimize-primcall)
(define (optimize-primcall ctxt op rand*)
(cond

View File

@ -10,19 +10,15 @@
generate-temporaries free-identifier=? syntax-error
eval-r6rs-top-level boot-library-expand eval-top-level)
(import
(r6rs)
(except (ikarus library-manager) installed-libraries)
(only (ikarus compiler) eval-core)
(chez modules)
(ikarus symbols)
(only (ikarus) error ormap andmap list*
format make-record-type parameterize
void make-parameter)
(rename (r6rs)
(free-identifier=? sys:free-identifier=?)
(identifier? sys:identifier?)
(syntax-error sys:syntax-error)
;(syntax->datum sys:syntax->datum)
(generate-temporaries sys:generate-temporaries)))
(ikarus parameters)
(only (ikarus) error ormap andmap list* format make-record-type void)
(only (r6rs syntax-case) syntax-case syntax with-syntax)
(prefix (r6rs syntax-case) sys:))
(define who 'expander)
(define-syntax no-source
(lambda (x) #f))
@ -1927,7 +1923,24 @@
(let ([lab* (find* sym* subst)])
(values (map cons sym* lab*) lib)))))]
[_ (error 'import "invalid import spec ~s" spec)])]
[(prefix) (error #f "prefix found")]
[(prefix)
(syntax-match spec ()
[(_ isp p)
(let ([s (if (symbol? p)
(symbol->string p)
(error 'import "invalid prefix"))])
(let-values ([(subst lib) (get-import isp)])
(values
(map
(lambda (x)
(cons
(string->symbol
(string-append s
(symbol->string (car x))))
(cdr x)))
subst)
lib)))]
[_ (error 'import "invalid prefix form ~s" spec)])]
[else
(let ([lib (find-library-by-name spec)])
(unless lib

View File

@ -96,7 +96,9 @@
(define library-legend
'([i (ikarus) #t]
[symbols (ikarus symbols) #t]
[parameters (ikarus parameters) #t]
[r (r6rs) #t]
[syncase (r6rs syntax-case) #t]
[cm (chez modules) #t]
[$all (ikarus system $all) #f]
[$pairs (ikarus system $pairs) #f]
@ -123,10 +125,10 @@
[module i cm]
[begin i r]
[set! i r]
[foreign-call i r]
[foreign-call i]
[quote i r]
[syntax-case i r]
[syntax i r]
[syntax-case i syncase]
[syntax i syncase]
[lambda i r]
[case-lambda i r]
[type-descriptor i ]
@ -135,14 +137,14 @@
[if i r]
[when i r]
[unless i r]
[parameterize i ]
[parameterize i parameters]
[case i r]
[let-values i r]
[define-record i r]
[include i r]
[syntax-rules i r]
[quasiquote i r]
[with-syntax i r]
[with-syntax i syncase]
[let i r]
[let* i r]
[cond i r]
@ -360,7 +362,7 @@
[hash-table? i]
[get-hash-table i]
[put-hash-table! i]
[make-parameter i]
[make-parameter i parameters]
[apply i r]
[values i r]
[call-with-values i r]
@ -392,10 +394,10 @@
[record-ref i]
[record-field-accessor i]
[record-field-mutator i]
[identifier? i r]
[syntax-error i r]
[generate-temporaries i r]
[free-identifier=? i r]
[identifier? i syncase]
[syntax-error i syncase]
[generate-temporaries i syncase]
[free-identifier=? i syncase]
[code? i]
[immediate? i]
[pointer-value i]