Add typed Kotlin JSON reader helpers
ober
d45025fb556b3b4a2a65a9bc5c31720f1dbfef2a
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -494,6 +494,9 @@ (cons 'json-array-put-json-object! (make-typed-call-sig (list 'JSONArray 'JSONObject) 'Unit '() 'jvm-json-array-put-json-object '())) + (cons 'json-array-get-json-object + (make-typed-call-sig (list 'JSONArray 'Int32) 'JSONObject '() + 'jvm-json-array-get-json-object '())) (cons 'json-array-length (make-typed-call-sig (list 'JSONArray) 'Int32 '() 'jvm-json-array-length '())) @@ -524,6 +527,12 @@ (cons 'json-object-opt-float32 (make-typed-call-sig (list 'JSONObject 'String) 'Float32 '() 'jvm-json-object-opt-float32 '())) + (cons 'json-object-opt-int32-default + (make-typed-call-sig (list 'JSONObject 'String 'Int32) 'Int32 '() + 'jvm-json-object-opt-int32-default '())) + (cons 'json-object-opt-json-array + (make-typed-call-sig (list 'JSONObject 'String) (list 'Nullable 'JSONArray) '() + 'jvm-json-object-opt-json-array '())) ;; crypto primitives — FFI to vetted RustCrypto crates, never reimplemented. ;; Each carries kind 'crypto-prim and an info `prim` the emitter dispatches ;; on; the Rust block they emit references the crate (sha2/hmac/hkdf) that @@ -1767,6 +1776,25 @@ (cons 'value-type value-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)) + (let-values ([(arg-irs errors) (infer-args args env type-names)]) + (let* ([types (ir-list-types arg-irs)] + [left-type (car types)] + [right-type (cadr types)] + [ok? (and (all-irs-valid? arg-irs) + (null? errors) + left-type + right-type)]) + (values + (and ok? + (make-typed-ir-call (list 'Pair left-type right-type) + (expr-source expr) 'jvm-pair 'pair arg-irs + (list (cons 'left-type left-type) + (cons 'right-type right-type)))) + errors))))) + (def (infer-mutable-list-empty args env type-names expr) (if (not (= (length args) 1)) (values #f (bad-constructor-arity expr 'mutable-list-empty 1 args)) @@ -2407,6 +2435,8 @@ (infer-list-ref args env type-names expr)] [(map-ref-or-null) (infer-map-ref-or-null args env type-names expr)] + [(pair) + (infer-pair args env type-names expr)] [(mutable-list-empty) (infer-mutable-list-empty args env type-names expr)] [(mutable-list-add!) --- a/lib/jerboa/typed/core.ss +++ b/lib/jerboa/typed/core.ss @@ -131,6 +131,7 @@ exact->inexact log2 debug-string + jvm-pair jvm-list-size jvm-list-ref jvm-map-ref-or-null @@ -143,6 +144,7 @@ jvm-json-array-put-int32 jvm-json-array-put-string jvm-json-array-put-json-object + jvm-json-array-get-json-object jvm-json-array-length jvm-json-array-opt-float32 jvm-json-object-empty @@ -153,6 +155,8 @@ jvm-json-object-opt-string jvm-json-object-opt-string-default jvm-json-object-opt-float32 + jvm-json-object-opt-int32-default + jvm-json-object-opt-json-array record-ctor record-pred record-accessor --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -243,6 +243,8 @@ (make-kt-member-call (car args) 'toLong '()))] [(jvm-to-string) (make-kt-member-call (car args) 'toString '())] + [(jvm-pair) + (make-kt-call (kt-name1 'Pair) args)] [(jvm-float32-abs) (make-kt-call (make-kt-name '(kotlin math abs)) args)] [(jvm-float32-round-to-int32) @@ -395,6 +397,8 @@ 'put (list (cadr args))))) (make-kt-lit 'Unit '()))] + [(jvm-json-array-get-json-object) + (make-kt-member-call (car args) 'getJSONObject (cdr args))] [(jvm-json-array-length) (make-kt-member-call (car args) 'length '())] [(jvm-json-array-opt-float32) @@ -456,6 +460,10 @@ (make-kt-member-call (car args) 'optDouble (cdr args)) 'toFloat '())] + [(jvm-json-object-opt-int32-default) + (make-kt-member-call (car args) 'optInt (cdr args))] + [(jvm-json-object-opt-json-array) + (make-kt-member-call (car args) 'optJSONArray (cdr args))] [(jvm-boolean-array-ref) (make-kt-index-get (car args) (cadr args))] [(jvm-boolean-array-set) --- a/tests/test-typed-checker.ss +++ b/tests/test-typed-checker.ss @@ -996,6 +996,28 @@ (json-array-put-json-object! items json))))) '()) +(test "json-object and array readers accept JSON types" + (error-kinds + '(typed-library (body json-readers) + (export read-values) + (type JSONObject) + (type JSONArray) + (type Int32) + (def (read-values (json : JSONObject) (items : JSONArray)) : (Pair JSONObject (Nullable JSONArray)) + (pair + (json-array-get-json-object items (json-object-opt-int32-default json "index" (int32 0))) + (json-object-opt-json-array json "items"))))) + '()) + +(test "pair constructor returns pair of operand types" + (error-kinds + '(typed-library (body pair-ok) + (export make-pair) + (type Int32) + (def (make-pair (name : String) (count : Int32)) : (Pair String Int32) + (pair name count)))) + '()) + (test "variant constructor and predicate calls" (error-kinds '(typed-library (body variant-ok) --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -612,6 +612,19 @@ map-kotlin "return cells[name]") +(define pair-form + '(typed-library (sample typed pairs) + (export makeNameCount) + (type Int32) + (def (makeNameCount (name : String) (count : Int32)) : (Pair String Int32) + (pair name count)))) + +(define pair-kotlin (typed-library-form->kotlin-string pair-form)) + +(test-contains "Pair constructor lowers to Kotlin Pair call" + pair-kotlin + "return Pair(name, count)") + (define json-array-form '(typed-library (sample typed json-array) (export makeNumbers firstNumber) @@ -663,6 +676,16 @@ (def (putObject (items : JSONArray) (json : JSONObject)) : Unit (json-array-put-json-object! items json)))) "items.put(json)") +(test-contains "JSONArray get JSONObject lowers to getJSONObject" + (typed-library-form->kotlin-string + '(typed-library (sample typed json-array-get-object) + (export getObject) + (type JSONArray) + (type JSONObject) + (type Int32) + (def (getObject (items : JSONArray) (index : Int32)) : JSONObject + (json-array-get-json-object items index)))) + "items.getJSONObject(index)") (test-contains "JSONArray length lowers to method call" json-array-kotlin "items.length()") @@ -672,7 +695,7 @@ (define json-object-form '(typed-library (sample typed json-object) - (export makeCell readX readName readNameDefault) + (export makeCell readX readCount readItems readName readNameDefault) (type JSONObject) (type JSONArray) (type Float32) @@ -689,6 +712,10 @@ json)))) (def (readX (json : JSONObject)) : Float32 (json-object-opt-float32 json "x")) + (def (readCount (json : JSONObject)) : Int32 + (json-object-opt-int32-default json "count" (int32 1))) + (def (readItems (json : JSONObject)) : (Nullable JSONArray) + (json-object-opt-json-array json "items")) (def (readName (json : JSONObject)) : String (json-object-opt-string json "name")) (def (readNameDefault (json : JSONObject)) : String @@ -714,6 +741,12 @@ (test-contains "JSONObject opt Float32 lowers through optDouble" json-object-kotlin "json.optDouble(\"x\").toFloat()") +(test-contains "JSONObject opt Int32 default lowers to optInt" + json-object-kotlin + "json.optInt(\"count\", 1)") +(test-contains "JSONObject opt JSONArray lowers to nullable optJSONArray" + json-object-kotlin + "json.optJSONArray(\"items\")") (test-contains "JSONObject opt String lowers to optString" json-object-kotlin "json.optString(\"name\")")