[honu] add simple class form. share the function parsing syntax class

collects/honu/core/main.rkt

@@ -3,6 +3,7 @@
 (require "private/honu-typed-scheme.rkt"
          "private/honu2.rkt"
          "private/macro2.rkt"
+         "private/class.rkt"
          (for-syntax (only-in "private/parse2.rkt" honu-expression))
          (prefix-in literal: "private/literals.rkt"))
 
@@ -12,6 +13,8 @@
          (for-syntax (rename-out [honu-expression expression]))
          (rename-out [#%dynamic-honu-module-begin #%module-begin]
                      [honu-top-interaction #%top-interaction]
+                     [honu-class class]
+                     [honu-new new]
                      [honu-function function]
                      [honu-require require]
                      [honu-macro macro]

collects/honu/core/private/class.rkt

@@ -0,0 +1,43 @@
+#lang racket/base
+
+(require "macro2.rkt"
+         (for-syntax racket/base
+                     "literals.rkt"
+                     "parse2.rkt"
+                     syntax/parse)
+         racket/class)
+
+(begin-for-syntax
+  (define (replace-with-public method)
+    (syntax-parse method #:literals (define)
+      [(define (name args ...) body ...)
+       #'(define/public (name args ...) body ...)]))
+  (define-splicing-syntax-class honu-class-method
+    [pattern method:honu-function
+             #:with result (replace-with-public #'method.result)]))
+
+(provide honu-class)
+(define-honu-syntax honu-class
+  (lambda (code context)
+    (syntax-parse code #:literal-sets (cruft)
+      [(_ name (#%parens constructor-argument ...) (#%braces method:honu-class-method ...) . rest)
+       (define class
+         #'(define name (class* object% ()
+                                (super-new)
+                                (init-field constructor-argument ...)
+                                method.result ...)))
+       (values
+         class
+         #'rest
+         #t)])))
+
+(provide honu-new)
+(define-honu-syntax honu-new
+  (lambda (code context)
+    (syntax-parse code #:literal-sets (cruft)
+      [(_ name (#%parens arg ...) . rest)
+       (define new #'(make-object name arg ...))
+       (values
+         new
+         #'rest
+         #f)])))

collects/honu/core/private/honu2.rkt

@@ -4,6 +4,7 @@
          "operator.rkt"
          "struct.rkt"
          "honu-typed-scheme.rkt"
+         racket/class
          (only-in "literals.rkt"
                   honu-then
                   semicolon)
@@ -127,6 +128,8 @@
           (cond
             [(honu-struct? left*) (let ([use (honu-struct-get left*)])
                                     (use left* 'right))]
+            [(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)])))))
 

collects/honu/core/private/parse2.rkt

@@ -134,6 +134,17 @@
   (debug "Comma? ~a ~a\n" what is)
   is)
 
+(provide honu-function)
+(define-splicing-syntax-class honu-function #:literal-sets (cruft)
+  [pattern (~seq function:identifier (#%parens args ...) (#%braces code ...))
+           #:with result
+           (with-syntax ([(parsed-arguments ...)
+                          (parse-arguments #'(args ...))])
+             #'(define (function parsed-arguments ...)
+                 (let-syntax ([parse-more (lambda (stx)
+                                            (parse-all #'(code ...)))])
+                   (parse-more))))])
+
 ;; 1 + 1
 ;; ^
 ;;  left: identity
@@ -217,6 +228,9 @@
                   stream)]
          [else
            (syntax-parse #'(head rest ...) #:literal-sets (cruft)
+             [(function:honu-function . rest)
+              (values #'function.result #'rest)]
+             #;
              [(function:identifier (#%parens args ...) (#%braces code ...) . rest)
               (values (with-syntax ([(parsed-arguments ...)
                                      (parse-arguments #'(args ...))])

collects/tests/honu/class.honu

@@ -0,0 +1,10 @@
+#lang honu
+
+class What(x){
+  foobar(z){
+    z + x
+  }
+};
+
+var instance = new What(5);
+printf("got ~a\n", instance.foobar(10))