diff --git a/src/ikarus.boot b/src/ikarus.boot index ad1c421..557efa5 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/libcogen1.ss b/src/libcogen1.ss index aedb26c..f131232 100644 --- a/src/libcogen1.ss +++ b/src/libcogen1.ss @@ -1,4 +1,4 @@ - +#!eof ;;; input to cogen is : ;;; ::= (constant x) ;;; | (var) diff --git a/src/libcompile.ss b/src/libcompile.ss index c209ab5..2593b62 100644 --- a/src/libcompile.ss +++ b/src/libcompile.ss @@ -5101,7 +5101,7 @@ [p (convert-closures p)] [p (optimize-closures/lift-codes p)] - [p^ (new-cogen p)] + ;[p^ (new-cogen p)] [p (introduce-primcalls p)] [p (simplify-operands p)] [p (insert-stack-overflow-checks p)] diff --git a/src/libtokenizer.ss b/src/libtokenizer.ss index 7fa00ca..e1931b8 100644 --- a/src/libtokenizer.ss +++ b/src/libtokenizer.ss @@ -190,6 +190,11 @@ [($char= c #\.) (read-char p) (cons 'datum (tokenize-flonum/no-digits #f p))] + [($char= c #\>) + (read-char p) + (let ([ls (tokenize-identifier '() p)]) + (let ([str (list->string (list* #\- #\> (reverse ls)))]) + (cons 'datum (string->symbol str))))] [else (error 'tokenize "invalid sequence -~a" c)])))) (define tokenize-dot (lambda (p) diff --git a/src/libwriter.ss b/src/libwriter.ss index 3a1a59b..10a0e5c 100644 --- a/src/libwriter.ss +++ b/src/libwriter.ss @@ -105,13 +105,26 @@ (subsequent*? str ($fxadd1 i) n))))) (define valid-symbol-string? (lambda (str) - (or (let ([n ($string-length str)]) + (define normal-symbol-string? + (lambda (str) + (let ([n ($string-length str)]) (and ($fx>= n 1) (initial? ($string-ref str 0)) - (subsequent*? str 1 n))) - (string=? str "+") - (string=? str "-") - (string=? str "...")))) + (subsequent*? str 1 n))))) + (define peculiar-symbol-string? + (lambda (str) + (let ([n (string-length str)]) + (cond + [(fx= n 1) + (memq (string-ref str 0) '(#\+ #\-))] + [(fx>= n 2) + (or (and (char=? (string-ref str 0) #\-) + (char=? (string-ref str 1) #\>) + (subsequent*? str 2 n)) + (string=? str "..."))])))) + (or (normal-symbol-string? str) + (peculiar-symbol-string? str)))) + (define write-symbol-esc-loop (lambda (x i n p) (unless ($fx= i n)