conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

1
src/ikarus.compiler.ss
View File

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

33
src/ikarus.syntax.ss
View File

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

22
src/makefile.ss
View File

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