Add typed Kotlin extern calls
ober
cc6296db7b1aeb92748c4a2bd78432e220197b0c
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -301,6 +301,7 @@ (def (declaration-value-names decl) (cond [(typed-def? decl) (list (typed-def-name decl))] + [(typed-extern? decl) (list (typed-extern-name decl))] [(typed-record? decl) (record-value-names decl)] [(typed-variant? decl) (variant-value-names decl)] [(typed-resource? decl) '()] @@ -362,6 +363,16 @@ 'function '())))) + (def (extern-signature decl) + (and (typed-extern? decl) + (cons (typed-extern-name decl) + (make-typed-call-sig + (map typed-param-type (typed-extern-params decl)) + (typed-extern-return-type decl) + '() + 'kotlin-call + (list (cons 'path (typed-extern-kotlin-path decl))))))) + (def builtin-call-signatures (list (cons 'string-length @@ -672,6 +683,7 @@ (def (declaration-call-signatures decl) (cond [(typed-def? decl) (list (function-signature decl))] + [(typed-extern? decl) (list (extern-signature decl))] [(typed-record? decl) (record-call-signatures decl)] [(typed-variant? decl) (variant-call-signatures decl)] [else '()])) @@ -771,6 +783,16 @@ (check-type (typed-def-return-type def) type-names) (check-def-body def type-names))) + (def (check-extern decl type-names) + (append + (duplicate-errors 'duplicate-param + "duplicate parameter name" + (map typed-param-name (typed-extern-params decl))) + (append-map + (lambda (param) (check-type (typed-param-type param) type-names)) + (typed-extern-params decl)) + (check-type (typed-extern-return-type decl) type-names))) + (def (infer-body exprs env type-names . src*) (let ([src (if (pair? src*) (car src*) #f)]) (cond @@ -2730,6 +2752,7 @@ (cond [(typed-record? decl) (check-record decl type-names)] [(typed-variant? decl) (check-variant decl type-names)] + [(typed-extern? decl) (check-extern decl type-names)] [(typed-def? decl) (check-def decl type-names)] [else '()])) @@ -2789,6 +2812,10 @@ (memq (typed-def-name d) (typed-module-exports imported-module))) (list (function-signature d))] + [(and (typed-extern? d) + (memq (typed-extern-name d) + (typed-module-exports imported-module))) + (list (extern-signature d))] [(typed-record? d) (record-call-signatures d)] [(typed-variant? d) (variant-call-signatures d)] [else '()])) --- a/lib/jerboa/typed/core.ss +++ b/lib/jerboa/typed/core.ss @@ -131,6 +131,7 @@ exact->inexact log2 debug-string + kotlin-call jvm-pair jvm-list-size jvm-list-ref --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -555,6 +555,8 @@ (make-kt-member-get (car args) 'size) 'toULong '())] + [(kotlin-call) + (make-kt-call (make-kt-name (info-ref info 'path (list operator))) args)] [(record-ctor) (make-kt-new (make-kt-type (info-ref info 'record operator) #f '()) --- a/lib/jerboa/typed/parser.ss +++ b/lib/jerboa/typed/parser.ss @@ -34,6 +34,10 @@ typed-resource? make-typed-resource typed-resource-name typed-resource-close typed-resource-source + typed-extern? make-typed-extern + typed-extern-name typed-extern-params typed-extern-return-type + typed-extern-kotlin-path typed-extern-source + typed-variant? make-typed-variant typed-variant-name typed-variant-cases typed-variant-source @@ -57,6 +61,7 @@ (defstruct typed-field (name type mutable? source)) (defstruct typed-record (name fields source)) (defstruct typed-resource (name close source)) + (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)) @@ -419,6 +424,38 @@ parsed-body source)))))) + (def (parse-kotlin-call-target form) + (let ([form (strip-source-annotations form)]) + (expect-proper-list 'parse-typed-extern form) + (unless (and (>= (length form) 2) + (eq? (car form) 'kotlin-call) + (symbol-list? (cdr form))) + (error 'parse-typed-extern + "expected (kotlin-call PackageOrObject function)" + form)) + (cdr form))) + + (def (parse-extern form) + (let* ([source (datum-source form)] + [raw-form (datum-value form)] + [form (strip-source-annotations form)]) + (expect-length 'parse-typed-extern form 5) + (let ([head (cadr raw-form)] + [return-marker (caddr form)] + [return-type (cadddr form)] + [target (list-ref raw-form 4)]) + (unless (memq return-marker '(: ->)) + (error 'parse-typed-extern + "expected : or -> before return type" + form)) + (let-values ([(name params) (parse-def-head head)]) + (make-typed-extern + name + params + (parse-typed-type return-type) + (parse-kotlin-call-target target) + source))))) + (def (parse-type-decl form) (let ([source (datum-source form)] [form (strip-source-annotations form)]) @@ -437,6 +474,7 @@ [(record) (parse-record form)] [(resource) (parse-resource form)] [(variant) (parse-variant form)] + [(extern) (parse-extern form)] [(def) (parse-def form)] [else (error 'parse-typed-declaration --- a/tests/test-typed-checker.ss +++ b/tests/test-typed-checker.ss @@ -469,6 +469,31 @@ (g x)))) '(return-type-mismatch)) +(test "extern kotlin call can be used from typed code" + (error-kinds + '(typed-library (body extern-ok) + (export find) + (type Context) + (type BoxType) + (extern (boxTypesResolve (context : Context) (raw : String)) : (Nullable BoxType) + (kotlin-call BoxTypes resolve)) + (def (find (context : Context) (raw : String)) : (Nullable BoxType) + (boxTypesResolve context raw)))) + '()) + +(test "extern kotlin call checks argument types" + (error-kinds + '(typed-library (body extern-arg) + (export find) + (type Context) + (type BoxType) + (type Int32) + (extern (boxTypesResolve (context : Context) (raw : String)) : (Nullable BoxType) + (kotlin-call BoxTypes resolve)) + (def (find (context : Context) (raw : Int32)) : (Nullable BoxType) + (boxTypesResolve context raw)))) + '(argument-type-mismatch)) + (test "effect annotation accepted" (error-kinds '(typed-library (effects accepted) --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -255,6 +255,22 @@ nullable-access-kotlin "(value!!)") +(define extern-form + '(typed-library (sample typed extern) + (export find) + (type Context) + (type BoxType) + (extern (boxTypesResolve (context : Context) (raw : String)) : (Nullable BoxType) + (kotlin-call BoxTypes resolve)) + (def (find (context : Context) (raw : String)) : (Nullable BoxType) + (boxTypesResolve context raw)))) + +(define extern-kotlin (typed-library-form->kotlin-string extern-form)) + +(test-contains "extern Kotlin call lowers to declared callee" + extern-kotlin + "return BoxTypes.resolve(context, raw)") + (define geometry-form '(typed-library (sample typed geometry) (export make-SsdCell SsdCell? SsdCell-x SsdCell-y SsdCell-w SsdCell-h