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

* ikarus.cxr now exports the cxr prims.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 02:28:30 -04:00
parent 0471c6b3fe
commit 4c66daca01
3 changed files with 38 additions and 67 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.

103
src/libcxr.ss → src/ikarus.cxr.ss
View File

@ -1,54 +1,48 @@
;(primitive-set! 'car (lambda (x) (car x)))
;(primitive-set! 'cdr (lambda (x) (cdr x)))
;(primitive-set! 'cadr (lambda (x) (cadr x)))
(library (ikarus cxr) (library (ikarus cxr)
(export) (export
(import (scheme)) car cdr caar cdar cadr cddr caaar cdaar cadar cddar caadr cdadr
caddr cdddr caaaar cdaaar cadaar cddaar caadar cdadar caddar
cdddar caaadr cdaadr cadadr cddadr caaddr cdaddr cadddr cddddr)
(import
(only (ikarus) define if lambda pair? error quote let)
(only (scheme) $car $cdr))
(define err (define err
(lambda (who x) (lambda (who x)
(error who "invalid list structure ~s" x))) (error who "invalid list structure ~s" x)))
(define car
(primitive-set!
'car
(lambda (orig) (lambda (orig)
(if (pair? orig) ($car orig) (err 'car orig)))) (if (pair? orig) ($car orig) (err 'car orig))))
(primitive-set! (define cdr
'cdr
(lambda (orig) (lambda (orig)
(if (pair? orig) ($cdr orig) (err 'cdr orig)))) (if (pair? orig) ($cdr orig) (err 'cdr orig))))
(primitive-set! (define caar
'caar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
(if (pair? x) ($car x) (err 'caar orig))) (if (pair? x) ($car x) (err 'caar orig)))
(err 'caar orig)))) (err 'caar orig))))
(primitive-set! (define cadr
'cadr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
(if (pair? x) ($car x) (err 'cadr orig))) (if (pair? x) ($car x) (err 'cadr orig)))
(err 'cadr orig)))) (err 'cadr orig))))
(primitive-set! (define cdar
'cdar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
(if (pair? x) ($cdr x) (err 'cdar orig))) (if (pair? x) ($cdr x) (err 'cdar orig)))
(err 'cdar orig)))) (err 'cdar orig))))
(primitive-set! (define cddr
'cddr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
(if (pair? x) ($cdr x) (err 'cddr orig))) (if (pair? x) ($cdr x) (err 'cddr orig)))
(err 'cddr orig)))) (err 'cddr orig))))
(primitive-set! (define caaar
'caaar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -57,8 +51,7 @@
(if (pair? x) ($car x) (err 'caaar orig))) (if (pair? x) ($car x) (err 'caaar orig)))
(err 'caaar orig))) (err 'caaar orig)))
(err 'caaar orig)))) (err 'caaar orig))))
(primitive-set! (define caadr
'caadr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -67,8 +60,7 @@
(if (pair? x) ($car x) (err 'caadr orig))) (if (pair? x) ($car x) (err 'caadr orig)))
(err 'caadr orig))) (err 'caadr orig)))
(err 'caadr orig)))) (err 'caadr orig))))
(primitive-set! (define cadar
'cadar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -77,8 +69,7 @@
(if (pair? x) ($car x) (err 'cadar orig))) (if (pair? x) ($car x) (err 'cadar orig)))
(err 'cadar orig))) (err 'cadar orig)))
(err 'cadar orig)))) (err 'cadar orig))))
(primitive-set! (define caddr
'caddr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -87,8 +78,7 @@
(if (pair? x) ($car x) (err 'caddr orig))) (if (pair? x) ($car x) (err 'caddr orig)))
(err 'caddr orig))) (err 'caddr orig)))
(err 'caddr orig)))) (err 'caddr orig))))
(primitive-set! (define cdaar
'cdaar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -97,8 +87,7 @@
(if (pair? x) ($cdr x) (err 'cdaar orig))) (if (pair? x) ($cdr x) (err 'cdaar orig)))
(err 'cdaar orig))) (err 'cdaar orig)))
(err 'cdaar orig)))) (err 'cdaar orig))))
(primitive-set! (define cdadr
'cdadr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -107,8 +96,7 @@
(if (pair? x) ($cdr x) (err 'cdadr orig))) (if (pair? x) ($cdr x) (err 'cdadr orig)))
(err 'cdadr orig))) (err 'cdadr orig)))
(err 'cdadr orig)))) (err 'cdadr orig))))
(primitive-set! (define cddar
'cddar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -117,8 +105,7 @@
(if (pair? x) ($cdr x) (err 'cddar orig))) (if (pair? x) ($cdr x) (err 'cddar orig)))
(err 'cddar orig))) (err 'cddar orig)))
(err 'cddar orig)))) (err 'cddar orig))))
(primitive-set! (define cdddr
'cdddr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -127,8 +114,7 @@
(if (pair? x) ($cdr x) (err 'cdddr orig))) (if (pair? x) ($cdr x) (err 'cdddr orig)))
(err 'cdddr orig))) (err 'cdddr orig)))
(err 'cdddr orig)))) (err 'cdddr orig))))
(primitive-set! (define caaaar
'caaaar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -140,8 +126,7 @@
(err 'caaaar orig))) (err 'caaaar orig)))
(err 'caaaar orig))) (err 'caaaar orig)))
(err 'caaaar orig)))) (err 'caaaar orig))))
(primitive-set! (define caaadr
'caaadr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -153,8 +138,7 @@
(err 'caaadr orig))) (err 'caaadr orig)))
(err 'caaadr orig))) (err 'caaadr orig)))
(err 'caaadr orig)))) (err 'caaadr orig))))
(primitive-set! (define caadar
'caadar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -166,8 +150,7 @@
(err 'caadar orig))) (err 'caadar orig)))
(err 'caadar orig))) (err 'caadar orig)))
(err 'caadar orig)))) (err 'caadar orig))))
(primitive-set! (define caaddr
'caaddr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -179,8 +162,7 @@
(err 'caaddr orig))) (err 'caaddr orig)))
(err 'caaddr orig))) (err 'caaddr orig)))
(err 'caaddr orig)))) (err 'caaddr orig))))
(primitive-set! (define cadaar
'cadaar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -192,8 +174,7 @@
(err 'cadaar orig))) (err 'cadaar orig)))
(err 'cadaar orig))) (err 'cadaar orig)))
(err 'cadaar orig)))) (err 'cadaar orig))))
(primitive-set! (define cadadr
'cadadr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -205,8 +186,7 @@
(err 'cadadr orig))) (err 'cadadr orig)))
(err 'cadadr orig))) (err 'cadadr orig)))
(err 'cadadr orig)))) (err 'cadadr orig))))
(primitive-set! (define caddar
'caddar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -218,8 +198,7 @@
(err 'caddar orig))) (err 'caddar orig)))
(err 'caddar orig))) (err 'caddar orig)))
(err 'caddar orig)))) (err 'caddar orig))))
(primitive-set! (define cadddr
'cadddr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -231,8 +210,7 @@
(err 'cadddr orig))) (err 'cadddr orig)))
(err 'cadddr orig))) (err 'cadddr orig)))
(err 'cadddr orig)))) (err 'cadddr orig))))
(primitive-set! (define cdaaar
'cdaaar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -244,8 +222,7 @@
(err 'cdaaar orig))) (err 'cdaaar orig)))
(err 'cdaaar orig))) (err 'cdaaar orig)))
(err 'cdaaar orig)))) (err 'cdaaar orig))))
(primitive-set! (define cdaadr
'cdaadr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -257,8 +234,7 @@
(err 'cdaadr orig))) (err 'cdaadr orig)))
(err 'cdaadr orig))) (err 'cdaadr orig)))
(err 'cdaadr orig)))) (err 'cdaadr orig))))
(primitive-set! (define cdadar
'cdadar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -270,8 +246,7 @@
(err 'cdadar orig))) (err 'cdadar orig)))
(err 'cdadar orig))) (err 'cdadar orig)))
(err 'cdadar orig)))) (err 'cdadar orig))))
(primitive-set! (define cdaddr
'cdaddr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -283,8 +258,7 @@
(err 'cdaddr orig))) (err 'cdaddr orig)))
(err 'cdaddr orig))) (err 'cdaddr orig)))
(err 'cdaddr orig)))) (err 'cdaddr orig))))
(primitive-set! (define cddaar
'cddaar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -296,8 +270,7 @@
(err 'cddaar orig))) (err 'cddaar orig)))
(err 'cddaar orig))) (err 'cddaar orig)))
(err 'cddaar orig)))) (err 'cddaar orig))))
(primitive-set! (define cddadr
'cddadr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])
@ -309,8 +282,7 @@
(err 'cddadr orig))) (err 'cddadr orig)))
(err 'cddadr orig))) (err 'cddadr orig)))
(err 'cddadr orig)))) (err 'cddadr orig))))
(primitive-set! (define cdddar
'cdddar
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($car orig)]) (let ([x ($car orig)])
@ -322,8 +294,7 @@
(err 'cdddar orig))) (err 'cdddar orig)))
(err 'cdddar orig))) (err 'cdddar orig)))
(err 'cdddar orig)))) (err 'cdddar orig))))
(primitive-set! (define cddddr
'cddddr
(lambda (orig) (lambda (orig)
(if (pair? orig) (if (pair? orig)
(let ([x ($cdr orig)]) (let ([x ($cdr orig)])

2
src/makefile.ss
View File

@ -25,7 +25,7 @@
"ikarus.control.ss" "ikarus.control.ss"
"ikarus.collect.ss" "ikarus.collect.ss"
"ikarus.records.ss" "ikarus.records.ss"
"libcxr.ss" "ikarus.cxr.ss"
"libnumerics.ss" "libnumerics.ss"
"libguardians.ss" "libguardians.ss"
"libcore.ss" "libcore.ss"