Lower Typed Jerboa debug strings
ober
e9f9a9adc365fcdf46e4014d29f1b93307bd7e9a
--- a/docs/jerboa-to-rust.md +++ b/docs/jerboa-to-rust.md @@ -629,6 +629,8 @@ Second module: typed `rope`. `bytevector-length` support landed as checked `(String -> Nat)` and `(Bytes -> Nat)` builtins. Same-type `equal?` now checks as `Bool` and lowers to Rust `==`, including for generated records and variants. + `debug-string` now lowers to Rust Debug formatting and returns a typed + `String`. - Generate wrappers. Initial scalar `.ss` wrappers plus `String` and `Bytes` argument wrappers landed. Same-module record and variant values now cross the wrapper boundary as opaque handles. `String` and `Bytes` returns now cross @@ -651,8 +653,8 @@ Second module: typed `rope`. boundaries as opaque handles. - Box self-recursive variant fields in generated Rust and rebind recursive match children as owned typed values for branch bodies. -- Support equality and debug output. Same-type `equal?` has landed; richer - debug/string rendering remains future work. +- Support equality and debug output. Same-type `equal?` and `debug-string` + have landed; richer custom string rendering remains future work. ### Milestone 4: First Real Module --- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -207,9 +207,11 @@ Current landing: `string-length`, is checked as `(String -> Nat)` and lowers to Rust `.len()`; `string-append` is checked as a two-argument `(String String -> String)` builtin and lowers to Rust `format!`; `bytevector-length` is checked - as `(Bytes -> Nat)` and lowers the same way. Imported calls and richer forms - are reported as unsupported. It does not yet resolve imports, lower to typed - core IR, or emit LLVM. + as `(Bytes -> Nat)` and lowers the same way. `debug-string` checks one typed + operand and lowers to Rust `format!("{:?}", ...)`, using the Debug derives on + generated records and variants. Imported calls and richer forms are reported + as unsupported. It does not yet resolve imports, lower to typed core IR, or + emit LLVM. - `Option` and `Result` type expressions now have explicit checked constructors in the front end: `(option-some expr)`, `(option-none Type)`, `(result-ok expr ErrorType)`, and `(result-err ValueType expr)`. Rust @@ -869,7 +871,8 @@ Minimum excluded features: landed, along with lowering for same-module record/variant operations and exhaustive variant `match`. Same-type `equal?` now checks as `Bool` and lowers to Rust `==`, including for generated records and variants that derive - `PartialEq`. + `PartialEq`. `debug-string` now lowers to Rust Debug formatting and returns a + typed `String`. - Generate a Cargo crate. Initial `make typed-rust` / `make typed-build` targets landed for a primitive typed fixture. - Compile generated Rust as a static or dynamic library. Initial disposable --- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -874,6 +874,16 @@ "equal? operands must have the same type" expr))))))))) + (def (infer-debug-string args env type-names expr) + (if (not (= (length args) 1)) + (values #f + (list (make-check-error 'bad-primitive-arity + "debug-string needs exactly one operand" + expr))) + (let-values ([(type errors) (infer-expression (car args) env type-names)]) + (values (and type (null? errors) 'String) + errors)))) + (def (infer-boolean op args env type-names expr) (cond [(and (eq? op 'not) (not (= (length args) 1))) @@ -1154,6 +1164,8 @@ (infer-comparison (car expr) (cdr expr) env type-names expr)] [(equal?) (infer-equality (cdr expr) env type-names expr)] + [(debug-string) + (infer-debug-string (cdr expr) env type-names expr)] [(not and or) (infer-boolean (car expr) (cdr expr) env type-names expr)] [(option-some) --- a/lib/jerboa/typed/rust.ss +++ b/lib/jerboa/typed/rust.ss @@ -930,6 +930,14 @@ (emit-expression (cadr args)) ")")) + (def (emit-debug-string args) + (unless (= (length args) 1) + (error 'typed-rust "debug-string expects one operand" args)) + (string-append + "format!(\"{:?}\", " + (emit-expression (car args)) + ")")) + (def (emit-option-some args) (unless (= (length args) 1) (error 'typed-rust "option-some expects one operand" args)) @@ -973,6 +981,8 @@ (emit-bytevector-length args)] [(eq? name 'equal?) (emit-equality args)] + [(eq? name 'debug-string) + (emit-debug-string args)] [(eq? name 'option-some) (emit-option-some args)] [(eq? name 'option-none) --- a/tests/fixtures/typed/rust-basic.ss +++ b/tests/fixtures/typed/rust-basic.ss @@ -1,7 +1,7 @@ (typed-library (sample typed rust-basic) (export zero add-one positive? choose greeting echo-text double-add text-length bytes-length echo-bytes make-box box-value make-some token-size - maybe-value echo-maybe ok-value err-value echo-result) + token-debug maybe-value echo-maybe ok-value err-value echo-result) (record Box ((value : Nat))) @@ -55,6 +55,9 @@ ((Some value) value) ((Empty) 0))) + (def (token-debug (token : Token)) : String + (debug-string token)) + (def (maybe-value (x : Nat)) : (Option Nat) (option-some x)) --- a/tests/test-typed-checker.ss +++ b/tests/test-typed-checker.ss @@ -867,6 +867,25 @@ (equal? x text)))) '(operand-type-mismatch)) +(test "debug-string primitive returns String" + (error-kinds + '(typed-library (body debug-string) + (export f) + (variant Token + (Some (value : Nat)) + (Empty)) + (def (f (token : Token)) : String + (debug-string token)))) + '()) + +(test "debug-string primitive rejects bad arity" + (error-kinds + '(typed-library (body debug-string-bad) + (export f) + (def (f (x : Nat)) : String + (debug-string x x)))) + '(bad-primitive-arity)) + (test "boolean primitive returns Bool" (error-kinds '(typed-library (body bool) --- a/tests/test-typed-rust.ss +++ b/tests/test-typed-rust.ss @@ -190,14 +190,16 @@ (define equality-form '(typed-library (sample typed equality) - (export same-text? same-token?) + (export same-text? same-token? token-debug) (variant Token (Some (value : Nat)) (Empty)) (def (same-text? (a : String) (b : String)) : Bool (equal? a b)) (def (same-token? (a : Token) (b : Token)) : Bool - (equal? a b)))) + (equal? a b)) + (def (token-debug (token : Token)) : String + (debug-string token)))) (define equality-rust (typed-library-form->rust-string equality-form)) @@ -328,6 +330,12 @@ (substring? equality-rust "(a == b)")) #t) +(test "rust lowers debug-string primitive" + (and (substring? equality-rust "pub fn token_debug(token: Token) -> String") + (substring? equality-rust "format!(\"{:?}\", token)") + (substring? equality-rust "jt_return_bytes(token_debug(token).into_bytes(), out_ptr, out_len)")) + #t) + (printf "~%Typed Rust emitter: ~a passed, ~a failed~%" pass fail) (when (> fail 0) (exit 1)) --- a/tests/test-typed-wrapper-e2e.ss +++ b/tests/test-typed-wrapper-e2e.ss @@ -60,6 +60,8 @@ (= (box-value (make-box 17)) 17)) (check "variant handle round trip" (= (token-size (make-some 23)) 23)) +(check "variant debug string" + (string=? (token-debug (make-some 44)) "Some { value: 44 }")) (define maybe-handle (maybe-value 29)) (check "option handle return"