Add typed Kotlin mutable list primitives
ober
9fc26e5ec60d40aba00372d70bdb0b2b45c00978
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -1663,6 +1663,110 @@ (list (cons 'inner-type inner-type)))) (append errors type-errors)))))) + (def (mutable-list-inner-type type) + (and (pair? type) + (eq? (car type) 'MutableList) + (cadr type))) + + (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)) + (let* ([type-arg (strip-source-annotations (car args))] + [errors (check-type type-arg type-names)]) + (values + (and (null? errors) + (make-typed-ir-call (list 'MutableList type-arg) + (expr-source expr) 'jvm-mutable-list-empty 'mutable-list-empty + '() + (list (cons 'inner-type type-arg)))) + errors)))) + + (def (infer-mutable-list-add args env type-names expr) + (if (not (= (length args) 2)) + (values #f (bad-constructor-arity expr 'mutable-list-add! 2 args)) + (let-values ([(arg-irs errors) (infer-args args env type-names)]) + (let* ([types (ir-list-types arg-irs)] + [list-type (car types)] + [value-type (cadr types)] + [inner-type (mutable-list-inner-type list-type)] + [type-errors + (append + (if inner-type + '() + (list + (make-check-error + 'argument-type-mismatch + "mutable-list-add! expects a MutableList 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 + "mutable-list-add! value must match the list 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 'Unit (expr-source expr) + 'jvm-mutable-list-add 'mutable-list-add! arg-irs + (list (cons 'inner-type inner-type)))) + (append errors type-errors)))))) + + (def (infer-mutable-list-set args env type-names expr) + (if (not (= (length args) 3)) + (values #f (bad-constructor-arity expr 'mutable-list-set! 3 args)) + (let-values ([(arg-irs errors) (infer-args args env type-names)]) + (let* ([types (ir-list-types arg-irs)] + [list-type (car types)] + [index-type (cadr types)] + [value-type (caddr types)] + [inner-type (mutable-list-inner-type list-type)] + [type-errors + (append + (if inner-type + '() + (list + (make-check-error + 'argument-type-mismatch + "mutable-list-set! expects a MutableList value" + expr + (and (pair? args) (expr-source (car args)))))) + (if (eq? index-type 'Int32) + '() + (list + (make-check-error + 'argument-type-mismatch + "mutable-list-set! index must be Int32" + expr + (and (pair? (cdr args)) + (expr-source (cadr args)))))) + (if (and inner-type value-type + (type-assignable? value-type inner-type)) + '() + (list + (make-check-error + 'argument-type-mismatch + "mutable-list-set! value must match the list element type" + expr + (and (pair? (cddr args)) + (expr-source (caddr args)))))))] + [ok? (and (all-irs-valid? arg-irs) + (null? errors) + (null? type-errors))]) + (values + (and ok? + (make-typed-ir-call 'Unit (expr-source expr) + 'jvm-mutable-list-set 'mutable-list-set! arg-irs + (list (cons 'inner-type inner-type)))) + (append errors type-errors)))))) + (def (infer-make-bytevector args env type-names expr) ;; (make-bytevector size) or (make-bytevector size fill). Size and fill are ;; numeric; the result is a fresh Bytes buffer. A missing fill defaults to a @@ -2163,6 +2267,12 @@ (infer-list-size args env type-names expr)] [(list-ref) (infer-list-ref args env type-names expr)] + [(mutable-list-empty) + (infer-mutable-list-empty args env type-names expr)] + [(mutable-list-add!) + (infer-mutable-list-add args env type-names expr)] + [(mutable-list-set!) + (infer-mutable-list-set args env type-names expr)] [(bytes-build) (infer-bytes-build args env type-names expr)] [(option-some) --- a/lib/jerboa/typed/core.ss +++ b/lib/jerboa/typed/core.ss @@ -133,6 +133,9 @@ debug-string jvm-list-size jvm-list-ref + jvm-mutable-list-empty + jvm-mutable-list-add + jvm-mutable-list-set record-ctor record-pred record-accessor --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -322,6 +322,24 @@ (make-kt-member-get (car args) 'size)] [(jvm-list-ref) (make-kt-index-get (car args) (cadr args))] + [(jvm-mutable-list-empty) + (make-kt-new + (make-kt-type 'ArrayList #f + (list (typed-type->kotlin-type + (info-ref info 'inner-type 'Any)))) + '())] + [(jvm-mutable-list-add) + (make-kt-block + (list + (make-kt-expr-stmt + (make-kt-member-call (car args) 'add (list (cadr args))))) + (make-kt-lit 'Unit '()))] + [(jvm-mutable-list-set) + (make-kt-block + (list + (make-kt-assign (make-kt-index-get (car args) (cadr args)) + (caddr args))) + (make-kt-lit 'Unit '()))] [(jvm-boolean-array-ref) (make-kt-index-get (car args) (cadr args))] [(jvm-boolean-array-set) --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -547,7 +547,8 @@ (define list-form '(typed-library (sample typed lists) - (export make-Cell Cell? Cell-x listCount firstX secondName) + (export make-Cell Cell? Cell-x listCount firstX secondName + emptyCells appendCell replaceCell) (type Int32) (type Float32) (record Cell @@ -558,7 +559,13 @@ (def (firstX (cells : (MutableList Cell))) : Float32 (Cell-x (list-ref cells (int32 0)))) (def (secondName (cells : (List Cell))) : String - (Cell-name (list-ref cells (int32 1)))))) + (Cell-name (list-ref cells (int32 1)))) + (def (emptyCells) : (MutableList Cell) + (mutable-list-empty Cell)) + (def (appendCell (cells : (MutableList Cell)) (cell : Cell)) : Unit + (mutable-list-add! cells cell)) + (def (replaceCell (cells : (MutableList Cell)) (cell : Cell)) : Unit + (mutable-list-set! cells (int32 0) cell)))) (define list-kotlin (typed-library-form->kotlin-string list-form)) @@ -574,6 +581,15 @@ (test-contains "List ref preserves element type" list-kotlin "return cells[1].name") +(test-contains "MutableList empty lowers to typed ArrayList" + list-kotlin + "return ArrayList<Cell>()") +(test-contains "MutableList add lowers to Kotlin add" + list-kotlin + "cells.add(cell)") +(test-contains "MutableList set lowers to indexed assignment" + list-kotlin + "cells[0] = cell") (define fold-form '(typed-library (sample typed fold)