Lower typed Kotlin constructor expressions
ober
fec34fcdcdb3cd21f6e599c46c4304d940c8bb72
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -3203,6 +3203,8 @@ (if (= (length args) 1) (check-ownership-expression (car args) env moved) (values moved '()))] + [(new) + (check-ownership-sequence (cdr args) env moved)] [(try) (if (= (length args) 2) (let ([catch-form (expr-value (cadr args))]) @@ -3418,6 +3420,36 @@ "return expects zero or one expression" expr)))])) + (def (infer-new args env type-names expr) + (cond + [(null? args) + (values #f + (list (error-at expr 'bad-new + "new expects a type and zero or more constructor arguments" + expr)))] + [else + (let* ([type-form (strip-source-annotations (car args))] + [result-type (parse-typed-type type-form)] + [type-errors (check-type result-type type-names)]) + (let loop ([rest (cdr args)] [arg-irs '()] [errors type-errors]) + (if (null? rest) + (let ([ok? (and (null? errors) + (valid-type? result-type type-names) + (all-irs-valid? (reverse arg-irs)))]) + (values + (and ok? + (make-typed-ir-new + result-type + (expr-source expr) + result-type + (reverse arg-irs))) + (reverse errors))) + (let-values ([(arg-ir arg-errors) + (infer-expression (car rest) env type-names)]) + (loop (cdr rest) + (cons arg-ir arg-irs) + (append (reverse arg-errors) errors))))))])) + (def (infer-try args env type-names expr) (cond [(not (= (length args) 2)) @@ -3561,6 +3593,8 @@ (infer-lambda args env type-names expr)] [(object) (infer-object args env type-names expr)] + [(new) + (infer-new args env type-names expr)] [(invoke) (infer-function-value-invoke args env type-names expr)] [(match) --- a/lib/jerboa/typed/core.ss +++ b/lib/jerboa/typed/core.ss @@ -97,6 +97,11 @@ typed-ir-object-method-body typed-ir-object-method-source + typed-ir-new? + make-typed-ir-new + typed-ir-new-type typed-ir-new-source + typed-ir-new-result-type typed-ir-new-args + typed-ir-for-fold? make-typed-ir-for-fold typed-ir-for-fold-type typed-ir-for-fold-source @@ -158,6 +163,7 @@ (defstruct typed-ir-object (type source super-type super-args methods)) (defstruct typed-ir-object-method (modifiers name params return-type body source)) + (defstruct typed-ir-new (type source result-type args)) ;; single-accumulator fold over an in-range index: the loop variable runs ;; [range-start, range-end); body (of acc's type) becomes acc's next value. (defstruct typed-ir-for-fold @@ -287,6 +293,7 @@ (typed-ir-try? x) (typed-ir-lambda? x) (typed-ir-object? x) + (typed-ir-new? x) (typed-ir-for-fold? x) (typed-ir-bytes-build? x) (typed-ir-match? x) @@ -309,6 +316,7 @@ [(typed-ir-try? node) (typed-ir-try-type node)] [(typed-ir-lambda? node) (typed-ir-lambda-type node)] [(typed-ir-object? node) (typed-ir-object-type node)] + [(typed-ir-new? node) (typed-ir-new-type node)] [(typed-ir-for-fold? node) (typed-ir-for-fold-type node)] [(typed-ir-bytes-build? node) (typed-ir-bytes-build-type node)] [(typed-ir-match? node) (typed-ir-match-type node)] @@ -332,6 +340,7 @@ [(typed-ir-try? node) (typed-ir-try-source node)] [(typed-ir-lambda? node) (typed-ir-lambda-source node)] [(typed-ir-object? node) (typed-ir-object-source node)] + [(typed-ir-new? node) (typed-ir-new-source node)] [(typed-ir-for-fold? node) (typed-ir-for-fold-source node)] [(typed-ir-bytes-build? node) (typed-ir-bytes-build-source node)] [(typed-ir-match? node) (typed-ir-match-source node)] --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -871,6 +871,10 @@ (lower-lambda ir)] [(typed-ir-object? ir) (lower-object ir)] + [(typed-ir-new? ir) + (make-kt-new + (typed-type->kotlin-type (typed-ir-new-result-type ir)) + (map lower-expr (typed-ir-new-args ir)))] [(typed-ir-for-fold? ir) (lower-for-fold ir)] [(typed-ir-bytes-build? ir) --- a/tests/test-typed-checker.ss +++ b/tests/test-typed-checker.ss @@ -2038,6 +2038,23 @@ (return (int32 1) (int32 2))))) '(bad-return)) +(test "new expression typechecks" + (error-kinds + '(typed-library (control new-ok) + (export makeMatrix) + (type Matrix) + (def (makeMatrix) : Matrix + (new Matrix)))) + '()) + +(test "new expression rejects unknown type" + (error-kinds + '(typed-library (control new-bad) + (export makeMissing) + (def (makeMissing) : Missing + (new Missing)))) + '(unknown-type unknown-type)) + (printf "~%Typed checker: ~a passed, ~a failed~%" pass fail) (when (> fail 0) (exit 1)) --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -1516,6 +1516,16 @@ (define return-kotlin (typed-library-form->kotlin-string return-form)) +(define new-expression-form + '(typed-library (sample typed constructors) + (export makeMatrix) + (type Matrix) + (def (makeMatrix) : Matrix + (new Matrix)))) + +(define new-expression-kotlin + (typed-library-form->kotlin-string new-expression-form)) + (define class-declaration-kotlin (typed-library-form->kotlin-string class-declaration-form)) @@ -1537,6 +1547,9 @@ (test-contains "typed return lowers to Kotlin return statement" return-kotlin "return true") +(test-contains "typed new expression lowers to Kotlin constructor call" + new-expression-kotlin + "return Matrix()") (printf "typed-kotlin tests: ~a passed, ~a failed~%" pass fail) (when (> fail 0) (exit 1))