Add typed Kotlin Set contains
ober
253dcd751a9c13924439692762f260134064053e
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -51,6 +51,7 @@ (Vector . 1) (MutableList . 1) (Map . 2) + (Set . 1) (Nullable . 1) (Option . 1) (Result . 2) @@ -93,7 +94,7 @@ [(unknown-type) "Define the type in this typed-library, import it later when imports exist, or use a builtin type name."] [(unknown-type-constructor) - "Use a supported compound type constructor: List, Vector, MutableList, Map, Nullable, Option, Result, Pair, Owned, Borrow, MutBorrow, or ->."] + "Use a supported compound type constructor: List, Vector, MutableList, Map, Set, Nullable, Option, Result, Pair, Owned, Borrow, MutBorrow, or ->."] [(bad-type-arity) "Check the number of type arguments for the compound type."] [(duplicate-type duplicate-value duplicate-field duplicate-param @@ -1764,6 +1765,11 @@ (eq? (car type) 'Map) (cons (cadr type) (caddr type)))) + (def (set-inner-type type) + (and (pair? type) + (eq? (car type) 'Set) + (cadr type))) + (def (infer-map-ref-or-null args env type-names expr) (if (not (= (length args) 2)) (values #f (bad-constructor-arity expr 'map-ref-or-null 2 args)) @@ -1806,6 +1812,45 @@ (cons 'value-type value-type)))) (append errors type-errors)))))) + (def (infer-set-contains args env type-names expr) + (if (not (= (length args) 2)) + (values #f (bad-constructor-arity expr 'set-contains? 2 args)) + (let-values ([(arg-irs errors) (infer-args args env type-names)]) + (let* ([types (ir-list-types arg-irs)] + [set-type (car types)] + [value-type (cadr types)] + [inner-type (set-inner-type set-type)] + [type-errors + (append + (if inner-type + '() + (list + (make-check-error + 'argument-type-mismatch + "set-contains? expects a Set value" + expr + (and (pair? args) (expr-source (car args)))))) + (if (and inner-type value-type + (type-assignable? value-type inner-type)) + '() + (list + (make-check-error + 'argument-type-mismatch + "set-contains? value must match the set element type" + expr + (and (pair? (cdr args)) + (expr-source (cadr args)))))))] + [ok? (and (all-irs-valid? arg-irs) + (null? errors) + (null? type-errors))]) + (values + (and ok? + (make-typed-ir-call 'Bool + (expr-source expr) 'jvm-set-contains 'set-contains? + arg-irs + (list (cons 'inner-type inner-type)))) + (append errors type-errors)))))) + (def (infer-pair args env type-names expr) (if (not (= (length args) 2)) (values #f (bad-constructor-arity expr 'pair 2 args)) @@ -2462,9 +2507,11 @@ [(list-size) (infer-list-size args env type-names expr)] [(list-ref) - (infer-list-ref args env type-names expr)] + (infer-list-ref args env type-names expr)] [(map-ref-or-null) (infer-map-ref-or-null args env type-names expr)] + [(set-contains?) + (infer-set-contains args env type-names expr)] [(pair) (infer-pair args env type-names expr)] [(mutable-list-empty) --- a/lib/jerboa/typed/core.ss +++ b/lib/jerboa/typed/core.ss @@ -135,6 +135,7 @@ jvm-list-size jvm-list-ref jvm-map-ref-or-null + jvm-set-contains jvm-mutable-list-empty jvm-mutable-list-add jvm-mutable-list-remove --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -105,6 +105,8 @@ (make-kt-type 'Map #f (list (typed-type->kotlin-type (cadr type)) (typed-type->kotlin-type (caddr type))))] + [(and (pair? type) (eq? (car type) 'Set)) + (make-kt-type 'Set #f (list (typed-type->kotlin-type (cadr type))))] [(and (pair? type) (eq? (car type) 'Nullable)) (let ([inner (typed-type->kotlin-type (cadr type))]) (make-kt-type (kt-type-name inner) #t (kt-type-args inner)))] @@ -350,6 +352,8 @@ (make-kt-index-get (car args) (cadr args))] [(jvm-map-ref-or-null) (make-kt-index-get (car args) (cadr args))] + [(jvm-set-contains) + (make-kt-member-call (car args) 'contains (cdr args))] [(jvm-mutable-list-empty) (make-kt-new (make-kt-type 'ArrayList #f --- a/tests/test-typed-checker.ss +++ b/tests/test-typed-checker.ss @@ -997,6 +997,23 @@ (map-ref-or-null cells id)))) '(argument-type-mismatch)) +(test "set-contains accepts matching element" + (error-kinds + '(typed-library (body set-contains-ok) + (export seen?) + (def (seen? (ids : (Set String)) (id : String)) : Bool + (set-contains? ids id)))) + '()) + +(test "set-contains rejects wrong element type" + (error-kinds + '(typed-library (body set-contains-wrong-element) + (export seen?) + (type Int32) + (def (seen? (ids : (Set String)) (id : Int32)) : Bool + (set-contains? ids id)))) + '(argument-type-mismatch)) + (test "json-array accepts string and object puts" (error-kinds '(typed-library (body json-array-more) --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -632,6 +632,21 @@ map-kotlin "return cells[name]") +(define set-form + '(typed-library (sample typed set) + (export seen?) + (def (seen? (ids : (Set String)) (id : String)) : Bool + (set-contains? ids id)))) + +(define set-kotlin (typed-library-form->kotlin-string set-form)) + +(test-contains "Set type lowers to Kotlin generics" + set-kotlin + "fun seen_p(ids: Set<String>, id: String): Boolean") +(test-contains "Set contains lowers to Kotlin contains" + set-kotlin + "return ids.contains(id)") + (define pair-form '(typed-library (sample typed pairs) (export makeNameCount)