Support typed Kotlin default parameters
ober
df9e55ab7994ee0de757edccf560f4349cc9381d
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -843,20 +843,65 @@ (lambda (case) (check-variant-case case type-names)) (typed-variant-cases variant)))) + (def (typed-param-has-default? param) + (not (eq? (typed-param-default param) '__typed_param_no_default))) + + (def (param-default-key owner param) + (list (*elaboration-scope*) owner (typed-param-name param) '*default*)) + + (def (check-param-defaults owner params env type-names) + (append-map + (lambda (param) + (if (not (typed-param-has-default? param)) + '() + (let-values ([(default-ir default-errors) + (infer-expression + (typed-param-default param) + env + type-names)]) + (let* ([actual-type (ir-type default-ir)] + [declared-type (typed-param-type param)] + [type-errors + (if (and actual-type + (valid-type? declared-type type-names) + (not (type-assignable? + actual-type + declared-type))) + (list (make-check-error 'param-default-type-mismatch + "parameter default type does not match declared type" + (list (typed-param-name param) + declared-type + actual-type) + (expr-source (typed-param-default param)))) + '())] + [all-errors (append default-errors type-errors)]) + (when (null? all-errors) + (record-elaboration-by-name! + (param-default-key owner param) + default-ir)) + all-errors)))) + params)) + (def (check-def def type-names) - (append - (duplicate-errors 'duplicate-param - "duplicate parameter name" - (map typed-param-name (typed-def-params def))) - (duplicate-errors 'duplicate-modifier - "duplicate modifier" - (typed-def-modifiers def)) - (effect-errors (typed-def-effects def)) - (append-map - (lambda (param) (check-type (typed-param-type param) type-names)) - (typed-def-params def)) - (check-type (typed-def-return-type def) type-names) - (check-def-body def type-names))) + (let ([params (typed-def-params def)]) + (append + (duplicate-errors 'duplicate-param + "duplicate parameter name" + (map typed-param-name params)) + (duplicate-errors 'duplicate-modifier + "duplicate modifier" + (typed-def-modifiers def)) + (effect-errors (typed-def-effects def)) + (append-map + (lambda (param) (check-type (typed-param-type param) type-names)) + params) + (check-param-defaults + (typed-def-name def) + params + (param-env params) + type-names) + (check-type (typed-def-return-type def) type-names) + (check-def-body def type-names)))) (def (check-extern decl type-names) (append @@ -1070,6 +1115,11 @@ (lambda (param) (check-type (typed-param-type param) visible-type-names)) params) + (check-param-defaults + '*constructor* + params + constructor-env + visible-type-names) (check-class-super (typed-class-decl-super class) constructor-env @@ -1485,7 +1535,15 @@ (let* ([type (parse-typed-type (caddr v))] [type-errors (check-type type type-names)]) (values (and (null? type-errors) - (make-typed-param (car v) type #f #f #f '() source)) + (make-typed-param + (car v) + type + '__typed_param_no_default + #f + #f + #f + '() + source)) type-errors))] [else (values #f --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -1004,16 +1004,23 @@ (typed-type->kotlin-type (cadr type)) (typed-type->kotlin-type type)))) - (def (lower-param param) + (def (param-default-key owner param) + (list (*kotlin-decl-scope*) owner (typed-param-name param) '*default*)) + + (def (lower-param/default-owner owner param) (make-kt-param (typed-param-name param) (lower-param-type param) - #f + (let ([default-ir (lookup-kotlin-ir (param-default-key owner param))]) + (and default-ir (lower-expr default-ir))) (typed-param-property param) (typed-param-mutable? param) (typed-param-visibility param) (typed-param-modifiers param))) + (def (lower-param param) + (lower-param/default-owner #f param)) + (def (lower-enum-param param) (make-kt-param (typed-param-name param) @@ -1033,7 +1040,9 @@ (typed-def-modifiers def) (or (typed-def-kotlin-name def) (typed-def-name def)) - (map lower-param (typed-def-params def)) + (map (lambda (param) + (lower-param/default-owner (typed-def-name def) param)) + (typed-def-params def)) (typed-type->kotlin-type (typed-def-return-type def)) (if (eq? (typed-def-return-type def) 'Unit) (lower-unit-statements ir) @@ -1121,7 +1130,9 @@ 'class #f (typed-class-decl-name decl) - (map lower-param (typed-class-decl-params decl)) + (map (lambda (param) + (lower-param/default-owner '*constructor* param)) + (typed-class-decl-params decl)) (let ([super (lower-class-super (typed-class-decl-super decl))]) (if super (list super) '())) (lower-nested-declarations --- a/lib/jerboa/typed/parser.ss +++ b/lib/jerboa/typed/parser.ss @@ -77,7 +77,8 @@ typed-variant-case-source typed-param? make-typed-param - typed-param-name typed-param-type typed-param-property + typed-param-name typed-param-type typed-param-default + typed-param-property typed-param-mutable? typed-param-visibility typed-param-modifiers typed-param-source @@ -105,7 +106,7 @@ (defstruct typed-extern (name params return-type kotlin-path source)) (defstruct typed-variant (name cases source)) (defstruct typed-variant-case (name fields source)) - (defstruct typed-param (name type property mutable? visibility modifiers source)) + (defstruct typed-param (name type default property mutable? visibility modifiers source)) (defstruct typed-def (name params return-type effects modifiers kotlin-name body source)) (def (strip-source-annotations datum) @@ -346,27 +347,54 @@ form)) (cdr form))) + (def (parse-param-default form) + (let ([raw-form (datum-value form)] + [form (strip-source-annotations form)]) + (unless (and (= (length form) 2) + (eq? (car form) 'default)) + (error 'parse-typed-param + "expected (default expr)" + form)) + (cadr raw-form))) + (def (parse-param-options options) (let loop ([rest options] + [default '__typed_param_no_default] [property #f] [visibility #f] [modifiers '()] + [seen-default? #f] [seen-property? #f] [seen-visibility? #f] [seen-modifiers? #f]) (cond [(null? rest) - (values property + (values default + property (eq? property 'var) visibility modifiers)] + [(param-option-form? (car rest) 'default) + (when seen-default? + (error 'parse-typed-param "duplicate default option" options)) + (loop (cdr rest) + (parse-param-default (car rest)) + property + visibility + modifiers + #t + seen-property? + seen-visibility? + seen-modifiers?)] [(param-option-form? (car rest) 'property) (when seen-property? (error 'parse-typed-param "duplicate property option" options)) (loop (cdr rest) + default (parse-param-property (car rest)) visibility modifiers + seen-default? #t seen-visibility? seen-modifiers?)] @@ -374,9 +402,11 @@ (when seen-visibility? (error 'parse-typed-param "duplicate visibility option" options)) (loop (cdr rest) + default property (parse-param-visibility (car rest)) modifiers + seen-default? seen-property? #t seen-modifiers?)] @@ -384,15 +414,17 @@ (when seen-modifiers? (error 'parse-typed-param "duplicate modifiers option" options)) (loop (cdr rest) + default property visibility (parse-param-modifiers (car rest)) + seen-default? seen-property? seen-visibility? #t)] [else (error 'parse-typed-param - "parameter options must be property, visibility, or modifiers forms" + "parameter options must be default, property, visibility, or modifiers forms" (car rest))]))) (def (parse-param form) @@ -402,11 +434,12 @@ (error 'parse-typed-param "expected (name : Type option ...)" form)) - (let-values ([(property mutable? visibility modifiers) + (let-values ([(default property mutable? visibility modifiers) (parse-param-options (cdddr form))]) (make-typed-param (expect-symbol 'parse-typed-param (car form) form) (parse-typed-type (caddr form)) + default property mutable? visibility --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -1573,8 +1573,11 @@ (export Store row) (type Context) (type Button) - (class Store ((context : Context (property val) (visibility private))) + (class Store ((context : Context (property val) (visibility private)) + (tag : String (property val) (default "main"))) (def (ready) : Bool #t)) + (def (label (text : String (default "SSD"))) : String + text) (def (row (buttons : (Array Button) (modifiers vararg))) : Unit (begin)))) @@ -1646,7 +1649,10 @@ "PRIMARY(1, 2, 18.0f, 56),\n NEUTRAL(3, 4, 15.0f, 48)") (test-contains "typed class constructor parameter lowers property visibility" param-options-kotlin - "class Store(private val context: Context)") + "class Store(private val context: Context, val tag: String = \"main\")") +(test-contains "typed function parameter lowers default value" + param-options-kotlin + "fun label(text: String = \"SSD\"): String") (test-contains "typed function parameter lowers vararg modifier" param-options-kotlin "fun row(vararg buttons: Button): Unit")