diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt index f6f3825583..368aa31098 100644 --- a/collects/honu/core/main.rkt +++ b/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] diff --git a/collects/honu/core/private/class.rkt b/collects/honu/core/private/class.rkt new file mode 100644 index 0000000000..979f1c4dd9 --- /dev/null +++ b/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)]))) diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index 5e822489f0..d488720c66 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/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)]))))) diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index 4d93b5c8ea..3c0629a3ca 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/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 ...))]) diff --git a/collects/tests/honu/class.honu b/collects/tests/honu/class.honu new file mode 100644 index 0000000000..a609d32330 --- /dev/null +++ b/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))