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

Fixes for new parsing of quotes

Browse source
This commit is contained in:
Justin Ethier 2015-05-27 22:48:54 -04:00
parent 8ed03a39d2
commit 9bded8918b
1 changed files with 41 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

73
parser.scm
View file

@ -135,7 +135,6 @@
;; END DEBUG ;; END DEBUG
(cond (cond
((eof-object? c) ((eof-object? c)
(write `(JAE DEBUG parens is ,parens))
(if (> parens 0) (if (> parens 0)
(parse-error "missing closing parenthesis" (parse-error "missing closing parenthesis"
(in-port:get-lnum ptbl) (in-port:get-lnum ptbl)
@ -187,9 +186,9 @@
;; New code - seems to be messing up the paren count?? ;; New code - seems to be messing up the paren count??
; maybe the code that reads closing parens needs to change such that ; maybe the code that reads closing parens needs to change such that
; it keeps the closing paren buffered if we are not in "all?" mode. ; it keeps the closing paren buffered if we are not in "all?" mode.
(write `(reading quoted subexpr)) ; (write `(reading quoted subexpr))
(newline) ; (newline)
(let* ((sub (let ((sub
(parse fp (parse fp
'() '()
'() '()
@ -197,25 +196,23 @@
#f ;comment? #f ;comment?
#f ;quote-level #f ;quote-level
0 ;parens 0 ;parens
ptbl)) ptbl)))
(new-toks (define new-toks
(add-tok (add-tok
(list (list
'quote 'quote
(if (and (pair? sub) (dotted? sub)) sub)
(->dotted-list sub) ;(if (and (pair? sub) (dotted? sub))
sub)) ; (->dotted-list sub)
(get-toks tok toks quotes) ; sub))
quotes))) (get-toks tok toks quotes)
(write `(subexpr ,sub new-toks ,new-toks)) quotes))
(newline)
;; Keep going ;; Keep going
(if all? (if all?
(parse fp '() new-toks all? #f #f parens ptbl) (parse fp '() new-toks all? #f #f parens ptbl)
(car new-toks))) (car new-toks)))
))) )))
((eq? c #\() ((eq? c #\()
;(write `(DEBUG read open paren ,tok))
(cond (cond
((and (not all?) (not (null? tok))) ((and (not all?) (not (null? tok)))
;; Reached a terminal char, read out previous token ;; Reached a terminal char, read out previous token
@ -236,12 +233,17 @@
(parse fp '() new-toks all? #f #f parens ptbl) (parse fp '() new-toks all? #f #f parens ptbl)
(car new-toks)))))) (car new-toks))))))
((eq? c #\)) ((eq? c #\))
;(write `(DEBUG decrementing paren level ,parens)) (cond
(if (= parens 0) ((and (not all?) (not (null? tok)))
(parse-error "unexpected closing parenthesis" ;; Reached a terminal char, read out previous token
(in-port:get-lnum ptbl) (in-port:set-buf! ptbl c)
(in-port:get-cnum ptbl))) (car (add-tok (->tok tok) toks quotes)))
(reverse (get-toks tok toks quotes))) ((= parens 0)
(parse-error "unexpected closing parenthesis"
(in-port:get-lnum ptbl)
(in-port:get-cnum ptbl)))
(else
(reverse (get-toks tok toks quotes)))))
((eq? c #\") ((eq? c #\")
(cond (cond
((and (not all?) (not (null? tok))) ((and (not all?) (not (null? tok)))
@ -263,8 +265,14 @@
(+ 1 (in-port:get-cnum ptbl))) (+ 1 (in-port:get-cnum ptbl)))
(cond (cond
;; Do not use add-tok below, no need to quote a bool ;; Do not use add-tok below, no need to quote a bool
((eq? #\t next-c) (parse fp '() (cons #t toks) all? #f #f parens ptbl)) ((eq? #\t next-c)
((eq? #\f next-c) (parse fp '() (cons #f toks) all? #f #f parens ptbl)) (if all?
(parse fp '() (cons #t toks) all? #f #f parens ptbl)
#t))
((eq? #\f next-c)
(if all?
(parse fp '() (cons #f toks) all? #f #f parens ptbl)
#f))
((eq? #\\ next-c) ((eq? #\\ next-c)
(let ((new-toks (cons (read-pound fp ptbl) toks))) (let ((new-toks (cons (read-pound fp ptbl) toks)))
(if all? (if all?
@ -400,12 +408,13 @@
; ;; Test code ; ;; Test code
; ;(let ((fp (open-input-file "tests/begin.scm"))) ; ;(let ((fp (open-input-file "tests/begin.scm")))
; ;(let ((fp (open-input-file "tests/strings.scm"))) ; ;(let ((fp (open-input-file "tests/strings.scm")))
(let ((fp (open-input-file "test.scm"))) ; (let ((fp (open-input-file "test.scm")))
(write (read-all fp))) ; (let ((fp (open-input-file "tests/unit-tests.scm")))
(define (repl) ; (write (read-all fp)))
(let ((fp (current-input-port))) ;(define (repl)
(write (cyc-read fp))) ; (let ((fp (current-input-port)))
(repl)) ; (write (cyc-read fp)))
;;(repl) ; (repl))
;(repl)