Support typed Kotlin property modifiers
ober
2aa15be6e5c71b0c0b6b79a141bde742a3c5d76c
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -893,12 +893,16 @@ (def (check-property prop type-names) (let-values ([(init-ir init-errors) - (infer-expression - (typed-property-init prop) - (*global-value-env*) - type-names)]) + (if (not (eq? (typed-property-init prop) + '__typed_property_no_init)) + (infer-expression + (typed-property-init prop) + (*global-value-env*) + type-names) + (values #f '()))]) (let* ([setter (typed-property-setter prop)] [setter-param (and setter (typed-property-setter-param setter))] + [modifiers (typed-property-modifiers prop)] [setter-env (and setter-param (extend-env/mutable @@ -947,8 +951,22 @@ [else '()])] [actual-type (ir-type init-ir)] [declared-type (typed-property-type prop)] + [lateinit? (memq 'lateinit modifiers)] + [missing-init-errors + (cond + [(not (eq? (typed-property-init prop) + '__typed_property_no_init)) '()] + [(and (typed-property-mutable? prop) lateinit?) '()] + [else + (list (make-check-error 'property-initializer-missing + "property without initializer must be a mutable lateinit property" + (typed-property-name prop) + (typed-property-source prop)))])] [type-errors (append + (duplicate-errors 'duplicate-modifier + "duplicate modifier" + modifiers) (check-type declared-type type-names) (if setter-param (check-type (typed-param-type setter-param) type-names) @@ -964,9 +982,11 @@ (typed-property-source prop))) '()))] [all-errors - (append init-errors type-errors setter-errors setter-shape-errors)]) + (append init-errors type-errors missing-init-errors + setter-errors setter-shape-errors)]) (when (null? all-errors) - (record-elaboration-by-name! (typed-property-name prop) init-ir) + (when init-ir + (record-elaboration-by-name! (typed-property-name prop) init-ir)) (when setter (record-elaboration-by-name! (list (typed-property-name prop) '*setter*) --- a/lib/jerboa/typed/kotlin/ast.ss +++ b/lib/jerboa/typed/kotlin/ast.ss @@ -32,7 +32,8 @@ kt-function-return-type kt-function-body kt-function-annotations kt-property? make-kt-property - kt-property-visibility kt-property-mutable? + kt-property-visibility kt-property-modifiers + kt-property-mutable? kt-property-name kt-property-type kt-property-init kt-property-annotations kt-property-setter @@ -137,7 +138,7 @@ (defstruct kt-function (visibility modifiers name params return-type body annotations)) (defstruct kt-property - (visibility mutable? name type init annotations setter)) + (visibility modifiers mutable? name type init annotations setter)) (defstruct kt-property-setter (param-name body)) ;; Statements. --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -1015,16 +1015,19 @@ (def (lower-property prop) (let ([ir (lookup-kotlin-ir (typed-property-name prop))] [setter (typed-property-setter prop)]) - (unless ir + (when (and (not (eq? (typed-property-init prop) + '__typed_property_no_init)) + (not ir)) (error 'lower-property "missing elaborated IR for typed property" (typed-property-name prop))) (make-kt-property #f + (typed-property-modifiers prop) (typed-property-mutable? prop) (typed-property-name prop) (typed-type->kotlin-type (typed-property-type prop)) - (lower-expr ir) + (and ir (lower-expr ir)) '() (and setter (let ([setter-ir --- a/lib/jerboa/typed/kotlin/print.ss +++ b/lib/jerboa/typed/kotlin/print.ss @@ -531,6 +531,7 @@ (write-line port indent (string-append (visibility-prefix (kt-property-visibility prop)) + (modifier-prefix (kt-property-modifiers prop)) (if (kt-property-mutable? prop) "var " "val ") (kotlin-symbol-name (kt-property-name prop)) (if (kt-property-type prop) @@ -556,12 +557,15 @@ (for-each (lambda (line) (write-line port indent line)) (annotation-lines (kt-class-annotations class))) (write-line port indent - (string-append - (class-prefix class) - (kotlin-symbol-name (kt-class-name class)) - (class-params-text class) - (class-super-text class) - " {")) + (if (and (eq? (kt-class-kind class) 'object) + (eq? (kt-class-name class) 'companion)) + "companion object {" + (string-append + (class-prefix class) + (kotlin-symbol-name (kt-class-name class)) + (class-params-text class) + (class-super-text class) + " {"))) (let ([body (kt-class-body class)]) (unless (null? body) (for-each --- a/lib/jerboa/typed/parser.ss +++ b/lib/jerboa/typed/parser.ss @@ -37,7 +37,8 @@ typed-property? make-typed-property typed-property-mutable? typed-property-name typed-property-type typed-property-init - typed-property-setter typed-property-source + typed-property-setter typed-property-modifiers + typed-property-source typed-property-setter? make-typed-property-setter typed-property-setter-param typed-property-setter-body @@ -84,7 +85,7 @@ (defstruct typed-field (name type mutable? source)) (defstruct typed-record (name fields source)) (defstruct typed-resource (name close source)) - (defstruct typed-property (mutable? name type init setter source)) + (defstruct typed-property (mutable? name type init setter modifiers source)) (defstruct typed-property-setter (param body source)) (defstruct typed-object-decl (name declarations source)) (defstruct typed-class-decl (name params super declarations source)) @@ -559,22 +560,50 @@ (cddr raw-form) source))) + (def (parse-property-extensions extensions context) + (let loop ([rest extensions] [setter #f] [modifiers '()] [seen-setter? #f] [seen-modifiers? #f]) + (cond + [(null? rest) (values setter modifiers)] + [(setter-form? (car rest)) + (when seen-setter? + (error 'parse-typed-property + "duplicate property setter" + context)) + (loop (cdr rest) + (parse-property-setter (car rest)) + modifiers + #t + seen-modifiers?)] + [(modifiers-form? (car rest)) + (when seen-modifiers? + (error 'parse-typed-property + "duplicate property modifiers" + context)) + (loop (cdr rest) + setter + (parse-modifiers-form + (strip-source-annotations (car rest))) + seen-setter? + #t)] + [else + (error 'parse-typed-property + "property extensions must be setter or modifiers forms" + (car rest))]))) + (def (parse-property form) (let* ([source (datum-source form)] [raw-form (datum-value form)] [form (strip-source-annotations form)]) (expect-proper-list 'parse-typed-property form) - (unless (or (= (length form) 5) (= (length form) 6)) + (unless (>= (length form) 4) (error 'parse-typed-property - "expected (val name : Type init), (var name : Type init), or property with setter" + "expected (val name : Type init), (var name : Type init), or property with setter/modifiers" form)) (let ([kind (car form)] [name (cadr form)] [type-marker (caddr form)] [type (cadddr form)] - [init (list-ref raw-form 4)] - [setter (and (= (length form) 6) - (list-ref raw-form 5))]) + [raw-tail (cddddr raw-form)]) (unless (memq kind '(val var)) (error 'parse-typed-property "expected val or var declaration" @@ -583,19 +612,29 @@ (error 'parse-typed-property "expected (val name : Type init) or (var name : Type init)" form)) - (make-typed-property - (eq? kind 'var) - (expect-symbol 'parse-typed-property name form) - (parse-typed-type type) - init - (and setter - (begin - (unless (setter-form? setter) - (error 'parse-typed-property - "property extension must be a setter form" - setter)) - (parse-property-setter setter))) - source)))) + (let* ([first-extension? + (and (pair? raw-tail) + (let ([entry (car raw-tail)]) + (or (setter-form? entry) + (modifiers-form? entry))))] + [init (if (and (pair? raw-tail) + (not first-extension?)) + (car raw-tail) + '__typed_property_no_init)] + [extensions (cond + [(null? raw-tail) '()] + [first-extension? raw-tail] + [else (cdr raw-tail)])]) + (let-values ([(setter modifiers) + (parse-property-extensions extensions form)]) + (make-typed-property + (eq? kind 'var) + (expect-symbol 'parse-typed-property name form) + (parse-typed-type type) + init + setter + modifiers + source)))))) (def (parse-type-decl form) (let ([source (datum-source form)]