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

* libtokenizer now librarified

This commit is contained in:
Abdulaziz Ghuloum 2007-04-29 22:29:42 -04:00
parent 726d53ac1b
commit 5d7afb92d4
3 changed files with 34 additions and 9 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.

19
src/libtokenizer.ss
View File

@ -1,8 +1,8 @@
;;; 9.1: bignum reader (library (ikarus tokenizer)
;;; 9.0: graph marks/refs (export)
;;; (import (scheme))
(let ()
(define delimiter? (define delimiter?
(lambda (c) (lambda (c)
(or (char-whitespace? c) (or (char-whitespace? c)
@ -459,7 +459,8 @@
(error 'tokenize (error 'tokenize
"invalid char ~a inside gensym" c)])))]))] "invalid char ~a inside gensym" c)])))]))]
[($char= #\@ c) [($char= #\@ c)
(cons 'datum ($fasl-read p))] (error 'read "FIXME: fasl read disabled")
'(cons 'datum ($fasl-read p))]
[else [else
(unread-char c p) (unread-char c p)
(error 'tokenize "invalid syntax #~a" c)]))) (error 'tokenize "invalid syntax #~a" c)])))
@ -738,7 +739,7 @@
h1))) h1)))
h)))))) h))))))
(define read (define my-read
(lambda (p) (lambda (p)
(let-values ([(expr locs k) (read-expr p '() void)]) (let-values ([(expr locs k) (read-expr p '() void)])
(cond (cond
@ -775,10 +776,10 @@
(error 'read-token "~s is not an input port" p))])) (error 'read-token "~s is not an input port" p))]))
(primitive-set! 'read (primitive-set! 'read
(case-lambda (case-lambda
[() (read (current-input-port))] [() (my-read (current-input-port))]
[(p) [(p)
(if (input-port? p) (if (input-port? p)
(read p) (my-read p)
(error 'read "~s is not an input port" p))])) (error 'read "~s is not an input port" p))]))
(primitive-set! 'comment-handler (primitive-set! 'comment-handler
(make-parameter (make-parameter
@ -790,7 +791,7 @@
(let () (let ()
(define read-and-eval (define read-and-eval
(lambda (p eval) (lambda (p eval)
(let ([x (read p)]) (let ([x (my-read p)])
(unless (eof-object? x) (unless (eof-object? x)
(eval x) (eval x)
(read-and-eval p eval))))) (read-and-eval p eval)))))

24
src/syntax.ss
View File

@ -533,6 +533,7 @@
[null? null?-label (core-prim . null?)] [null? null?-label (core-prim . null?)]
[procedure? procedure?-label (core-prim . procedure?)] [procedure? procedure?-label (core-prim . procedure?)]
[eof-object? eof-object?-label (core-prim . eof-object?)] [eof-object? eof-object?-label (core-prim . eof-object?)]
[eof-object eof-object-label (core-prim . eof-object)]
;;; comparison ;;; comparison
[eq? eq?-label (core-prim . eq?)] [eq? eq?-label (core-prim . eq?)]
[eqv? eqv?-label (core-prim . eqv?)] [eqv? eqv?-label (core-prim . eqv?)]
@ -549,8 +550,11 @@
[cadr cadr-label (core-prim . cadr)] [cadr cadr-label (core-prim . cadr)]
[cddr cddr-label (core-prim . cddr)] [cddr cddr-label (core-prim . cddr)]
[list list-label (core-prim . list)] [list list-label (core-prim . list)]
[make-list make-list-label (core-prim . make-list)]
[list* list*-label (core-prim . list*)]
[list? list?-label (core-prim . list?)] [list? list?-label (core-prim . list?)]
[append append-label (core-prim . append)] [append append-label (core-prim . append)]
[reverse reverse-label (core-prim . reverse)]
[length length-label (core-prim . length)] [length length-label (core-prim . length)]
[assq assq-label (core-prim . assq)] [assq assq-label (core-prim . assq)]
[assv assv-label (core-prim . assv)] [assv assv-label (core-prim . assv)]
@ -563,15 +567,23 @@
[char=? char=?-label (core-prim . char=?)] [char=? char=?-label (core-prim . char=?)]
[integer->char integer->char-label (core-prim . integer->char)] [integer->char integer->char-label (core-prim . integer->char)]
[char->integer char->integer-label (core-prim . char->integer)] [char->integer char->integer-label (core-prim . char->integer)]
[char-whitespace? char-whitespace?-label (core-prim . char-whitespace?)]
[$char? $char?-label (core-prim . $char?)]
[$char<= $char<=-label (core-prim . $char<=)]
[$char= $char=-label (core-prim . $char=)]
[$char->fixnum $char->fixnum-label (core-prim . $char->fixnum)]
;;; strings ;;; strings
[string? string?-label (core-prim . string?)] [string? string?-label (core-prim . string?)]
[make-string make-string-label (core-prim . make-string)]
[string-ref string-ref-label (core-prim . string-ref)] [string-ref string-ref-label (core-prim . string-ref)]
[string-set! string-set!-label (core-prim . string-set!)] [string-set! string-set!-label (core-prim . string-set!)]
[string-length string-length-label (core-prim . string-length)] [string-length string-length-label (core-prim . string-length)]
[string=? string=?-label (core-prim . string=?)] [string=? string=?-label (core-prim . string=?)]
[substring substring-label (core-prim . substring)] [substring substring-label (core-prim . substring)]
[list->string list->string-label (core-prim . list->string)]
;;; vectors ;;; vectors
[vector vector-label (core-prim . vector)] [vector vector-label (core-prim . vector)]
[make-vector make-vector-label (core-prim . make-vector)]
[vector-ref vector-ref-label (core-prim . vector-ref)] [vector-ref vector-ref-label (core-prim . vector-ref)]
[vector-set! vector-set!-label (core-prim . vector-set!)] [vector-set! vector-set!-label (core-prim . vector-set!)]
[vector? vector?-label (core-prim . vector?)] [vector? vector?-label (core-prim . vector?)]
@ -592,6 +604,7 @@
[fx= fx=-label (core-prim . fx=)] [fx= fx=-label (core-prim . fx=)]
[fx- fx--label (core-prim . fx-)] [fx- fx--label (core-prim . fx-)]
[fx+ fx+-label (core-prim . fx+)] [fx+ fx+-label (core-prim . fx+)]
[fx* fx*-label (core-prim . fx*)]
[fxzero? fxzero?-label (core-prim . fxzero?)] [fxzero? fxzero?-label (core-prim . fxzero?)]
[fxadd1 fxadd1-label (core-prim . fxadd1)] [fxadd1 fxadd1-label (core-prim . fxadd1)]
[fxsub1 fxsub1-label (core-prim . fxsub1)] [fxsub1 fxsub1-label (core-prim . fxsub1)]
@ -604,6 +617,8 @@
[fxlognot fxlognot-label (core-prim . fxlognot)] [fxlognot fxlognot-label (core-prim . fxlognot)]
[$fx>= $fx>=-label (core-prim . $fx>=)] [$fx>= $fx>=-label (core-prim . $fx>=)]
[$fx< $fx<-label (core-prim . $fx<)] [$fx< $fx<-label (core-prim . $fx<)]
;;; flonum
[string->flonum string->flonum-label (core-prim . string->flonum)]
;;; generic arithmetic ;;; generic arithmetic
[- minus-label (core-prim . -)] [- minus-label (core-prim . -)]
[* *-label (core-prim . *)] [* *-label (core-prim . *)]
@ -615,6 +630,7 @@
[gensym gensym-label (core-prim . gensym)] [gensym gensym-label (core-prim . gensym)]
[getprop getprop-label (core-prim . getprop)] [getprop getprop-label (core-prim . getprop)]
[putprop putprop-label (core-prim . putprop)] [putprop putprop-label (core-prim . putprop)]
[string->symbol string->symbol-label (core-prim . string->symbol)]
[symbol->string symbol->string-label (core-prim . symbol->string)] [symbol->string symbol->string-label (core-prim . symbol->string)]
[gensym->unique-string gensym->unique-string-label (core-prim . gensym->unique-string)] [gensym->unique-string gensym->unique-string-label (core-prim . gensym->unique-string)]
[$set-symbol-value! $set-symbol-value!-label (core-prim . $set-symbol-value!)] [$set-symbol-value! $set-symbol-value!-label (core-prim . $set-symbol-value!)]
@ -624,6 +640,9 @@
[set-top-level-value! set-top-level-value!-label (core-prim . set-top-level-value!)] [set-top-level-value! set-top-level-value!-label (core-prim . set-top-level-value!)]
;;; IO/ports ;;; IO/ports
[output-port? output-port?-label (core-prim . output-port?)] [output-port? output-port?-label (core-prim . output-port?)]
[input-port? input-port?-label (core-prim . input-port?)]
[open-input-file open-input-file-label (core-prim . open-input-file)]
[close-input-port close-input-port-label (core-prim . close-input-port)]
[console-input-port console-input-port-label (core-prim . console-input-port)] [console-input-port console-input-port-label (core-prim . console-input-port)]
[console-output-port console-output-port-label (core-prim . console-output-port)] [console-output-port console-output-port-label (core-prim . console-output-port)]
[current-input-port current-input-port-label (core-prim . current-input-port)] [current-input-port current-input-port-label (core-prim . current-input-port)]
@ -636,15 +655,20 @@
[write-char write-char-label (core-prim . write-char)] [write-char write-char-label (core-prim . write-char)]
[read read-label (core-prim . read)] [read read-label (core-prim . read)]
[read-char read-char-label (core-prim . read-char)] [read-char read-char-label (core-prim . read-char)]
[read-token read-token-label (core-prim . read-token)]
[peek-char peek-char-label (core-prim . peek-char)]
[unread-char unread-char-label (core-prim . unread-char)]
[newline newline-label (core-prim . newline)] [newline newline-label (core-prim . newline)]
[printf printf-label (core-prim . printf)] [printf printf-label (core-prim . printf)]
[format format-label (core-prim . format)] [format format-label (core-prim . format)]
[pretty-print pretty-print-label (core-prim . pretty-print)] [pretty-print pretty-print-label (core-prim . pretty-print)]
[comment-handler comment-handler-label (core-prim . comment-handler)]
;;; hash tables ;;; hash tables
[make-hash-table make-hash-table-label (core-prim . make-hash-table)] [make-hash-table make-hash-table-label (core-prim . make-hash-table)]
[get-hash-table get-hash-table-label (core-prim . get-hash-table)] [get-hash-table get-hash-table-label (core-prim . get-hash-table)]
[put-hash-table! put-hash-table!-label (core-prim . put-hash-table!)] [put-hash-table! put-hash-table!-label (core-prim . put-hash-table!)]
;;; evaluation / control ;;; evaluation / control
[make-parameter make-parameter-label (core-prim . make-parameter)]
[apply apply-label (core-prim . apply)] [apply apply-label (core-prim . apply)]
[values values-label (core-prim . values)] [values values-label (core-prim . values)]
[call-with-values cwv-label (core-prim . call-with-values)] [call-with-values cwv-label (core-prim . call-with-values)]