[honu] add structs and use . to lookup the field names in a struct instance

collects/honu/core/main.rkt

@@ -21,6 +21,7 @@
                      [honu-cons ::]
                      [honu-and and]
                      [honu-or or]
+                     [honu-structure structure]
                      [literal:honu-= =]
                      [literal:semicolon |;|]
                      [literal:honu-comma |,|]

collects/honu/core/private/honu2.rkt

@@ -2,6 +2,7 @@
 
 (require "macro2.rkt"
          "operator.rkt"
+         "struct.rkt"
          (only-in "literals.rkt"
                   semicolon)
          (for-syntax syntax/parse
@@ -9,6 +10,7 @@
                      "parse2.rkt"
                      racket/base))
 
+(provide (all-from-out "struct.rkt"))
 
 (provide honu-function)
 (define-honu-syntax honu-function
@@ -91,13 +93,17 @@
   (lambda (left right)
     (with-syntax ([left left]
                   [right right])
-      #'(let ([left* left]
-              [right* right])
+      #'(let ([left* left])
+          (cond
+            [(honu-struct? left*) (let ([use (honu-struct-get left*)])
+                                    (use left* 'right))]
+            [else (error 'dot "don't know how to deal with ~a" 'left)]))
+      #;
+      #'(let ([left* left])
           (cond
-            #;
             [(list? left*)
-             (list-ref left* right*)]
-            [else (error 'dot "don't know how to deal with ~a and ~a" left* right*)])))))
+             (list-ref left* right)]
+            [else (error 'dot "don't know how to deal with ~a and ~a" 'left 'right)])))))
 
 (define-binary-operator honu-+ 1 'left +)
 (define-binary-operator honu-- 1 'left -)

collects/honu/core/private/literals.rkt

@@ -25,4 +25,4 @@
                 honu-for-syntax
                 honu-for-template)
 
-(define-literal-set cruft (#%parens #%brackets #%braces semicolon honu-=))
+(define-literal-set cruft (#%parens #%brackets #%braces semicolon honu-= honu-comma))

collects/honu/core/private/parse2.rkt

@@ -330,3 +330,8 @@
                    (parse stx))
     (debug "parsed ~a\n" parsed)
     (list (parsed-things stx unparsed) parsed)))
+
+(provide identifier-comma-list)
+(define-splicing-syntax-class identifier-comma-list
+                              #:literal-sets (cruft)
+  [pattern (~seq (~seq name:id (~optional honu-comma)) ...)]) 

collects/honu/core/private/struct.rkt

@@ -0,0 +1,33 @@
+#lang racket/base
+
+(require "macro2.rkt"
+         (for-syntax racket/base
+                     "parse2.rkt"
+                     "literals.rkt"
+                     syntax/parse
+                     unstable/syntax))
+
+(provide honu-struct honu-struct? honu-struct-get)
+(define-values (honu-struct honu-struct? honu-struct-get)
+               (make-struct-type-property 'honu-struct))
+
+(define-for-syntax (make-accessors name fields)
+  (for/list ([field fields])
+    (format-unique-id name "~a-~a" name field)))
+
+(provide honu-structure)
+(define-honu-syntax honu-structure
+  (lambda (code context)
+    (syntax-parse code #:literal-sets (cruft)
+      [(_ name:id (#%braces fields:identifier-comma-list) . rest)
+       (define out
+         (with-syntax ([(fields.name/accessor ...)
+                        (make-accessors #'name (syntax->list #'(fields.name ...)))])
+           #'(struct name (fields.name ...)
+                     #:property honu-struct (lambda (instance name)
+                                              (case name
+                                                [(fields.name) (fields.name/accessor instance)]
+                                                ...
+                                                [else (error 'dot "no such field name ~a" name)])))))
+       (values out #'rest #t)])))
+