Lower typed JVM boolean array builders
ober
f7d301f2262ba655b75774fb3f0b966e74d559ad
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -1557,6 +1557,48 @@ (list (cons 'index idx-name)))) (append size-errors body-errors type-errors)))))])) + (def (infer-boolean-array-build args env type-names expr) + ;; (boolean-array-build size (idx body)): a fresh JVM BooleanArray of + ;; length size whose idx-th element is body. + (cond + [(not (= (length args) 2)) + (values #f + (list (error-at expr 'bad-boolean-array-build + "boolean-array-build expects a size and an (index body) clause" + expr)))] + [(not (and (expr-list? (cadr args)) + (= (expr-length (cadr args)) 2) + (expr-symbol? (expr-car (cadr args))))) + (values #f + (list (error-at expr 'bad-boolean-array-build + "boolean-array-build clause must be (index body)" + expr)))] + [else + (let ([size-expr (car args)] + [idx-name (expr-value (expr-car (cadr args)))] + [body-expr (expr-cadr (cadr args))]) + (let*-values + ([(size-ir size-errors) (infer-expression size-expr env type-names)] + [(body-ir body-errors) + (infer-expression body-expr + (extend-env idx-name 'Int32 env) type-names)]) + (let* ([type-errors + (argument-type-errors + 'boolean-array-build + (list 'Int32 'Bool) + (list (ir-type size-ir) (ir-type body-ir)) + (list size-expr body-expr))] + [ok? (and size-ir body-ir + (null? size-errors) (null? body-errors) + (null? type-errors))]) + (values + (and ok? + (make-typed-ir-call 'BooleanArray (expr-source expr) + 'jvm-boolean-array-build 'boolean-array-build + (list size-ir body-ir) + (list (cons 'index idx-name)))) + (append size-errors body-errors type-errors)))))])) + (def (list-like-inner-type type) (and (pair? type) (memq (car type) '(List Vector MutableList)) @@ -2115,6 +2157,8 @@ (infer-float-array args env type-names expr)] [(int-array-build) (infer-int-array-build args env type-names expr)] + [(boolean-array-build) + (infer-boolean-array-build args env type-names expr)] [(list-size) (infer-list-size args env type-names expr)] [(list-ref) --- a/lib/jerboa/typed/kotlin/lower.ss +++ b/lib/jerboa/typed/kotlin/lower.ss @@ -323,6 +323,14 @@ (list (make-kt-assign (make-kt-index-get (car args) (cadr args)) (caddr args))) (make-kt-lit 'Unit '()))] + [(jvm-boolean-array-build) + (make-kt-call + (kt-name1 'BooleanArray) + (list + (car args) + (make-kt-lambda + (list (info-ref info 'index 'index)) + (cadr args))))] [(jvm-boolean-array-length) (make-kt-member-get (car args) 'size)] [(bytevector-length) --- a/tests/test-typed-kotlin.ss +++ b/tests/test-typed-kotlin.ss @@ -502,6 +502,24 @@ int-array-build-kotlin "IntArray(items.size, { index -> (items[index] + 1) })") +(define boolean-array-build-form + '(typed-library (sample typed booleanarraybuild) + (export highMask) + (type Int32) + (type IntArray) + (type BooleanArray) + (def (highMask (items : IntArray) (threshold : Int32)) : BooleanArray + (boolean-array-build + (int-array-length items) + (index (>= (int-array-ref items index) threshold)))))) + +(define boolean-array-build-kotlin + (typed-library-form->kotlin-string boolean-array-build-form)) + +(test-contains "BooleanArray build lowers to Kotlin BooleanArray constructor" + boolean-array-build-kotlin + "BooleanArray(items.size, { index -> (items[index] >= threshold) })") + (define list-form '(typed-library (sample typed lists) (export make-Cell Cell? Cell-x listCount firstX secondName)