Define Typed Jerboa core IR module
ober
cfddd7f74bbb4fcd8da7ba8034d4183a2b09f769
--- a/Makefile +++ b/Makefile @@ -31,7 +31,7 @@ TYPED_RUST_SOURCES ?= $(TYPED_SOURCES) TYPED_RUST_DIR ?= build/typed/rust TYPED_WRAPPER_DIR ?= build/typed/jerboa -.PHONY: help chez chez-cross build binary binary-cross native-cross pure-audit typecheck typed-rust typed-wrappers typed-build typed-wrapper-smoke typed-split-tree-smoke 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-typed-wrappers 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 +.PHONY: help chez chez-cross build binary binary-cross native-cross pure-audit typecheck typed-rust typed-wrappers typed-build typed-wrapper-smoke typed-split-tree-smoke 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-core test-typed-parser test-typed-checker test-typed-rust test-typed-wrappers 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>" @@ -342,7 +342,7 @@ typed-split-tree-smoke: build/typed/split-tree-smoke/sample_typed_split_tree.ss \ tests/test-typed-split-tree-caller.ss -typed-test: test-typed-parser test-typed-checker test-typed-rust test-typed-wrappers typecheck +typed-test: test-typed-core test-typed-parser test-typed-checker test-typed-rust test-typed-wrappers typecheck typed-clean: @rm -rf build/typed @@ -396,6 +396,9 @@ test-ergo: @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-ergo.ss @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-jerboa-prelude-ergo.ss +test-typed-core: + @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-typed-core.ss + test-typed-parser: @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-typed-parser.ss --- a/docs/jerboa-to-rust.md +++ b/docs/jerboa-to-rust.md @@ -81,7 +81,9 @@ Landed: Still open: -- Typed core IR. This is the most important backend architecture gap. +- Typed core IR adoption. The IR record types now live in + `(jerboa typed core)`; the checker and Rust emitter still walk surface + datums and need to be switched over. - Import resolution between typed modules. - Structured Rust-to-Scheme error returns instead of conservative panic defaults. --- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -141,6 +141,13 @@ Current landing: inside function bodies so the checker can attach file/line/column to expression diagnostics. The Rust emitter strips annotations at its boundary so generated code remains deterministic. +- `(jerboa typed core)` defines the first slice of an explicit typed core IR: + `typed-ir-lit`, `typed-ir-var`, `typed-ir-begin`, `typed-ir-let`, + `typed-ir-if`, `typed-ir-match`, and a unified `typed-ir-call` covering + primitives, typed function calls, record/variant operations, Option/Result + constructors, and string builtins. Every node carries its inferred type and + optional source location. The checker and Rust emitter do not yet consume + the IR; that wiring is the next step. - `(jerboa typed checker)` performs the first backend-neutral validation pass: duplicate names, export resolution, type-reference resolution, compound type arities, duplicate fields, duplicate params, duplicate variant cases, and a @@ -268,9 +275,10 @@ Code that has landed: The next model should continue in small commits with tests and docs per step. Highest-value next steps: -1. Introduce an explicit typed core IR between parser/checker and backends. - Today the checker and Rust emitter both walk surface datums, which keeps the - MVP simple but will make imports, source maps, and optimization harder. +1. Continue the typed core IR rollout. The IR record types now live in + `(jerboa typed core)`; the next steps are to have the checker emit IR + alongside its existing type/effect output and then to switch the Rust + emitter to consume IR rather than re-walking surface datums. 2. Resolve imports between typed modules. The checker currently handles calls within one typed module only; imported calls are intentionally unsupported. 3. Improve boundary semantics for Option/Result. They currently cross the FFI new file mode 100644 --- /dev/null +++ b/lib/jerboa/typed/core.ss @@ -0,0 +1,145 @@ +#!chezscheme +;;; (jerboa typed core) -- Typed Jerboa core IR +;;; +;;; The core IR is the intermediate representation produced by the checker +;;; and consumed by the Rust backend. It carries an inferred type and an +;;; optional source location on every expression node so that diagnostics +;;; and code generation never need to re-parse surface datums. +;;; +;;; This first slice keeps the IR small: it captures only the expression +;;; shapes the current checker accepts. Future work can extend it with +;;; explicit ownership/borrow nodes, lowered match decision trees, and +;;; effect annotations on call sites. + +(library (jerboa typed core) + (export + typed-ir-lit? + make-typed-ir-lit + typed-ir-lit-type typed-ir-lit-source typed-ir-lit-value + + typed-ir-var? + make-typed-ir-var + typed-ir-var-type typed-ir-var-source typed-ir-var-name + + typed-ir-begin? + make-typed-ir-begin + typed-ir-begin-type typed-ir-begin-source typed-ir-begin-exprs + + typed-ir-let? + make-typed-ir-let + typed-ir-let-type typed-ir-let-source + typed-ir-let-bindings typed-ir-let-body + + typed-ir-binding? + make-typed-ir-binding + typed-ir-binding-name typed-ir-binding-expr + + typed-ir-if? + make-typed-ir-if + typed-ir-if-type typed-ir-if-source + typed-ir-if-test typed-ir-if-then typed-ir-if-else + + typed-ir-match? + make-typed-ir-match + typed-ir-match-type typed-ir-match-source + typed-ir-match-scrutinee typed-ir-match-scrutinee-type + typed-ir-match-clauses typed-ir-match-default + + typed-ir-match-clause? + make-typed-ir-match-clause + typed-ir-match-clause-case + typed-ir-match-clause-bindings + typed-ir-match-clause-field-types + typed-ir-match-clause-body + + typed-ir-call? + make-typed-ir-call + typed-ir-call-type typed-ir-call-source + typed-ir-call-kind typed-ir-call-operator + typed-ir-call-args typed-ir-call-info + + typed-ir-call-kinds + typed-ir-node? + typed-ir-node-type + typed-ir-node-source) + + (import (chezscheme) ; jerboa-security: suppress direct-chezscheme-import-user-code -- trusted typed core IR module + (only (jerboa core) def defstruct)) + + ;; --- expression node types ----------------------------------------------- + + (defstruct typed-ir-lit (type source value)) + (defstruct typed-ir-var (type source name)) + (defstruct typed-ir-begin (type source exprs)) + (defstruct typed-ir-let (type source bindings body)) + (defstruct typed-ir-binding (name expr)) + (defstruct typed-ir-if (type source test then else)) + (defstruct typed-ir-match + (type source scrutinee scrutinee-type clauses default)) + (defstruct typed-ir-match-clause (case bindings field-types body)) + + ;; --- call node ----------------------------------------------------------- + ;; + ;; A single call record covers every kind of typed call so the Rust emitter + ;; can dispatch on a small set of symbols rather than inspecting surface + ;; syntax. The `kind` field is one of the symbols in `typed-ir-call-kinds`, + ;; the `operator` field carries the primitive symbol or callee name, and the + ;; `info` field carries kind-specific extras (record/field/case names, type + ;; annotations on option/result constructors, etc.). + (defstruct typed-ir-call (type source kind operator args info)) + + (def typed-ir-call-kinds + '(function + prim-arith + prim-cmp + prim-eq + prim-bool + string-length + string-append + bytevector-length + debug-string + record-ctor + record-pred + record-accessor + record-setter + variant-ctor + variant-pred + option-some + option-none + result-ok + result-err)) + + ;; --- generic accessors --------------------------------------------------- + + (def (typed-ir-node? x) + (or (typed-ir-lit? x) + (typed-ir-var? x) + (typed-ir-begin? x) + (typed-ir-let? x) + (typed-ir-if? x) + (typed-ir-match? x) + (typed-ir-call? x))) + + (def (typed-ir-node-type node) + (cond + [(typed-ir-lit? node) (typed-ir-lit-type node)] + [(typed-ir-var? node) (typed-ir-var-type node)] + [(typed-ir-begin? node) (typed-ir-begin-type node)] + [(typed-ir-let? node) (typed-ir-let-type node)] + [(typed-ir-if? node) (typed-ir-if-type node)] + [(typed-ir-match? node) (typed-ir-match-type node)] + [(typed-ir-call? node) (typed-ir-call-type node)] + [else (error 'typed-ir-node-type "not a typed IR node" node)])) + + (def (typed-ir-node-source node) + (cond + [(typed-ir-lit? node) (typed-ir-lit-source node)] + [(typed-ir-var? node) (typed-ir-var-source node)] + [(typed-ir-begin? node) (typed-ir-begin-source node)] + [(typed-ir-let? node) (typed-ir-let-source node)] + [(typed-ir-if? node) (typed-ir-if-source node)] + [(typed-ir-match? node) (typed-ir-match-source node)] + [(typed-ir-call? node) (typed-ir-call-source node)] + [else (error 'typed-ir-node-source "not a typed IR node" node)])) + +) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-typed-core.ss @@ -0,0 +1,131 @@ +#!chezscheme +(import (chezscheme) + (jerboa typed core)) + +(define total 0) +(define failed 0) + +(define-syntax test + (syntax-rules () + [(_ label actual expected) + (begin + (set! total (+ total 1)) + (let ([a actual] [e expected]) + (if (equal? a e) + (printf " ok ~a~%" label) + (begin + (set! failed (+ failed 1)) + (printf " FAIL ~a~% expected: ~s~% actual: ~s~%" + label e a)))))])) + +(define-syntax test-true + (syntax-rules () + [(_ label actual) + (test label (if actual #t #f) #t)])) + +(printf "--- Typed Jerboa core IR tests ---~%") + +;; --- literals ------------------------------------------------------------ + +(define lit42 (make-typed-ir-lit 'Nat #f 42)) +(test "lit carries type" (typed-ir-lit-type lit42) 'Nat) +(test "lit carries value" (typed-ir-lit-value lit42) 42) +(test "lit has no source by default" (typed-ir-lit-source lit42) #f) +(test-true "lit is a typed-ir-node" (typed-ir-node? lit42)) +(test "typed-ir-node-type works on lit" (typed-ir-node-type lit42) 'Nat) + +;; --- variables ----------------------------------------------------------- + +(define var-x (make-typed-ir-var 'String 'src 'x)) +(test "var carries type" (typed-ir-var-type var-x) 'String) +(test "var carries name" (typed-ir-var-name var-x) 'x) +(test "var carries source" (typed-ir-var-source var-x) 'src) +(test "typed-ir-node-source works on var" (typed-ir-node-source var-x) 'src) + +;; --- begin --------------------------------------------------------------- + +(define seq (make-typed-ir-begin 'Bool #f (list lit42 var-x))) +(test "begin carries type" (typed-ir-begin-type seq) 'Bool) +(test "begin carries exprs" + (map typed-ir-node-type (typed-ir-begin-exprs seq)) + '(Nat String)) + +;; --- let ----------------------------------------------------------------- + +(define binding (make-typed-ir-binding 'x lit42)) +(define let-node (make-typed-ir-let 'Bool #f (list binding) (list var-x))) +(test "binding carries name" (typed-ir-binding-name binding) 'x) +(test "binding carries expr type" + (typed-ir-node-type (typed-ir-binding-expr binding)) 'Nat) +(test "let carries type" (typed-ir-let-type let-node) 'Bool) +(test "let carries bindings" + (length (typed-ir-let-bindings let-node)) 1) +(test "let carries body" + (length (typed-ir-let-body let-node)) 1) + +;; --- if ------------------------------------------------------------------ + +(define if-node + (make-typed-ir-if 'Nat #f + (make-typed-ir-lit 'Bool #f #t) + lit42 + (make-typed-ir-lit 'Nat #f 0))) +(test "if carries type" (typed-ir-if-type if-node) 'Nat) +(test "if test type" (typed-ir-node-type (typed-ir-if-test if-node)) 'Bool) +(test "if then type" (typed-ir-node-type (typed-ir-if-then if-node)) 'Nat) +(test "if else type" (typed-ir-node-type (typed-ir-if-else if-node)) 'Nat) + +;; --- match --------------------------------------------------------------- + +(define clause + (make-typed-ir-match-clause + 'Insert + '(at text) + '(Nat String) + (list (make-typed-ir-lit 'Unit #f '())))) +(define match-node + (make-typed-ir-match 'Unit #f var-x 'EditOp (list clause) #f)) +(test "match-clause carries case" (typed-ir-match-clause-case clause) 'Insert) +(test "match-clause carries bindings" + (typed-ir-match-clause-bindings clause) '(at text)) +(test "match-clause carries field types" + (typed-ir-match-clause-field-types clause) '(Nat String)) +(test "match scrutinee type" + (typed-ir-match-scrutinee-type match-node) 'EditOp) +(test "match carries clauses" + (length (typed-ir-match-clauses match-node)) 1) +(test "match default empty" (typed-ir-match-default match-node) #f) + +;; --- call ---------------------------------------------------------------- + +(define plus-call + (make-typed-ir-call 'Nat #f 'prim-arith '+ + (list lit42 (make-typed-ir-lit 'Nat #f 1)) #f)) +(test "call carries type" (typed-ir-call-type plus-call) 'Nat) +(test "call carries kind" (typed-ir-call-kind plus-call) 'prim-arith) +(test "call carries operator" (typed-ir-call-operator plus-call) '+) +(test "call carries args" + (length (typed-ir-call-args plus-call)) 2) +(test-true "call kind is in the registry" + (memq (typed-ir-call-kind plus-call) typed-ir-call-kinds)) + +(define record-ctor + (make-typed-ir-call 'Position #f 'record-ctor 'make-Position + (list (make-typed-ir-lit 'Nat #f 0) (make-typed-ir-lit 'Nat #f 0)) + '((record . Position)))) +(test "record-ctor kind" (typed-ir-call-kind record-ctor) 'record-ctor) +(test "record-ctor info" + (cdr (assq 'record (typed-ir-call-info record-ctor))) 'Position) + +(define option-none + (make-typed-ir-call '(Option Nat) #f 'option-none 'option-none + '() '((inner-type . Nat)))) +(test "option-none kind" (typed-ir-call-kind option-none) 'option-none) +(test "option-none type" + (typed-ir-call-type option-none) '(Option Nat)) + +;; --- summary ------------------------------------------------------------- + +(printf "~%Typed core IR: ~a passed, ~a failed~%" + (- total failed) failed) +(when (> failed 0) (exit 1))