Support typed Kotlin parameter modifiers
ober
c0f2d60605a5153c1f82a08940234be86526f778
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -1485,7 +1485,7 @@ (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 source)) + (make-typed-param (car v) type #f #f #f '() source)) type-errors))] [else (values #f --- a/lib/jerboa/typed/kotlin/ast.ss +++ b/lib/jerboa/typed/kotlin/ast.ss @@ -20,6 +20,7 @@ kt-param? make-kt-param kt-param-name kt-param-type kt-param-default kt-param-property kt-param-mutable? kt-param-visibility + kt-param-modifiers kt-class? make-kt-class kt-class-kind kt-class-visibility kt-class-name @@ -135,7 +136,7 @@ ;; Function/constructor parameters. When `property` is 'val or 'var, the ;; printer emits the parameter as a Kotlin primary-constructor property. - (defstruct kt-param (name type default property mutable? visibility)) + (defstruct kt-param (name type default property mutable? visibility modifiers)) ;; Declarations. `kind` is one of: class, data-class, sealed-class, object, ;; data-object, interface, enum. --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -950,7 +950,8 @@ #f 'val (typed-field-mutable? field) - #f)) + #f + '())) (def (lower-record record) (make-kt-class @@ -999,9 +1000,10 @@ (typed-param-name param) (typed-type->kotlin-type (typed-param-type param)) #f - #f - #f - #f)) + (typed-param-property param) + (typed-param-mutable? param) + (typed-param-visibility param) + (typed-param-modifiers param))) (def (lower-enum-param param) (make-kt-param @@ -1010,7 +1012,8 @@ #f 'val #f - #f)) + #f + '())) (def (lower-def def) (let ([ir (lookup-kotlin-ir (typed-def-name def))]) --- a/lib/jerboa/typed/kotlin/print.ss +++ b/lib/jerboa/typed/kotlin/print.ss @@ -182,7 +182,7 @@ (def (visibility-prefix visibility) (if visibility - (string-append (kotlin-symbol-name visibility) " ") + (string-append (kotlin-modifier->string visibility) " ") "")) (def (annotation-lines annotations) @@ -220,6 +220,7 @@ (def (kotlin-param->string param) (string-append (visibility-prefix (kt-param-visibility param)) + (modifier-prefix (kt-param-modifiers param)) (cond [(kt-param-property param) (string-append (if (kt-param-mutable? param) "var " "val "))] --- a/lib/jerboa/typed/parser.ss +++ b/lib/jerboa/typed/parser.ss @@ -77,7 +77,9 @@ typed-variant-case-source typed-param? make-typed-param - typed-param-name typed-param-type typed-param-source + typed-param-name typed-param-type typed-param-property + typed-param-mutable? typed-param-visibility typed-param-modifiers + typed-param-source typed-def? make-typed-def typed-def-name typed-def-params typed-def-return-type @@ -103,7 +105,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 source)) + (defstruct typed-param (name type property mutable? visibility modifiers source)) (defstruct typed-def (name params return-type effects modifiers kotlin-name body source)) (def (strip-source-annotations datum) @@ -310,18 +312,106 @@ "expected (name : Type) or (mut name : Type)" form)]))) + (def (param-option-form? form head) + (let ([form (strip-source-annotations form)]) + (and (pair? form) (eq? (car form) head)))) + + (def (parse-param-property form) + (let ([form (strip-source-annotations form)]) + (unless (and (= (length form) 2) + (eq? (car form) 'property) + (memq (cadr form) '(val var))) + (error 'parse-typed-param + "expected (property val) or (property var)" + form)) + (cadr form))) + + (def (parse-param-visibility form) + (let ([form (strip-source-annotations form)]) + (unless (and (= (length form) 2) + (eq? (car form) 'visibility) + (symbol? (cadr form))) + (error 'parse-typed-param + "expected (visibility modifier)" + form)) + (cadr form))) + + (def (parse-param-modifiers form) + (let ([form (strip-source-annotations form)]) + (unless (and (pair? form) + (eq? (car form) 'modifiers) + (symbol-list? (cdr form))) + (error 'parse-typed-param + "expected (modifiers symbol ...)" + form)) + (cdr form))) + + (def (parse-param-options options) + (let loop ([rest options] + [property #f] + [visibility #f] + [modifiers '()] + [seen-property? #f] + [seen-visibility? #f] + [seen-modifiers? #f]) + (cond + [(null? rest) + (values property + (eq? property 'var) + visibility + modifiers)] + [(param-option-form? (car rest) 'property) + (when seen-property? + (error 'parse-typed-param "duplicate property option" options)) + (loop (cdr rest) + (parse-param-property (car rest)) + visibility + modifiers + #t + seen-visibility? + seen-modifiers?)] + [(param-option-form? (car rest) 'visibility) + (when seen-visibility? + (error 'parse-typed-param "duplicate visibility option" options)) + (loop (cdr rest) + property + (parse-param-visibility (car rest)) + modifiers + seen-property? + #t + seen-modifiers?)] + [(param-option-form? (car rest) 'modifiers) + (when seen-modifiers? + (error 'parse-typed-param "duplicate modifiers option" options)) + (loop (cdr rest) + property + visibility + (parse-param-modifiers (car rest)) + seen-property? + seen-visibility? + #t)] + [else + (error 'parse-typed-param + "parameter options must be property, visibility, or modifiers forms" + (car rest))]))) + (def (parse-param form) (let ([source (datum-source form)] [form (strip-source-annotations form)]) - (expect-length 'parse-typed-param form 3) - (unless (eq? (cadr form) ':) + (unless (and (>= (length form) 3) (eq? (cadr form) ':)) (error 'parse-typed-param - "expected (name : Type)" + "expected (name : Type option ...)" form)) - (make-typed-param - (expect-symbol 'parse-typed-param (car form) form) - (parse-typed-type (caddr form)) - source))) + (let-values ([(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)) + property + mutable? + visibility + modifiers + source)))) (def (parse-record form) (let* ([source (datum-source form)] --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -86,7 +86,7 @@ #f '() 'add-one - (list (make-kt-param 'x (make-kt-type 'ULong #f '()) #f #f #f #f)) + (list (make-kt-param 'x (make-kt-type 'ULong #f '()) #f #f #f #f '())) (make-kt-type 'ULong #f '()) (list (make-kt-return @@ -107,7 +107,7 @@ (list (make-kt-param 's (make-kt-type 'Editable #t '()) - #f #f #f #f)) + #f #f #f #f '())) (make-kt-type 'Unit #f '()) (list (make-kt-expr-stmt (make-kt-lit 'Unit '()))) '())))) @@ -1568,6 +1568,16 @@ (PRIMARY (int32 1) (int32 2) (float32 18.0) (int32 56)) (NEUTRAL (int32 3) (int32 4) (float32 15.0) (int32 48))))) +(define param-options-form + '(typed-library (sample typed paramoptions) + (export Store row) + (type Context) + (type Button) + (class Store ((context : Context (property val) (visibility private))) + (def (ready) : Bool #t)) + (def (row (buttons : Button (modifiers vararg))) : Unit + (begin)))) + (define return-form '(typed-library (sample typed returns) (export guarded) @@ -1601,6 +1611,9 @@ (define enum-kotlin (typed-library-form->kotlin-string enum-form)) +(define param-options-kotlin + (typed-library-form->kotlin-string param-options-form)) + (test-contains "typed class declaration lowers constructor and superclass" class-declaration-kotlin "class ReviewView(context: Context) : View(context) {") @@ -1631,6 +1644,12 @@ (test-contains "typed enum declaration lowers enum entries" enum-kotlin "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)") +(test-contains "typed function parameter lowers vararg modifier" + param-options-kotlin + "fun row(vararg buttons: Button): Unit") (test-contains "typed def kotlin-name lowers emitted method name" kotlin-name-kotlin "override fun read(): Int")