[honu] wrap expressions with a semicolon at the end of them in (%semicolon ...)

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:semicolon %semicolon]
-                     [literal:honu-comma |,|]
+                     [literal:honu-comma %comma]
                      [literal:#%brackets #%brackets]
                      [literal:#%braces #%braces]
                      [literal:#%parens #%parens])

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 ...)))]))

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))

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)]
              #;

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 '%dot)]
-    ["," (token-identifier '|,|)]
+    ["," (token-identifier '%comma)]
-    [":" (token-identifier ':)]
+    [":" (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]

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_permissive_xexprs(true)
-  xml_xml_to_xexpr(xml_document_element(xml_read_xml()));
+  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");
+var xml = loadXml("test.xml")
-printf("xml ~a\n", xml);
+printf("xml ~a\n", xml)
-printf("data: ~a\n", xml.getData());
+printf("data: ~a\n", xml.getData())
-printf("table1: ~a\n", xml.Descendants("Table1"));
+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")