Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Slight speedup

Browse source
This commit is contained in:
Justin Ethier 2017-08-16 11:24:04 +00:00
parent 4b7386dedf
commit d72feb5d34
1 changed files with 14 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
read.scm
View file

@ -698,10 +698,17 @@
" Cyc_io_read_token(data, k, port);")
(define-c Cyc-opaque-eq?
"(void *data, int argc, closure _, object k, object opq, object obj)"
" if (Cyc_is_opaque(opq) == boolean_f)
return_closcall1(data, k, boolean_f);
return_closcall1(data, k, equalp( opaque_ptr(opq), obj ));")
(define-c Cyc-opaque-unsafe-eq?
"(void *data, int argc, closure _, object k, object opq, object obj)"
" return_closcall1(data, k, equalp( opaque_ptr(opq), obj ));")
(write
;(call-parse2 (open-input-file "scheme/cyclone/cgen.sld")))
(call-parse2 (open-input-file "test.scm")))
;(read-token (open-input-file "test.scm")))
@ -748,21 +755,21 @@
((Cyc-opaque? token)
(cond
;; Open paren, start read loop
((Cyc-opaque-eq? token #\()
((Cyc-opaque-unsafe-eq? token #\()
(let loop ((lis '())
(t (parse2 fp)))
(cond
((eof-object? t)
(error "missing closing parenthesis"))
((and (Cyc-opaque? t) (Cyc-opaque-eq? t #\)))
((Cyc-opaque-eq? t #\))
(reverse lis))
(else
(loop (cons t lis) (parse2 fp))))))
((Cyc-opaque-eq? token #\')
((Cyc-opaque-unsafe-eq? token #\')
(list 'quote (parse2 fp)))
((Cyc-opaque-eq? token #\`)
((Cyc-opaque-unsafe-eq? token #\`)
(list 'quasiquote (parse2 fp)))
((Cyc-opaque-eq? token #\,)
((Cyc-opaque-unsafe-eq? token #\,)
(list 'unquote (parse2 fp)))
(else
token))) ;; TODO: error if this is returned to original caller of parse2
@ -782,7 +789,7 @@
(cond
((eof-object? t)
(error "missing closing parenthesis"))
((and (Cyc-opaque? t) (Cyc-opaque-eq? t #\)))
((Cyc-opaque-eq? t #\))
(list->vector (reverse lis)))
(else
(loop (cons t lis) (parse2 fp))))))))
@ -792,7 +799,7 @@
(cond
((eof-object? t)
(error "missing closing parenthesis"))
((and (Cyc-opaque? t) (Cyc-opaque-eq? t #\)))
((Cyc-opaque-eq? t #\))
(apply bytevector (reverse lis)))
(else
(loop (cons t lis) (parse2 fp))))))