suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[honu] add [] as a list form

Browse Source
This commit is contained in:
Jon Rafkind 2011-08-09 16:04:39 -06:00
parent ab0a21db99
commit 0871117538
4 changed files with 72 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/honu/core/main.rkt
View File

@ -22,6 +22,7 @@
[literal:honu-= =] [literal:honu-= =]
[literal:semicolon |;|] [literal:semicolon |;|]
[literal:honu-comma |,|] [literal:honu-comma |,|]
[literal:#%brackets #%brackets]
[literal:#%braces #%braces] [literal:#%braces #%braces]
[literal:#%parens #%parens]) [literal:#%parens #%parens])
) )

7
collects/honu/core/private/debug.rkt
View File

@ -4,12 +4,17 @@
(provide debug) (provide debug)
(define-for-syntax (filename path)
(define-values (base name dir?)
(split-path (build-path path)))
name)
(define-for-syntax verbose? (getenv "HONU_DEBUG")) (define-for-syntax verbose? (getenv "HONU_DEBUG"))
(define-syntax (debug stx) (define-syntax (debug stx)
(if verbose? (if verbose?
(syntax-case stx () (syntax-case stx ()
[(_ str x ...) [(_ str x ...)
(with-syntax ([file (syntax-source #'str)] (with-syntax ([file (filename (syntax-source #'str))]
[line (syntax-line #'str)] [line (syntax-line #'str)]
[column (syntax-column #'str)]) [column (syntax-column #'str)])
#'(printf (string-append "~a at ~a:~a " str) file line column x ...))]) #'(printf (string-append "~a at ~a:~a " str) file line column x ...))])

11
collects/honu/core/private/parse2.rkt
View File

@ -96,7 +96,7 @@
(loop (cons #'name out) #'())] (loop (cons #'name out) #'())]
[() (reverse out)]))) [() (reverse out)])))
(define (parse-call-arguments arguments) (define (parse-comma-expression arguments)
(if (null? (syntax->list arguments)) (if (null? (syntax->list arguments))
'() '()
(let loop ([used '()] (let loop ([used '()]
@ -224,6 +224,13 @@
(if current (if current
(values (left current) stream) (values (left current) stream)
(do-parse #'(rest ...) precedence left #'x))] (do-parse #'(rest ...) precedence left #'x))]
[(#%brackets stuff ...)
(define value (with-syntax ([(data ...)
(parse-comma-expression #'(stuff ...))])
#'(list data ...)))
(if current
(values (left current) stream)
(do-parse #'(rest ...) precedence left value))]
[(#%braces stuff ...) [(#%braces stuff ...)
(if current (if current
(values (left current) stream) (values (left current) stream)
@ -234,7 +241,7 @@
(debug "function call ~a\n" left) (debug "function call ~a\n" left)
(values (left (with-syntax ([current current] (values (left (with-syntax ([current current]
[(parsed-args ...) [(parsed-args ...)
(parse-call-arguments #'(args ...)) ]) (parse-comma-expression #'(args ...)) ])
#'(current parsed-args ...))) #'(current parsed-args ...)))
#'(rest ...)) #'(rest ...))
#; #;

2
collects/honu/core/read.rkt
View File

@ -329,7 +329,7 @@
(do-parse (cons sub-tree current) unparsed table))) (do-parse (cons sub-tree current) unparsed table)))
(define do-left-parens (make-encloser '#%parens ")" right-parens?)) (define do-left-parens (make-encloser '#%parens ")" right-parens?))
(define do-left-bracket (make-encloser '#%bracket "}" right-bracket?)) (define do-left-bracket (make-encloser '#%brackets "}" right-bracket?))
(define do-left-brace (make-encloser '#%braces "]" right-brace?)) (define do-left-brace (make-encloser '#%braces "]" right-brace?))
(define dispatch-table (list [list atom? do-atom] (define dispatch-table (list [list atom? do-atom]