52 lines
2.0 KiB
Racket
52 lines
2.0 KiB
Racket
#lang racket/base
|
|
|
|
(require "syntax.rkt"
|
|
"literals.rkt"
|
|
(only-in "operator.rkt" honu-equal)
|
|
(only-in "honu2.rkt" honu-declaration separate-ids)
|
|
(for-syntax racket/base
|
|
"compile.rkt"
|
|
"literals.rkt"
|
|
"parse2.rkt"
|
|
"util.rkt"
|
|
syntax/parse)
|
|
racket/class)
|
|
|
|
(begin-for-syntax
|
|
(define (replace-with-public method)
|
|
(syntax-parse method #:literals (define)
|
|
[(define (name args ...) body ...)
|
|
(racket-syntax (define/public (name args ...) body ...))]))
|
|
(define-literal-set equals (honu-equal))
|
|
(define-splicing-syntax-class honu-class-thing
|
|
#:literal-sets (equals)
|
|
[pattern method:honu-function
|
|
#:with result (replace-with-public (local-binding method.result))]
|
|
[pattern var:honu-declaration
|
|
#:with result #'(field [var.name var.expression] ...)]))
|
|
|
|
(provide honu-class)
|
|
(define-honu-syntax honu-class
|
|
(lambda (code)
|
|
(syntax-parse code #:literal-sets (cruft)
|
|
;; FIXME: empty parenthesis for constructor arguments should be optional
|
|
[(_ name (#%parens (~var constructor-argument (separate-ids (literal-syntax-class honu-comma) (literal-syntax-class honu-comma))))
|
|
(#%braces method:honu-class-thing ...) . rest)
|
|
(define class
|
|
(racket-syntax (define name (class* object% ()
|
|
(super-new)
|
|
(init-field constructor-argument.id ...)
|
|
method.result ...))))
|
|
(values class (local-binding rest) #t)])))
|
|
|
|
(provide honu-new)
|
|
(define-honu-syntax honu-new
|
|
(lambda (code)
|
|
(syntax-parse code #:literal-sets (cruft)
|
|
[(_ name (#%parens arg:honu-expression/comma) . rest)
|
|
(define new (racket-syntax (make-object name (let () arg.result) ...)))
|
|
(values
|
|
new
|
|
(local-binding rest)
|
|
#f)])))
|