[honu] dont produce an extra void expression in a block. add a for form to iterate over a list. add an example of linq with xml

collects/honu/core/main.rkt

@@ -13,6 +13,7 @@
          (for-syntax (rename-out [honu-expression expression]))
          (rename-out [#%dynamic-honu-module-begin #%module-begin]
                      [honu-top-interaction #%top-interaction]
+                     [honu-with-input-from-file with_input_from_file]
                      [honu-class class]
                      [honu-new new]
                      [honu-function function]
@@ -42,8 +43,10 @@
                      [honu-not not] [honu-not !]
                      [honu-structure structure]
                      [honu-structure struct]
+                     [literal:honu-prefix prefix]
                      [literal:honu-then then]
                      [literal:colon :]
+                     [literal:honu-in in]
                      [literal:semicolon |;|]
                      [literal:honu-comma |,|]
                      [literal:#%brackets #%brackets]

collects/honu/core/private/class.rkt

@@ -35,8 +35,8 @@
 (define-honu-syntax honu-new
   (lambda (code context)
     (syntax-parse code #:literal-sets (cruft)
-      [(_ name (#%parens arg ...) . rest)
+      [(_ name (#%parens arg:honu-expression ...) . rest)
-       (define new #'(make-object name arg ...))
+       (define new #'(make-object name arg.result ...))
        (values
          new
          #'rest

collects/honu/core/private/honu-typed-scheme.rkt

@@ -459,7 +459,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
     [(_ forms ...)
      (define-values (parsed unparsed) (honu-expand #'(forms ...)))
      (debug "expanded ~a unexpanded ~a\n"
-            (syntax->datum parsed)
+            (if parsed (syntax->datum parsed) parsed)
             (syntax->datum unparsed))
      (with-syntax ([parsed parsed]
                    [(unparsed ...) unparsed])

collects/honu/core/private/honu2.rkt

@@ -5,8 +5,11 @@
          "struct.rkt"
          "honu-typed-scheme.rkt"
          racket/class
+         racket/require
          (only-in "literals.rkt"
                   honu-then
+                  honu-in
+                  honu-prefix
                   semicolon)
          (for-syntax syntax/parse
                      "literals.rkt"
@@ -50,14 +53,20 @@
 (define-honu-syntax honu-for
   (lambda (code context)
     (syntax-parse code #:literal-sets (cruft)
-                       #:literals (honu-=)
+                       #:literals (honu-= honu-in)
       [(_ iterator:id honu-= start:honu-expression honu-to end:honu-expression
           honu-do body:honu-expression . rest)
        (values
          #'(for ([iterator (in-range start.result end.result)])
              body.result)
          #'rest
-         #t)])))
+         #t)]
+      [(_ iterator:id honu-in stuff:honu-expression
+          honu-do body:honu-expression . rest)
+       (values #'(for ([iterator stuff.result])
+                   body.result)
+               #'rest
+               #t)])))
 
 (provide honu-if)
 (define-honu-syntax honu-if
@@ -131,7 +140,7 @@
             [(object? left*) (lambda args
                                (send/apply left* right args))]
             ;; possibly handle other types of data
-            [else (error 'dot "don't know how to deal with ~a" 'left)])))))
+            [else (error 'dot "don't know how to deal with ~a (~a)" 'left left*)])))))
 
 (provide honu-flow)
 (define-honu-operator/syntax honu-flow 0.001 'left
@@ -170,12 +179,41 @@
     [(_ rest ...)
      #'(#%top-interaction . (honu-unparsed-begin rest ...))]))
 
+(begin-for-syntax
+  (define-splicing-syntax-class require-form
+                                #:literals (honu-prefix)
+                                #:literal-sets (cruft)
+    [pattern (~seq honu-prefix prefix module)
+             #:with result #'(prefix-in prefix module)]
+    [pattern x:str #:with result #'x]
+    [pattern x:id #:with result #'x
+             #:when (not ((literal-set->predicate cruft) #'x))]))
+
+(define-for-syntax (racket-names->honu name)
+  (regexp-replace* #rx"-" "_"))
+
 (provide honu-require)
 (define-honu-syntax honu-require
   (lambda (code context)
     (syntax-parse code
-      [(_ module . rest)
+      [(_ form:require-form ... . rest)
        (values
-         #'(require module)
+         #'(require (filtered-in (lambda (name)
+                                   (regexp-replace* #rx"-"
+                                                    (regexp-replace* #rx"->" name "_to_")
+                                                    "_"))
+                                 (combine-in form.result ...)))
+
+         #'rest
+         #f)])))
+
+(provide honu-with-input-from-file)
+(define-honu-syntax honu-with-input-from-file
+  (lambda (code context)
+    (syntax-parse code #:literal-sets (cruft)
+      [(_ (#%parens name:id) something:honu-expression . rest)
+       (define with #'(with-input-from-file name (lambda () something.result)))
+       (values
+         with
          #'rest
          #f)])))

collects/honu/core/private/literals.rkt

@@ -25,7 +25,9 @@
                 honu-? honu-: honu-comma honu-. #%braces #%brackets #%parens colon
                 honu-and
                 ellipses-comma ellipses-comma* ellipses-repeat
+                honu-in
                 honu-for-syntax
-                honu-for-template)
+                honu-for-template
+                honu-prefix)
 
 (define-literal-set cruft (#%parens #%brackets #%braces semicolon colon honu-comma honu-<-))

collects/honu/core/private/parse2.rkt

@@ -122,7 +122,9 @@
 
 (define parsed-property (gensym 'honu-parsed))
 (define (parsed-syntax syntax)
-  (syntax-property syntax parsed-property #t))
+  (if syntax
+    (syntax-property syntax parsed-property #t)
+    syntax))
 
 (define (parsed-syntax? syntax)
   (syntax-property syntax parsed-property))
@@ -178,7 +180,7 @@
       [pattern x:number])
 
     (debug "parse ~a precedence ~a left ~a current ~a\n" stream precedence left current)
-    (define final (if current current #'(void)))
+    (define final (if current current #f))
     (syntax-parse stream #:literal-sets (cruft)
       [()
        (values (left final) #'())]
@@ -332,10 +334,12 @@
              [code code])
     (define-values (parsed unparsed)
                    (parse (strip-stops code)))
-    (debug "Parsed ~a unparsed ~a\n" (syntax->datum parsed)
+    (debug "Parsed ~a unparsed ~a\n" (if parsed (syntax->datum parsed) parsed)
-           (syntax->datum unparsed))
+           (if unparsed (syntax->datum unparsed) unparsed))
     (if (empty-syntax? unparsed)
-      (with-syntax ([(use ...) (reverse (cons parsed all))])
+      (with-syntax ([(use ...) (reverse (if parsed
+                                          (cons parsed all)
+                                          all))])
         #'(begin use ...))
       (loop (cons parsed all)
             unparsed))))
@@ -372,7 +376,7 @@
     (debug "honu expression syntax class\n")
     (define-values (parsed unparsed)
                    (parse stx))
-    (debug "parsed ~a\n" parsed)
+    (debug "parsed ~a\n" (if parsed (syntax->datum parsed) parsed))
     (list (parsed-things stx unparsed) parsed)))
 
 (provide identifier-comma-list)

collects/honu/core/private/struct.rkt

@@ -24,6 +24,7 @@
          (with-syntax ([(fields.name/accessor ...)
                         (make-accessors #'name (syntax->list #'(fields.name ...)))])
            #'(struct name (fields.name ...)
+                     #:transparent
                      #:property honu-struct (lambda (instance name)
                                               (case name
                                                 [(fields.name) (fields.name/accessor instance)]

collects/tests/honu/linq.honu

@@ -0,0 +1,48 @@
+#lang honu
+
+require prefix xml_ xml;
+require "linq.rkt";
+
+class Xml(data){
+  Descendants(name){
+    [new Xml(element): element <- find_descendants(data, name)]
+  }
+
+  Element(name){
+    new Xml(get_element(data, name));
+  }
+
+  Value(){
+    get_text(data);
+  }
+
+  getData(){ data }
+};
+
+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());
+  }
+}
+
+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};
+
+var addresses = linq from add in xml.Descendants("Table1")
+                     select test(add.Element("familyName").Value(),
+                                 add.Element("address").Value());
+
+printf("addresses ~a\n", addresses);
+
+for add in addresses do {
+  printf("name ~a address ~a\n", add.name, add.address);
+}

collects/tests/honu/linq.rkt

@@ -0,0 +1,56 @@
+#lang racket/base
+
+(require honu/core/private/macro2
+         honu/core/private/honu-typed-scheme
+         honu/core/private/literals
+         racket/list
+         racket/match
+         (for-syntax racket/base
+                     honu/core/private/literals
+                     honu/core/private/parse2
+                     syntax/parse))
+
+(define-literal linq-from linq-select)
+(provide linq (rename-out [linq-from from]
+                          [linq-select select]))
+
+(define-honu-syntax linq
+  (lambda (code context)
+    (syntax-parse code #:literal-sets (cruft)
+                       #:literals (honu-in)
+      [(_ linq-from name:id honu-in
+          (~var store honu-expression)
+          linq-select what:honu-expression . rest)
+       (define out
+         #'(for/list ([name store.result])
+             what.result))
+       (values out #'rest #f)])))
+          
+#|
+var addresses = linq from add in xml.Descendants("Table1")
+                     select new {
+                       Name = add.Element("familyName").Value,
+                       Address = add.Element("address").Value
+                     };
+
+|#
+
+(provide find-descendants)
+(define (find-descendants xexpr name)
+  (match xexpr
+    [(list root root-attributes elements ...)
+     (filter (lambda (element)
+               (match element
+                 [(list (? (lambda (x) (string=? name (symbol->string x)))) stuff ...) #t]
+                 [else #f]))
+             elements)]))
+
+(provide get-element)
+(define (get-element xexpr name)
+  (first (find-descendants xexpr name)))
+
+(provide get-text)
+(define (get-text xexpr)
+  (match xexpr
+    [(list name attributes text)
+     text]))