mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-11 14:57:36 +02:00
Fixes for unquote-splicing
This commit is contained in:
parent
49d6bc3213
commit
8ddce6b5bc
2 changed files with 25 additions and 24 deletions
31
parser.scm
31
parser.scm
|
@ -223,34 +223,35 @@
|
||||||
(in-port:set-buf! ptbl c)
|
(in-port:set-buf! ptbl c)
|
||||||
(car (add-tok (->tok tok) toks quotes)))
|
(car (add-tok (->tok tok) toks quotes)))
|
||||||
(else
|
(else
|
||||||
|
|
||||||
;; TODO: this is not good enough for unquote-splicing as
|
|
||||||
;; that construct requires reading two chars ,@
|
|
||||||
;; need a way of peeking at the next char here, either
|
|
||||||
;; via peek-char, or perhaps better by having a larger buffer
|
|
||||||
;; of input chars.
|
|
||||||
;; TODO:
|
;; TODO:
|
||||||
; buffer must be empty now since it is only 1 char, so
|
; buffer must be empty now since it is only 1 char, so
|
||||||
; call read-char. then:
|
; call read-char. then:
|
||||||
; - @ - unquote-splicing processing
|
; - @ - unquote-splicing processing
|
||||||
; - eof - error
|
; - eof - error
|
||||||
; - otherwise, add char back to buffer and do unquote processing
|
; - otherwise, add char back to buffer and do unquote processing
|
||||||
;
|
|
||||||
; can test this below for unquote by doing the read-char and adding
|
|
||||||
; back to the buffer
|
|
||||||
|
|
||||||
;; Read the next expression and wrap it in a quote
|
;; Read the next expression and wrap it in a quote
|
||||||
(letrec ((sub (parse fp '() '() #f #f #f 0 ptbl))
|
(letrec ((sub #f)
|
||||||
(next-c (read-char fp))
|
(next-c (read-char fp))
|
||||||
(unquote-sym (if (equal? next-c #\@) 'unquote-splicing 'unquote))
|
(unquote-sym (if (equal? next-c #\@) 'unquote-splicing 'unquote))
|
||||||
(new-toks
|
(new-toks #f))
|
||||||
|
|
||||||
|
;; Buffer read-ahead char, if unused
|
||||||
|
(cond
|
||||||
|
((eof-object? next-c)
|
||||||
|
(parse-error "unexpected end of file"
|
||||||
|
(in-port:get-lnum ptbl)
|
||||||
|
(in-port:get-cnum ptbl)))
|
||||||
|
((not (equal? next-c #\@))
|
||||||
|
(in-port:set-buf! ptbl next-c))
|
||||||
|
(else #f))
|
||||||
|
|
||||||
|
(set! sub (parse fp '() '() #f #f #f 0 ptbl))
|
||||||
|
(set! new-toks
|
||||||
(add-tok
|
(add-tok
|
||||||
(list unquote-sym sub)
|
(list unquote-sym sub)
|
||||||
(get-toks tok toks quotes)
|
(get-toks tok toks quotes)
|
||||||
quotes)))
|
quotes))
|
||||||
;; Buffer read-ahead char, if unused
|
|
||||||
(if (not (equal? next-c #\@))
|
|
||||||
(in-port:set-buf! ptbl next-c))
|
|
||||||
|
|
||||||
;; Keep going
|
;; Keep going
|
||||||
(if all?
|
(if all?
|
||||||
|
|
4
test.scm
4
test.scm
|
@ -3,5 +3,5 @@
|
||||||
|
|
||||||
(write `(read ,(+ 1 2 3)))
|
(write `(read ,(+ 1 2 3)))
|
||||||
(write `(read ,(list 1 2 3)))
|
(write `(read ,(list 1 2 3)))
|
||||||
;(write `(read ,@(list 1 2 3)))
|
(write `(read ,@(list 1 2 3)))
|
||||||
|
;`(read ,
|
||||||
|
|
Loading…
Add table
Reference in a new issue