Working on changing how quotes are parsed

This commit is contained in:
Justin Ethier 2015-05-27 21:47:06 -04:00
parent 8a5185fdbd
commit 8ed03a39d2
2 changed files with 53 additions and 16 deletions

View file

@ -135,6 +135,7 @@
;; 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)
@ -172,15 +173,47 @@
(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
(let ((quote-level (if quotes ;; OLD CODE:
(+ quotes 1) ;; (let ((quote-level (if quotes
1))) ;; (+ quotes 1)
(cond ;; 1)))
((null? tok) ;; (cond
(parse fp '() toks all? comment? quote-level parens ptbl)) ;; ((null? tok)
(else ;; (parse fp '() toks all? comment? quote-level parens ptbl))
(parse fp '() (add-tok (->tok tok) toks quotes) ;; (else
all? comment? quote-level parens ptbl))))))) ;; (parse fp '() (add-tok (->tok tok) toks quotes)
;; all? comment? quote-level parens ptbl)))))))
;; New code - seems to be messing up the paren count??
; 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.
(write `(reading quoted subexpr))
(newline)
(let* ((sub
(parse fp
'()
'()
#f ;all?
#f ;comment?
#f ;quote-level
0 ;parens
ptbl))
(new-toks
(add-tok
(list
'quote
(if (and (pair? sub) (dotted? sub))
(->dotted-list sub)
sub))
(get-toks tok toks quotes)
quotes)))
(write `(subexpr ,sub new-toks ,new-toks))
(newline)
;; Keep going
(if all?
(parse fp '() new-toks all? #f #f parens ptbl)
(car new-toks)))
)))
((eq? c #\() ((eq? c #\()
;(write `(DEBUG read open paren ,tok)) ;(write `(DEBUG read open paren ,tok))
(cond (cond
@ -364,16 +397,15 @@
;; read -> port -> object ;; read -> port -> object
;(define read cyc-read) ;(define read cyc-read)
;(define (repl)
; ;; 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 "eval.scm"))) (let ((fp (open-input-file "test.scm")))
; ;(let ((fp (open-input-file "dev.scm"))) (write (read-all fp)))
; ; (write (read-all fp))) (define (repl)
; (let ((fp (current-input-port))) (let ((fp (current-input-port)))
; (write (cyc-read fp))) (write (cyc-read fp)))
; (repl)) (repl))
;;(repl) ;;(repl)

View file

@ -1,3 +1,8 @@
(import (scheme base) (import (scheme base)
(scheme read)) (scheme read))
'aa
(define (quoted? exp)
(tagged-list? exp 'quote))
(write (read)) (write (read))