Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 12:35: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);") " Cyc_io_read_token(data, k, port);")
(define-c Cyc-opaque-eq? (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)" "(void *data, int argc, closure _, object k, object opq, object obj)"
" return_closcall1(data, k, equalp( opaque_ptr(opq), obj ));") " return_closcall1(data, k, equalp( opaque_ptr(opq), obj ));")
(write (write
;(call-parse2 (open-input-file "scheme/cyclone/cgen.sld")))
(call-parse2 (open-input-file "test.scm"))) (call-parse2 (open-input-file "test.scm")))
;(read-token (open-input-file "test.scm"))) ;(read-token (open-input-file "test.scm")))
@ -748,21 +755,21 @@
((Cyc-opaque? token) ((Cyc-opaque? token)
(cond (cond
;; Open paren, start read loop ;; Open paren, start read loop
((Cyc-opaque-eq? token #\() ((Cyc-opaque-unsafe-eq? token #\()
(let loop ((lis '()) (let loop ((lis '())
(t (parse2 fp))) (t (parse2 fp)))
(cond (cond
((eof-object? t) ((eof-object? t)
(error "missing closing parenthesis")) (error "missing closing parenthesis"))
((and (Cyc-opaque? t) (Cyc-opaque-eq? t #\))) ((Cyc-opaque-eq? t #\))
(reverse lis)) (reverse lis))
(else (else
(loop (cons t lis) (parse2 fp)))))) (loop (cons t lis) (parse2 fp))))))
((Cyc-opaque-eq? token #\') ((Cyc-opaque-unsafe-eq? token #\')
(list 'quote (parse2 fp))) (list 'quote (parse2 fp)))
((Cyc-opaque-eq? token #\`) ((Cyc-opaque-unsafe-eq? token #\`)
(list 'quasiquote (parse2 fp))) (list 'quasiquote (parse2 fp)))
((Cyc-opaque-eq? token #\,) ((Cyc-opaque-unsafe-eq? token #\,)
(list 'unquote (parse2 fp))) (list 'unquote (parse2 fp)))
(else (else
token))) ;; TODO: error if this is returned to original caller of parse2 token))) ;; TODO: error if this is returned to original caller of parse2
@ -782,7 +789,7 @@
(cond (cond
((eof-object? t) ((eof-object? t)
(error "missing closing parenthesis")) (error "missing closing parenthesis"))
((and (Cyc-opaque? t) (Cyc-opaque-eq? t #\))) ((Cyc-opaque-eq? t #\))
(list->vector (reverse lis))) (list->vector (reverse lis)))
(else (else
(loop (cons t lis) (parse2 fp)))))))) (loop (cons t lis) (parse2 fp))))))))
@ -792,7 +799,7 @@
(cond (cond
((eof-object? t) ((eof-object? t)
(error "missing closing parenthesis")) (error "missing closing parenthesis"))
((and (Cyc-opaque? t) (Cyc-opaque-eq? t #\))) ((Cyc-opaque-eq? t #\))
(apply bytevector (reverse lis))) (apply bytevector (reverse lis)))
(else (else
(loop (cons t lis) (parse2 fp)))))) (loop (cons t lis) (parse2 fp))))))