diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt index 0e680c7f95..785e2b69a3 100644 --- a/collects/honu/core/main.rkt +++ b/collects/honu/core/main.rkt @@ -36,7 +36,7 @@ [literal:honu-<- <-] [honu-map map] [honu-flow \|] - [honu-dot |.|] + [honu-dot %dot] [honu-string=? string_equal] [honu-cons ::] [honu-and and] [honu-and &&] @@ -46,10 +46,10 @@ [honu-structure struct] [literal:honu-prefix prefix] [literal:honu-then then] - [literal:colon :] + [literal:colon %colon] [literal:honu-in in] - [literal:semicolon |;|] - [literal:honu-comma |,|] + [literal:semicolon %semicolon] + [literal:honu-comma %comma] [literal:#%brackets #%brackets] [literal:#%braces #%braces] [literal:#%parens #%parens]) diff --git a/collects/honu/core/private/honu-typed-scheme.rkt b/collects/honu/core/private/honu-typed-scheme.rkt index 9a6574c4aa..e252b70e72 100644 --- a/collects/honu/core/private/honu-typed-scheme.rkt +++ b/collects/honu/core/private/honu-typed-scheme.rkt @@ -9,6 +9,7 @@ syntax/parse/experimental/splicing scheme/splicing macro-debugger/emit + racket/pretty "debug.rkt" "contexts.rkt" "util.rkt" @@ -474,5 +475,5 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt (syntax-case stx () [(_ forms ...) (begin - (debug "Module begin ~a\n" (syntax->datum #'(forms ...))) + (debug "Module begin ~a\n" (pretty-format (syntax->datum #'(forms ...)))) #'(#%module-begin (honu-unparsed-begin forms ...)))])) diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index db0bc67d00..284db1ac5e 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/collects/honu/core/private/honu2.rkt @@ -38,10 +38,15 @@ (lambda (code context) (syntax-parse code #:literal-sets (cruft) #:literals (honu-=) - [(_ name:id honu-= . rest) + [(_ name:id honu-= one:honu-expression . rest) + (values #'(define name one.result) + #'rest + #t) ;; parse one expression + #; (define-values (parsed unparsed) (parse #'rest)) + #; (values (with-syntax ([parsed parsed]) #'(define name parsed)) diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index 4b13214323..a720ad27c7 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -100,6 +100,7 @@ ;; removes syntax that causes expression parsing to stop (define (strip-stops code) (define-syntax-class stopper #:literal-sets (cruft) + #; [pattern semicolon] [pattern honu-comma] [pattern colon]) @@ -227,11 +228,23 @@ 0 (lambda (x) x) (left final)))] + [(stopper? #'head) (values (left final) stream)] [else (syntax-parse #'(head rest ...) #:literal-sets (cruft) + [((semicolon more ...) . rest) + #; + (define-values (parsed unparsed) + (do-parse #'(more ...) + 0 + (lambda (x) x) + #f)) + #; + (when (not (stx-null? unparsed)) + (raise-syntax-error 'parse "found unparsed input" unparsed)) + (values (parse-all #'(more ...)) #'rest)] [(function:honu-function . rest) (values #'function.result #'rest)] #; diff --git a/collects/honu/core/read.rkt b/collects/honu/core/read.rkt index 1feb369686..1d9868e637 100644 --- a/collects/honu/core/read.rkt +++ b/collects/honu/core/read.rkt @@ -20,6 +20,7 @@ parse-error left-bracket right-bracket left-brace right-brace + semicolon block-comment end-of-line-comment]) @@ -67,13 +68,13 @@ #; [block-comment (token-whitespace)] ["/*" (token-block-comment)] - ["." (token-identifier '|.|)] - ["," (token-identifier '|,|)] - [":" (token-identifier ':)] + ["." (token-identifier '%dot)] + ["," (token-identifier '%comma)] + [":" (token-identifier '%colon)] ["'" (token-identifier 'quote)] ["`" (token-identifier 'quasiquote)] [operator (token-identifier (string->symbol lexeme))] - [";" (token-identifier '|;|)] + [";" (token-semicolon)] ;; strip the quotes from the resulting string ;; TODO: find a more optimal way [string (let () @@ -109,7 +110,8 @@ block-comment parse-error identifier left-parens right-parens left-bracket right-bracket - left-brace right-brace) + left-brace right-brace + semicolon) ;; returns #t if an entire comment was read (with an ending newline) (define (read-until-end-of-line input) @@ -294,6 +296,63 @@ (define (do-empty current tokens table) (reverse current)) + + (define (contains-semicolon? syntax) + (syntax-case syntax (%semicolon #%braces #%parens) + [(%semicolon x ...) #t] + [#%braces #t] + [(#%braces x ...) #t] + #; + [(#%parens x ...) #t] + [else #f])) + + ;; wraps syntax objects with (%semicolon ...) + ;; it will search backwards through the list of already created syntax objects + ;; until it either runs out of syntax objects or finds one already wrapped with + ;; (%semicolon ...) + ;; + ;; if the original input is '1 + 2; 3 + 4;' this will get read as + ;; (1 + 2 %semicolon 3 + 4 %semicolon) + ;; then parsing will start from the front. when %semicolon is reached we will have + ;; the following (current is always backwards). + ;; current: (2 + 1) + ;; do-semicolon will search this for a syntax object containing (%semicolon ...) but + ;; since one doesn't appear the entire expression will be reversed and wrapped thus + ;; resulting in + ;; (%semicolon 1 + 2) + ;; + ;; Now parsing continues with (3 + 4 %semicolon). When the next %semicolon is hit we + ;; will have + ;; current: (4 + 3 (%semicolon 1 + 2)) + ;; + ;; So do-semicolon will find (%semicolon 1 + 2) and leave stop processing there, + ;; resulting in + ;; ((%semicolon 3 + 4) (%semicolon 1 + 2)) + ;; + ;; The entire list will be reversed at the end of parsing. + (define (do-semicolon current tokens table) + ;; (debug "Do semicolon on ~a\n" current) + (define-values (wrap ok) + (let loop ([found '()] + [rest current]) + (match rest + [(list) (values found rest)] + [(list (and (? contains-semicolon?) head) rest* ...) + (values found rest)] + [(list head rest ...) + (loop (cons head found) rest)]))) + (define semicolon (make-syntax `(%semicolon ,@wrap) + ;; FIXME: this is probably the wrong token + ;; to get source location from + (car tokens) + source)) + + (do-parse (cons semicolon ok) + (cdr tokens) + table)) + + (define (semicolon? tokens) + (is-first-token token-semicolon? tokens)) (define (left-parens? tokens) (is-first-token token-left-parens? tokens)) @@ -334,7 +393,8 @@ (define do-left-bracket (make-encloser '#%brackets "}" right-bracket?)) (define do-left-brace (make-encloser '#%braces "]" right-brace?)) - (define dispatch-table (list [list atom? do-atom] + (define dispatch-table (list [list semicolon? do-semicolon] + [list atom? do-atom] [list left-parens? do-left-parens] [list left-bracket? do-left-bracket] [list left-brace? do-left-brace] diff --git a/collects/tests/honu/linq.honu b/collects/tests/honu/linq.honu index 3f27c29038..e05bd41623 100644 --- a/collects/tests/honu/linq.honu +++ b/collects/tests/honu/linq.honu @@ -9,24 +9,24 @@ class Xml(data){ } Element(name){ - new Xml(get_element(data, name)); + new Xml(get_element(data, name)) } Value(){ - get_text(data); + get_text(data) } getData(){ data } -}; +} read_xml(){ - xml_permissive_xexprs(true); - xml_xml_to_xexpr(xml_document_element(xml_read_xml())); + xml_permissive_xexprs(true) + xml_xml_to_xexpr(xml_document_element(xml_read_xml())) } loadXml(file){ with_input_from_file(file){ - new Xml(read_xml()); + new Xml(read_xml()) } } @@ -34,23 +34,23 @@ starts_with(start, what){ substring(what, 0, string_length(start)) string_equal start } -var xml = loadXml("test.xml"); -printf("xml ~a\n", xml); -printf("data: ~a\n", xml.getData()); -printf("table1: ~a\n", xml.Descendants("Table1")); +var xml = loadXml("test.xml") +printf("xml ~a\n", xml) +printf("data: ~a\n", xml.getData()) +printf("table1: ~a\n", xml.Descendants("Table1")) -struct test{name, address}; +struct test{name, address} var addresses = linq from add in xml.Descendants("Table1") where true orderby add.Element("familyName").Value() select test(add.Element("familyName").Value(), - add.Element("address").Value()); + add.Element("address").Value()) -printf("addresses ~a\n", addresses); +printf("addresses ~a\n", addresses) for add in addresses do { - printf("name ~a address ~a\n", add.name, add.address); + printf("name ~a address ~a\n", add.name, add.address) } for xs in linq from foo in xml.Descendants("Table1")