Add typed Kotlin class init blocks
ober
dfb64812ae3c12e43f4b54253eaacd7c028bd5ff
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -1044,6 +1044,26 @@ setter-ir))) all-errors))) + (def (check-init-decl init type-names) + (let-values ([(body-ir body-errors) + (infer-body + (typed-init-decl-body init) + (*global-value-env*) + type-names + (typed-init-decl-source init))]) + (let* ([actual-type (ir-type body-ir)] + [type-errors + (if (and actual-type (not (eq? actual-type 'Unit))) + (list (make-check-error 'init-type-mismatch + "init body must return Unit" + actual-type + (typed-init-decl-source init))) + '())] + [all-errors (append body-errors type-errors)]) + (when (null? all-errors) + (record-elaboration-by-name! '*init* body-ir)) + all-errors))) + (def (check-object-decl object type-names) (let* ([declarations (typed-object-decl-declarations object)] [local-type-names (declared-type-names declarations)] @@ -4004,6 +4024,7 @@ [(typed-record? decl) (check-record decl type-names)] [(typed-variant? decl) (check-variant decl type-names)] [(typed-property? decl) (check-property decl type-names)] + [(typed-init-decl? decl) (check-init-decl decl type-names)] [(typed-object-decl? decl) (check-object-decl decl type-names)] [(typed-class-decl? decl) (check-class-decl decl type-names)] [(typed-enum-decl? decl) (check-enum-decl decl type-names)] --- a/lib/jerboa/typed/kotlin/ast.ss +++ b/lib/jerboa/typed/kotlin/ast.ss @@ -46,6 +46,9 @@ kt-enum-entry? make-kt-enum-entry kt-enum-entry-name kt-enum-entry-args + kt-init? make-kt-init + kt-init-body + kt-return? make-kt-return kt-return-expr @@ -154,6 +157,7 @@ (visibility modifiers mutable? name type init annotations setter)) (defstruct kt-property-setter (param-name body)) (defstruct kt-enum-entry (name args)) + (defstruct kt-init (body)) ;; Statements. (defstruct kt-return (expr)) --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -1096,6 +1096,13 @@ (typed-param-name (typed-property-setter-param setter)) (lower-unit-statements setter-ir))))))) + (def (lower-init-declaration decl) + (let ([ir (lookup-kotlin-ir '*init*)]) + (unless ir + (error 'lower-init-declaration + "missing elaborated IR for init block")) + (make-kt-init (lower-unit-statements ir)))) + (def (lower-extern decl) (let* ([target (typed-extern-kotlin-path decl)] [kind-entry (assq 'kind target)] @@ -1187,6 +1194,7 @@ [(typed-record? decl) (lower-record decl)] [(typed-variant? decl) (lower-variant decl)] [(typed-property? decl) (lower-property decl)] + [(typed-init-decl? decl) (lower-init-declaration decl)] [(typed-object-decl? decl) (lower-object-declaration decl)] [(typed-class-decl? decl) (lower-class-declaration decl)] [(typed-enum-decl? decl) (lower-enum-declaration decl)] --- a/lib/jerboa/typed/kotlin/print.ss +++ b/lib/jerboa/typed/kotlin/print.ss @@ -588,6 +588,12 @@ ")"))) suffix))) + (def (write-init port indent init) + (write-line port indent "init {") + (for-each (lambda (stmt) (write-statement port (+ indent 1) stmt)) + (kt-init-body init)) + (write-line port indent "}")) + (def (write-enum-class-body port indent body) (let loop ([rest body] [entries '()] [decls '()]) (cond @@ -650,6 +656,7 @@ [(kt-function? decl) (write-function port indent decl)] [(kt-property? decl) (write-property port indent decl)] [(kt-enum-entry? decl) (write-enum-entry port indent decl "")] + [(kt-init? decl) (write-init port indent decl)] [else (error 'write-declaration "unsupported Kotlin declaration" decl)])) (def (write-import port import) --- a/lib/jerboa/typed/parser.ss +++ b/lib/jerboa/typed/parser.ss @@ -57,6 +57,9 @@ typed-class-super-name typed-class-super-args typed-class-super-source + typed-init-decl? make-typed-init-decl + typed-init-decl-body typed-init-decl-source + typed-enum-decl? make-typed-enum-decl typed-enum-decl-name typed-enum-decl-params typed-enum-decl-entries typed-enum-decl-source @@ -101,6 +104,7 @@ (defstruct typed-object-decl (name declarations source)) (defstruct typed-class-decl (name params super declarations source)) (defstruct typed-class-super (name args source)) + (defstruct typed-init-decl (body source)) (defstruct typed-enum-decl (name params entries source)) (defstruct typed-enum-entry (name args source)) (defstruct typed-extern (name params return-type kotlin-path source)) @@ -882,6 +886,17 @@ (map parse-typed-declaration decls) source))))) + (def (parse-init-decl form) + (let* ([source (datum-source form)] + [raw-form (datum-value form)] + [form (strip-source-annotations form)]) + (expect-proper-list 'parse-typed-init form) + (unless (>= (length form) 2) + (error 'parse-typed-init + "expected (init body ...)" + form)) + (make-typed-init-decl (cdr raw-form) source))) + (def (parse-enum-entry form) (let* ([source (datum-source form)] [raw-form (datum-value form)] @@ -931,6 +946,7 @@ [(val var) (parse-property form)] [(object) (parse-object-decl form)] [(class) (parse-class-decl form)] + [(init) (parse-init-decl form)] [(enum) (parse-enum-decl form)] [(variant) (parse-variant form)] [(extern) (parse-extern form)] --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -1573,6 +1573,8 @@ (begin (set! field value) (markDirty)))) + (init + (markDirty)) (def (performClick) : Bool (modifiers override) (begin @@ -1688,6 +1690,9 @@ (test-contains "typed class declaration lowers custom property setter" class-declaration-kotlin "var selected: String = \"\"\n set(value) {\n field = value\n markDirty()\n }") +(test-contains "typed class declaration lowers init block" + class-declaration-kotlin + "init {\n markDirty()\n }") (test-contains "typed class declaration lowers member function" class-declaration-kotlin "fun ready(): Boolean {\n return densityReady(density)")