Add Typed Jerboa Rust emitter skeleton
ober
ffa65b330c9e8ebb6033ddbb0e50dbd35b9c2812
--- a/Makefile +++ b/Makefile @@ -28,7 +28,7 @@ PURE_AUDIT_ROOT ?= $(HOME)/mine PURE_AUDIT_ARGS ?= --summary --discover $(PURE_AUDIT_ROOT) TYPED_SOURCES ?= tests/fixtures/typed/valid-split-tree.ss -.PHONY: help chez chez-cross build binary binary-cross native-cross pure-audit typecheck typed-test typed-clean test test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-contract test-ergo test-typed-parser test-typed-checker test-pure-audit test-features test-wrappers test-phase4a test-phase4b test-phase4c test-phase4d test-phase4e test-phase4f test-phase5 test-phase5e test-phase6 test-phase7 test-phase8 test-functional test-repl test-security test-security-profile test-native test-gaps native clean-native audit-native clean security security-production security-profile fuzz fuzz-smoke fuzz-deep fuzz-reader-fuzz fuzz-json-fuzz fuzz-http2-fuzz fuzz-websocket-fuzz fuzz-dns-fuzz fuzz-pregexp-fuzz fuzz-csv-fuzz fuzz-base64-fuzz fuzz-hex-fuzz fuzz-uri-fuzz fuzz-format-fuzz fuzz-router-fuzz fuzz-sandbox-fuzz test-rawstring test-regex test-rx test-peg test-regex-all check-docs check-docs-strict docker-build docker-push +.PHONY: help chez chez-cross build binary binary-cross native-cross pure-audit typecheck typed-test typed-clean test test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-contract test-ergo test-typed-parser test-typed-checker test-typed-rust test-pure-audit test-features test-wrappers test-phase4a test-phase4b test-phase4c test-phase4d test-phase4e test-phase4f test-phase5 test-phase5e test-phase6 test-phase7 test-phase8 test-functional test-repl test-security test-security-profile test-native test-gaps native clean-native audit-native clean security security-production security-profile fuzz fuzz-smoke fuzz-deep fuzz-reader-fuzz fuzz-json-fuzz fuzz-http2-fuzz fuzz-dns-fuzz fuzz-pregexp-fuzz fuzz-csv-fuzz fuzz-base64-fuzz fuzz-hex-fuzz fuzz-uri-fuzz fuzz-format-fuzz fuzz-router-fuzz fuzz-sandbox-fuzz test-rawstring test-regex test-rx test-peg test-regex-all check-docs check-docs-strict docker-build docker-push help: @echo "Usage: make <target>" @@ -72,6 +72,7 @@ help: @echo " test-ergo Ergonomic contract marker tests" @echo " test-typed-parser Typed Jerboa parser tests" @echo " test-typed-checker Typed Jerboa checker tests" + @echo " test-typed-rust Typed Jerboa Rust emitter tests" @echo " test-pure-audit Pure Jerboa migration scanner tests" @echo "" @echo "Test (features):" @@ -303,7 +304,7 @@ test: test-reader test-core test-runtime test-stdlib test-ffi test-modules test- typecheck: @$(SCHEME) --libdirs $(LIBDIRS) --script support/typecheck.ss $(TYPED_SOURCES) -typed-test: test-typed-parser test-typed-checker typecheck +typed-test: test-typed-parser test-typed-checker test-typed-rust typecheck typed-clean: @rm -rf build/typed @@ -363,6 +364,9 @@ test-typed-parser: test-typed-checker: @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-typed-checker.ss +test-typed-rust: + @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-typed-rust.ss + test-pure-audit: @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-pure-audit.ss --- a/docs/jerboa-to-rust.md +++ b/docs/jerboa-to-rust.md @@ -535,10 +535,14 @@ Second module: typed `rope`. ### Milestone 1: Rust Emitter Skeleton +- Generate deterministic Rust text. Initial `(jerboa typed rust)` emitter + landed with safe Rust headers, identifier sanitization, primitive type + mapping, records, variants, and primitive function bodies. - Generate crate directory. - Generate `Cargo.toml`. - Generate `lib.rs`. -- Generate one function returning an integer. +- Generate one function returning an integer. Initial text emission for `Nat` + functions landed; crate compilation is next. - Build with Cargo. - Call from Jerboa through FFI. --- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -145,6 +145,10 @@ Current landing: run the parser/checker over typed source files without invoking Rust. The typecheck CLI now prints structured diagnostics with module context, detail, and a short hint for common errors. +- `(jerboa typed rust)` emits deterministic safe Rust text for checked typed + modules. The first emitter covers Rust identifiers, primitive types, + records, variants, and primitive function bodies; crate generation and FFI + wrappers are still future work. - The parser currently recognizes explicit `export` forms, `type` declarations, immutable and `mut` record fields, variants including nullary cases, and `def` forms with typed parameters and `:` or `->` return markers. @@ -154,7 +158,7 @@ Current landing: the same module, generated record/variant operations, and exhaustive `match` over same-module variants. Imported calls and richer forms are reported as unsupported. It does not yet resolve imports, lower to typed core - IR, or emit Rust/LLVM. + IR, compile generated Rust, or emit LLVM. ## Surface Syntax @@ -624,10 +628,11 @@ Initial meanings: - `typecheck`: parse and type check typed modules. Initial target landed for parser/checker validation over `TYPED_SOURCES`. -- `typed-rust`: generate Rust for typed modules. +- `typed-rust`: generate Rust for typed modules. Initial Rust text emission has + landed as `(jerboa typed rust)`; the public make target is still pending. - `typed-build`: generate Rust, compile artifacts, generate wrappers. - `typed-test`: run typed compiler tests and runtime boundary tests. Initial - target runs parser, checker, and `typecheck`. + target runs parser, checker, Rust emitter, and `typecheck`. - `typed-llvm`: reserved until the LLVM backend exists. ## Generated Files @@ -769,8 +774,9 @@ Minimum excluded features: ### Milestone 3: Rust Backend -- Generate Rust structs and enums. -- Generate Rust functions. +- Generate Rust structs and enums. Initial safe Rust text emission landed. +- Generate Rust functions. Initial primitive expression function emission + landed. - Generate conversion functions. - Compile generated Rust as a static or dynamic library. - Generate Jerboa wrappers. new file mode 100644 --- /dev/null +++ b/lib/jerboa/typed/rust.ss @@ -0,0 +1,358 @@ +#!chezscheme +;;; (jerboa typed rust) -- initial safe Rust text emitter for Typed Jerboa +;;; +;;; This is a deterministic text backend for the checked Typed Jerboa AST. It +;;; emits a restricted safe Rust subset and deliberately rejects expressions it +;;; cannot lower yet. + +(library (jerboa typed rust) + (export + rust-symbol-name + typed-module->rust-string + typed-library-form->rust-string) + + (import (chezscheme) ; jerboa-security: suppress direct-chezscheme-import-user-code -- trusted typed compiler Rust emitter + (only (jerboa core) def) + (jerboa typed parser) + (jerboa typed checker)) + + (def (emit-to-string thunk) + (let ([port (open-output-string)]) + (thunk port) + (get-output-string port))) + + (def (join-strings strings separator) + (cond + [(null? strings) ""] + [else + (let ([port (open-output-string)]) + (display (car strings) port) + (let loop ([rest (cdr strings)]) + (unless (null? rest) + (display separator port) + (display (car rest) port) + (loop (cdr rest)))) + (get-output-string port))])) + + (def (write-indent port level) + (let loop ([n level]) + (when (> n 0) + (display " " port) + (loop (- n 1))))) + + (def (write-line port level text) + (write-indent port level) + (display text port) + (newline port)) + + (def rust-keywords + '("as" "break" "const" "continue" "crate" "else" "enum" "extern" + "false" "fn" "for" "if" "impl" "in" "let" "loop" "match" "mod" + "move" "mut" "pub" "ref" "return" "self" "Self" "static" "struct" + "super" "trait" "true" "type" "unsafe" "use" "where" "while" + "async" "await" "dyn")) + + (def (rust-keyword? name) + (let loop ([rest rust-keywords]) + (cond + [(null? rest) #f] + [(string=? name (car rest)) #t] + [else (loop (cdr rest))]))) + + (def (identifier-start? ch) + (or (char-alphabetic? ch) (char=? ch #\_))) + + (def (identifier-char? ch) + (or (identifier-start? ch) (char-numeric? ch))) + + (def (write-rust-ident-char ch port) + (cond + [(identifier-char? ch) (write-char ch port)] + [(char=? ch #\-) (write-char #\_ port)] + [(char=? ch #\?) (display "_p" port)] + [(char=? ch #\!) (display "_bang" port)] + [else (write-char #\_ port)])) + + (def (sanitize-rust-ident raw) + (let ([port (open-output-string)]) + (let loop ([chars (string->list raw)]) + (unless (null? chars) + (write-rust-ident-char (car chars) port) + (loop (cdr chars)))) + (let ([name (get-output-string port)]) + (cond + [(string=? name "") "_"] + [(or (not (identifier-start? (string-ref name 0))) + (rust-keyword? name)) + (string-append "_" name)] + [else name])))) + + (def (rust-symbol-name sym) + (sanitize-rust-ident (symbol->string sym))) + + (def (rust-string-literal text) + (emit-to-string + (lambda (port) + (write-char #\" port) + (let loop ([chars (string->list text)]) + (unless (null? chars) + (let ([ch (car chars)]) + (cond + [(char=? ch #\\) (display "\\\\" port)] + [(char=? ch #\") (display "\\\"" port)] + [(char=? ch #\newline) (display "\\n" port)] + [(char=? ch #\tab) (display "\\t" port)] + [(char=? ch #\return) (display "\\r" port)] + [else (write-char ch port)])) + (loop (cdr chars)))) + (write-char #\" port)))) + + (def (rust-char-literal ch) + (string-append + "'" + (cond + [(char=? ch #\\) "\\\\"] + [(char=? ch #\') "\\'"] + [(char=? ch #\newline) "\\n"] + [(char=? ch #\tab) "\\t"] + [(char=? ch #\return) "\\r"] + [else (string ch)]) + "'")) + + (def (rust-type type) + (cond + [(symbol? type) + (case type + [(Unit) "()"] + [(Bool) "bool"] + [(Char) "char"] + [(Int) "i64"] + [(Nat) "u64"] + [(Fixnum) "isize"] + [(Float) "f64"] + [(String) "String"] + [(Bytes) "Vec<u8>"] + [(Symbol) "String"] + [(Keyword) "String"] + [else (rust-symbol-name type)])] + [(pair? type) + (case (car type) + [(Option) (string-append "Option<" (rust-type (cadr type)) ">")] + [(Result) (string-append "Result<" (rust-type (cadr type)) + ", " (rust-type (caddr type)) ">")] + [(Vector List) (string-append "Vec<" (rust-type (cadr type)) ">")] + [(Pair) (string-append "(" (rust-type (cadr type)) + ", " (rust-type (caddr type)) ")")] + [else (error 'typed-rust "unsupported compound type" type)])] + [else (error 'typed-rust "unsupported type" type)])) + + (def (emit-record record port) + (write-line port 0 "#[derive(Clone, Debug, PartialEq)]") + (write-line port 0 + (string-append "pub struct " (rust-symbol-name (typed-record-name record)) " {")) + (for-each + (lambda (field) + (write-line port 1 + (string-append + "pub " + (rust-symbol-name (typed-field-name field)) + ": " + (rust-type (typed-field-type field)) + ","))) + (typed-record-fields record)) + (write-line port 0 "}") + (newline port)) + + (def (emit-variant-case case port) + (let ([fields (typed-variant-case-fields case)]) + (cond + [(null? fields) + (write-line port 1 + (string-append (rust-symbol-name (typed-variant-case-name case)) ","))] + [else + (write-line port 1 + (string-append (rust-symbol-name (typed-variant-case-name case)) " {")) + (for-each + (lambda (field) + (write-line port 2 + (string-append + (rust-symbol-name (typed-field-name field)) + ": " + (rust-type (typed-field-type field)) + ","))) + fields) + (write-line port 1 "},")]))) + + (def (emit-variant variant port) + (write-line port 0 "#[derive(Clone, Debug, PartialEq)]") + (write-line port 0 + (string-append "pub enum " (rust-symbol-name (typed-variant-name variant)) " {")) + (for-each + (lambda (case) + (emit-variant-case case port)) + (typed-variant-cases variant)) + (write-line port 0 "}") + (newline port)) + + (def (emit-param param) + (string-append + (rust-symbol-name (typed-param-name param)) + ": " + (rust-type (typed-param-type param)))) + + (def (emit-binary-chain op args) + (cond + [(null? args) (error 'typed-rust "operator needs operands" op)] + [(null? (cdr args)) (emit-expression (car args))] + [else + (let loop ([rest (cdr args)] [out (emit-expression (car args))]) + (if (null? rest) + out + (loop (cdr rest) + (string-append "(" out " " op " " + (emit-expression (car rest)) ")"))))])) + + (def (emit-bool-chain op args) + (cond + [(null? args) (if (string=? op "&&") "true" "false")] + [(null? (cdr args)) (emit-expression (car args))] + [else (emit-binary-chain op args)])) + + (def (emit-begin exprs) + (cond + [(null? exprs) "()"] + [(null? (cdr exprs)) (emit-expression (car exprs))] + [else + (string-append + "{ " + (join-strings + (append + (map (lambda (expr) + (string-append (emit-expression expr) ";")) + (let loop ([rest exprs]) + (if (null? (cdr rest)) '() (cons (car rest) (loop (cdr rest)))))) + (list (emit-expression (let loop ([rest exprs]) + (if (null? (cdr rest)) + (car rest) + (loop (cdr rest))))))) + " ") + " }")])) + + (def (emit-let bindings body) + (string-append + "{ " + (join-strings + (append + (map (lambda (binding) + (string-append "let " + (rust-symbol-name (car binding)) + " = " + (emit-expression (cadr binding)) + ";")) + bindings) + (list (emit-begin body))) + " ") + " }")) + + (def (emit-if args) + (unless (= (length args) 3) + (error 'typed-rust "if expects condition, then branch, and else branch" args)) + (string-append + "if " + (emit-expression (car args)) + " { " + (emit-expression (cadr args)) + " } else { " + (emit-expression (caddr args)) + " }")) + + (def (emit-call name args) + (string-append + (rust-symbol-name name) + "(" + (join-strings (map emit-expression args) ", ") + ")")) + + (def (emit-expression expr) + (cond + [(boolean? expr) (if expr "true" "false")] + [(char? expr) (rust-char-literal expr)] + [(string? expr) + (string-append "String::from(" (rust-string-literal expr) ")")] + [(integer? expr) + (if (>= expr 0) + (string-append (number->string expr) "u64") + (string-append (number->string expr) "i64"))] + [(symbol? expr) (rust-symbol-name expr)] + [(pair? expr) + (case (car expr) + [(begin) (emit-begin (cdr expr))] + [(let) (emit-let (cadr expr) (cddr expr))] + [(if) (emit-if (cdr expr))] + [(+) (emit-binary-chain "+" (cdr expr))] + [(-) (emit-binary-chain "-" (cdr expr))] + [(*) (emit-binary-chain "*" (cdr expr))] + [(/) (emit-binary-chain "/" (cdr expr))] + [(=) (emit-binary-chain "==" (cdr expr))] + [(<) (emit-binary-chain "<" (cdr expr))] + [(<=) (emit-binary-chain "<=" (cdr expr))] + [(>) (emit-binary-chain ">" (cdr expr))] + [(>=) (emit-binary-chain ">=" (cdr expr))] + [(not) + (unless (= (length (cdr expr)) 1) + (error 'typed-rust "not expects one operand" expr)) + (string-append "(!" (emit-expression (cadr expr)) ")")] + [(and) (emit-bool-chain "&&" (cdr expr))] + [(or) (emit-bool-chain "||" (cdr expr))] + [(match) (error 'typed-rust "match lowering is not implemented yet" expr)] + [else + (if (symbol? (car expr)) + (emit-call (car expr) (cdr expr)) + (error 'typed-rust "unsupported expression" expr))])] + [else (error 'typed-rust "unsupported expression" expr)])) + + (def (emit-def def port) + (let ([params (join-strings (map emit-param (typed-def-params def)) ", ")]) + (write-line port 0 + (string-append + "pub fn " + (rust-symbol-name (typed-def-name def)) + "(" + params + ") -> " + (rust-type (typed-def-return-type def)) + " {")) + (write-line port 1 (emit-begin (typed-def-body def))) + (write-line port 0 "}") + (newline port))) + + (def (emit-declaration decl port) + (cond + [(typed-record? decl) (emit-record decl port)] + [(typed-variant? decl) (emit-variant decl port)] + [(typed-def? decl) (emit-def decl port)] + [else #f])) + + (def (emit-module module port) + (write-line port 0 "// Generated by Jerboa's typed Rust backend. Do not edit.") + (write-line port 0 "#![forbid(unsafe_code)]") + (newline port) + (for-each + (lambda (decl) + (emit-declaration decl port)) + (typed-module-declarations module))) + + (def (typed-module->rust-string module) + (let ([errors (check-typed-module module)]) + (unless (null? errors) + (error 'typed-module->rust-string + "typed module has check errors" + (map typed-check-error-kind errors))) + (emit-to-string + (lambda (port) + (emit-module module port))))) + + (def (typed-library-form->rust-string form) + (typed-module->rust-string (parse-typed-library form))) + +) ;; end library --- a/support/build.ss +++ b/support/build.ss @@ -19,6 +19,7 @@ (jerboa build) (jerboa typed parser) (jerboa typed checker) + (jerboa typed rust) ;; Regex / rx / peg tier — compiled independently so errors are isolated (std srfi srfi-115) (std regex) new file mode 100644 --- /dev/null +++ b/tests/test-typed-rust.ss @@ -0,0 +1,64 @@ +#!chezscheme +;;; Tests for (jerboa typed rust) + +(import (chezscheme) + (jerboa typed rust)) + +(define pass 0) +(define fail 0) + +(define-syntax test + (syntax-rules () + [(_ name expr expected) + (guard (exn [#t (set! fail (+ fail 1)) + (printf "FAIL ~a: exception ~a~%" name + (if (message-condition? exn) (condition-message exn) exn))]) + (let ([got expr]) + (if (equal? got expected) + (begin (set! pass (+ pass 1)) + (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) + (printf "FAIL ~a: got ~s expected ~s~%" name got expected)))))])) + +(define calc-form + '(typed-library (sample typed calc) + (export zero add-one) + (def (zero) : Nat + 0) + (def (add-one (x : Nat)) : Nat + (+ x 1)))) + +(define calc-rust + "// Generated by Jerboa's typed Rust backend. Do not edit.\n#![forbid(unsafe_code)]\n\npub fn zero() -> u64 {\n 0u64\n}\n\npub fn add_one(x: u64) -> u64 {\n (x + 1u64)\n}\n\n") + +(define data-form + '(typed-library (sample typed data) + (export make-Pane Pane? Pane-id Pane-focused? Pane-focused?-set! + EditOp? Insert Noop) + (record Pane + ((id : Nat) + (mut focused? : Bool))) + (variant EditOp + (Insert (at : Nat) (text : String)) + (Noop)))) + +(define data-rust + "// Generated by Jerboa's typed Rust backend. Do not edit.\n#![forbid(unsafe_code)]\n\n#[derive(Clone, Debug, PartialEq)]\npub struct Pane {\n pub id: u64,\n pub focused_p: bool,\n}\n\n#[derive(Clone, Debug, PartialEq)]\npub enum EditOp {\n Insert {\n at: u64,\n text: String,\n },\n Noop,\n}\n\n") + +(printf "--- Typed Jerboa Rust emitter tests ---~%") + +(test "rust symbol sanitizes" + (rust-symbol-name 'edit-op?) + "edit_op_p") + +(test "rust emits primitive functions" + (typed-library-form->rust-string calc-form) + calc-rust) + +(test "rust emits records and variants" + (typed-library-form->rust-string data-form) + data-rust) + +(printf "~%Typed Rust emitter: ~a passed, ~a failed~%" pass fail) +(when (> fail 0) + (exit 1))