updates
ober
903ad8dfe4eda0331d989a71489914feacaa3295
--- a/.gitignore +++ b/.gitignore @@ -68,6 +68,7 @@ /.chez/ /.chez-cross-*/ /build/ +/.tmp/ # Rust build artifacts jerboa-native-rs/target/ @@ -88,6 +89,16 @@ tests/vm/vm_key.pub tests/vm/seed/ tests/vm/*.log tests/vm/*.pid + +# Generated by tests/wasm-gc/*.ss. +tests/wasm-gc/fixtures/*.wasm +tests/wasm-gc/fixtures/*.ss +tests/wasm-gc/fixtures/**/*.wasm +tests/wasm-gc/fixtures/**/*.ss +tests/wasm-gc/fixtures/**/*.out +tests/wasm-gc/fixtures/**/*.err +tests/wasm-gc/fixtures/**/*.size +tests/wasm-gc/fixtures/*.json .claude/ *.jpkg .jerboa-catalog.lock --- a/Makefile +++ b/Makefile @@ -1813,6 +1813,7 @@ BROWSER_REPL_WASM := browser-repl/target/wasm32-unknown-unknown/release/jerboa_b BROWSER_REPL_DIST := dist/browser-repl BROWSER_REPL_CARGO := RUSTC=$$(rustup which rustc --toolchain 1.94.1) rustup run 1.94.1 cargo BROWSER_REPL_RUSTFLAGS := -C link-arg=--max-memory=33554432 +BROWSER_REPL_MAX_BYTES ?= 1572864 .PHONY: browser-repl-check browser-repl-wasm browser-repl-test browser-repl-artifact @@ -1825,7 +1826,7 @@ browser-repl-wasm: browser-repl-test: browser-repl-check browser-repl-wasm node tests/browser-repl-node-smoke.mjs $(BROWSER_REPL_WASM) - @test $$(wc -c < $(BROWSER_REPL_WASM)) -le 786432 + @test $$(wc -c < $(BROWSER_REPL_WASM)) -le $(BROWSER_REPL_MAX_BYTES) browser-repl-artifact: browser-repl-test @mkdir -p $(BROWSER_REPL_DIST) @@ -1838,7 +1839,7 @@ browser-repl-artifact: browser-repl-test '{' \ ' "schema_version": 1,' \ ' "abi_version": 1,' \ - ' "subset_revision": "browser-subset-1",' \ + ' "subset_revision": "browser-subset-120",' \ " \"jerboa_version\": \"$$version\"," \ " \"jerboa_commit\": \"$$commit\"," \ ' "rust_toolchain": "1.94.1",' \ new file mode 100644 --- /dev/null +++ b/benchmarks/wasm-gc/closure-call.ss @@ -0,0 +1,10 @@ +(import (jerboa prelude)) + +(define (make-adder n) + (lambda (x) (+ x n))) + +(define (main n) + (let ([add7 (make-adder 7)]) + (add7 n))) + +(export main) new file mode 100644 --- /dev/null +++ b/benchmarks/wasm-gc/direct-tail-sum.ss @@ -0,0 +1,11 @@ +(import (jerboa prelude)) + +(define (sum-down n acc) + (if (= n 0) + acc + (sum-down (- n 1) (+ acc n)))) + +(define (main n) + (sum-down n 0)) + +(export main) new file mode 100644 --- /dev/null +++ b/benchmarks/wasm-gc/list-hashtable.ss @@ -0,0 +1,25 @@ +(import (jerboa prelude)) + +(defstruct point (x y)) + +(define (score p) + (+ (point-x p) (point-y p))) + +(define (bump p) + (make-point (+ (point-x p) 1) (point-y p))) + +(define (sum-score acc p) + (+ acc (score p))) + +(define (main n) + (let* ([points (map bump + (list (make-point n 2) + (make-point (+ n 1) 4) + (make-point (+ n 2) 6)))] + [selected (filter (lambda (p) (even? (score p))) points)] + [total (fold-left sum-score 0 selected)] + [table (make-eq-hashtable)]) + (hashtable-set! table 'total total) + (hashtable-ref table 'total 0))) + +(export main) new file mode 100644 --- /dev/null +++ b/benchmarks/wasm-gc/manifest.json @@ -0,0 +1,42 @@ +{ + "schema": "jerboa.wasm-gc.benchmark-manifest.v1", + "defaultIterations": 5, + "cases": [ + { + "id": "direct-tail-sum", + "source": "benchmarks/wasm-gc/direct-tail-sum.ss", + "export": "main", + "args": [1000], + "expected": "500500", + "targets": ["core"], + "optLevels": [0, 2], + "budgets": { + "maxWasmBytes": null + } + }, + { + "id": "closure-call", + "source": "benchmarks/wasm-gc/closure-call.ss", + "export": "main", + "args": [35], + "expected": "42", + "targets": ["core"], + "optLevels": [0, 2], + "budgets": { + "maxWasmBytes": null + } + }, + { + "id": "list-hashtable", + "source": "benchmarks/wasm-gc/list-hashtable.ss", + "export": "main", + "args": [1], + "expected": "14", + "targets": ["core"], + "optLevels": [0, 2], + "budgets": { + "maxWasmBytes": null + } + } + ] +} --- a/bin/jerboa +++ b/bin/jerboa @@ -8,9 +8,11 @@ set -euo pipefail # Auto-detect JERBOA_HOME as the parent of this script's directory SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" JERBOA_HOME="${JERBOA_HOME:-$(cd "$SCRIPT_DIR/.." && pwd)}" +export JERBOA_HOME SCHEME="${SCHEME:-$JERBOA_HOME/.chez/bin/scheme}" LIBDIRS="$JERBOA_HOME/lib" +export LIBDIRS VERSION="$(tr -d '[:space:]' < "$JERBOA_HOME/VERSION" 2>/dev/null || true)" VERSION="${VERSION:-0.2.0}" @@ -42,6 +44,7 @@ Commands: (auto-installs declared dependencies before running) eval '<expr>' Evaluate a single expression test [dir] Discover and run test files (default: tests/) + wasm <cmd> [args] Wasm tooling: build, run, inspect, validate, package build Run make build in the project directory install <gh-url> Install a package (e.g. github.com/user/repo) uninstall <name> Uninstall a package by name @@ -334,6 +337,293 @@ LIST ) } +cmd_wasm_build() { + local backend="gc" + local output="" + local source="" + local import_manifest="" + local emit_ir="" + local emit_analysis="" + local emit_size_report="" + local -a exports=() + local compile_options="" + local opt_level="0" + local target="core" + local debug_names="0" + local unsafe_js_eval="0" + local compiler_path="" + local source_manifest="" + local export_name="" + local export_name_re='^[-A-Za-z0-9_+*/<>=!?$%&~^:.]+$' + scheme_string_literal() { + local text="$1" + text="${text//\\/\\\\}" + text="${text//\"/\\\"}" + printf '"%s"' "$text" + } + validate_wasm_gc_export_name() { + local name="$1" + local flag="$2" + if [ -z "$name" ]; then + echo "Error: $flag requires a function name" >&2 + exit 1 + fi + if [[ ! "$name" =~ $export_name_re ]]; then + echo "Error: invalid Wasm-GC export name '$name'" >&2 + exit 1 + fi + } + while [ $# -gt 0 ]; do + case "$1" in + --backend) + shift + backend="${1:-}" + ;; + -o|--output) + shift + output="${1:-}" + ;; + --export) + shift + export_name="${1:-}" + validate_wasm_gc_export_name "$export_name" "--export" + exports+=("$export_name") + ;; + --exports) + shift + if [ -z "${1:-}" ]; then + echo "Error: --exports requires a comma-separated name list" >&2 + exit 1 + fi + IFS=',' read -r -a export_parts <<< "$1" + for export_name in "${export_parts[@]}"; do + validate_wasm_gc_export_name "$export_name" "--exports" + exports+=("$export_name") + done + ;; + --emit-import-manifest) + shift + import_manifest="${1:-}" + if [ -z "$import_manifest" ]; then + echo "Error: --emit-import-manifest requires an output path" >&2 + exit 1 + fi + ;; + --emit-ir) + shift + emit_ir="${1:-}" + if [ -z "$emit_ir" ]; then + echo "Error: --emit-ir requires an output path" >&2 + exit 1 + fi + ;; + --emit-analysis) + shift + emit_analysis="${1:-}" + if [ -z "$emit_analysis" ]; then + echo "Error: --emit-analysis requires an output path" >&2 + exit 1 + fi + ;; + --emit-size-report) + shift + emit_size_report="${1:-}" + if [ -z "$emit_size_report" ]; then + echo "Error: --emit-size-report requires an output path" >&2 + exit 1 + fi + ;; + --target) + shift + target="${1:-}" + if [ "$target" != "core" ] && [ "$target" != "node" ] && [ "$target" != "browser" ]; then + echo "Error: --target expects core, node, or browser" >&2 + exit 1 + fi + ;; + -O0) + opt_level="0" + ;; + -O1) + opt_level="1" + ;; + -O2) + opt_level="2" + ;; + --debug-names) + debug_names="1" + ;; + --unsafe-js-eval) + unsafe_js_eval="1" + ;; + --compiler) + shift + compiler_path="${1:-}" + if [ -z "$compiler_path" ]; then + echo "Error: --compiler requires a compiler Wasm path" >&2 + exit 1 + fi + ;; + --source-manifest) + shift + source_manifest="${1:-}" + if [ -z "$source_manifest" ]; then + echo "Error: --source-manifest requires a source manifest path" >&2 + exit 1 + fi + ;; + -*) + echo "Error: unsupported wasm build option '$1'" >&2 + exit 1 + ;; + *) + if [ -n "$source" ]; then + echo "Error: wasm build accepts one source file" >&2 + exit 1 + fi + source="$1" + ;; + esac + shift + done + if [ "$backend" != "gc" ] && [ "$backend" != "wasm-gc" ]; then + echo "Error: only --backend gc is currently supported" >&2 + exit 1 + fi + if [ -z "$source" ]; then + echo "Usage: jerboa wasm build --backend gc program.ss -o program.wasm" >&2 + exit 2 + fi + if [ ! -f "$source" ]; then + echo "Error: source file not found: $source" >&2 + exit 1 + fi + if [ -z "$output" ]; then + output="${source%.*}.wasm" + fi + compile_options="((opt-level $opt_level) (target $target)" + if [ "${#exports[@]}" -gt 0 ]; then + compile_options="$compile_options (exports ${exports[*]})" + fi + if [ "$debug_names" = "1" ]; then + compile_options="$compile_options (debug-names #t)" + fi + if [ "$unsafe_js_eval" = "1" ]; then + compile_options="$compile_options (unsafe-js-eval #t)" + fi + if [ -n "$compiler_path" ]; then + if [ "$unsafe_js_eval" = "1" ]; then + echo "Error: unsafe JS eval is not available for Wasm-GC compiler artifact builds" >&2 + exit 1 + fi + if [ -n "$import_manifest" ] || [ -n "$emit_ir" ] || [ -n "$emit_analysis" ] || [ -n "$emit_size_report" ]; then + echo "Error: --compiler cannot emit stage0 IR, analysis, size, or import-manifest artifacts" >&2 + exit 1 + fi + compiler_args=(node "$JERBOA_HOME/support/wasm-gc/compiler-runner.mjs" --compiler "$compiler_path" --target "$target" "-O$opt_level") + if [ -n "$source_manifest" ]; then + compiler_args+=(--source-manifest "$source_manifest") + fi + if [ "$debug_names" = "1" ]; then + compiler_args+=(--debug-names) + fi + if [ "${#exports[@]}" -gt 0 ]; then + for export_name in "${exports[@]}"; do + compiler_args+=(--export "$export_name") + done + fi + compiler_args+=("$source" -o "$output") + exec "${compiler_args[@]}" + elif [ -n "$source_manifest" ]; then + echo "Error: --source-manifest requires --compiler" >&2 + exit 1 + fi + compile_options="$compile_options)" + JERBOA_WASM_SOURCE="$source" JERBOA_WASM_OUTPUT="$output" JERBOA_WASM_OPTIONS="$compile_options" JERBOA_WASM_IMPORT_MANIFEST="$import_manifest" JERBOA_WASM_IR_OUTPUT="$emit_ir" JERBOA_WASM_ANALYSIS_OUTPUT="$emit_analysis" JERBOA_WASM_SIZE_REPORT_OUTPUT="$emit_size_report" \ + "$SCHEME" --libdirs "$LIBDIRS" --program "$JERBOA_HOME/support/wasm-gc/build-driver.ss" +} + +cmd_wasm() { + local sub="${1:-}" + if [ $# -gt 0 ]; then shift; fi + case "$sub" in + build) + cmd_wasm_build "$@" + ;; + validate) + if [ $# -eq 0 ]; then + echo "Usage: jerboa wasm validate module.wasm ..." >&2 + exit 2 + fi + exec node "$JERBOA_HOME/support/wasm-gc/validate.mjs" "$@" + ;; + bench) + if [ $# -eq 0 ]; then + echo "Usage: jerboa wasm bench [--quick] [--engine node[,chromium,firefox,safari]] benchmarks/wasm-gc/manifest.json [report.json]" >&2 + exit 2 + fi + exec node "$JERBOA_HOME/support/wasm-gc/benchmark-report.mjs" "$@" + ;; + package) + exec node "$JERBOA_HOME/support/wasm-gc/package-runtime.mjs" "$@" + ;; + build-compiler) + exec node "$JERBOA_HOME/support/wasm-gc/build-compiler-artifact.mjs" "$@" + ;; + self-host-check) + exec node "$JERBOA_HOME/support/wasm-gc/self-host-check.mjs" "$@" + ;; + inspect) + if [ $# -ne 1 ]; then + echo "Usage: jerboa wasm inspect module.wasm" >&2 + exit 2 + fi + node "$JERBOA_HOME/support/wasm-gc/check-abi.mjs" require "$1" + node "$JERBOA_HOME/support/wasm-gc/check-imports.mjs" manifest "$1" + ;; + run) + local backend="gc" + if [ "${1:-}" = "--backend" ]; then + shift + backend="${1:-}" + shift || true + fi + if [ "$backend" != "gc" ] && [ "$backend" != "wasm-gc" ]; then + echo "Error: only --backend gc is currently supported" >&2 + exit 1 + fi + if [ $# -eq 0 ]; then + echo "Usage: jerboa wasm run [--backend gc] module.wasm [export [expected [args...]]]" >&2 + exit 2 + fi + local file="$1" + shift + local export_name="${1:-main}" + if [ $# -gt 0 ]; then shift; fi + exec node "$JERBOA_HOME/support/wasm-gc/run-export.mjs" "$file" "$export_name" "$@" + ;; + help|--help|-h|"") + cat <<EOF +Usage: jerboa wasm <command> [args...] + +Commands: + build --backend gc [--target core|node|browser] [-O0|-O1|-O2] [--debug-names] [--export name | --exports a,b] [--emit-ir path] [--emit-analysis path] [--emit-size-report path] [--emit-import-manifest path] [--unsafe-js-eval] [--compiler compiler.wasm [--source-manifest sources.json]] program.ss -o program.wasm + run [--backend gc] module.wasm [export [expected [args...]]] + inspect module.wasm + validate module.wasm ... + bench [--quick] [--engine node[,chromium,firefox,safari]] [--allow-missing-engine] benchmarks/wasm-gc/manifest.json [report.json] + package [-o output-dir] [--compiler compiler.wasm --self-hosting-evidence evidence.json] [--version version] + build-compiler --source compiler.ss [--source-manifest compiler-sources.json] -o stage1.wasm [--manifest stage1.manifest.json] [--flattened-source flattened.ss] [--source-audit-report audit.json] + self-host-check --compiler stage1.wasm --compiler-source compiler.ss [--compiler-source-manifest compiler-sources.json] (--fixture fixture.ss [--fixture-source-manifest fixture-sources.json] [--fixture-target core|node|browser] [--fixture-O0|--fixture-O1|--fixture-O2] [--fixture-debug-names] [--fixture-export name] ... | --fixture-manifest fixtures.json) -o self-hosting-evidence.json +EOF + ;; + *) + echo "Error: unknown wasm command '$sub'" >&2 + exit 1 + ;; + esac +} + cmd_version() { echo "jerboa $VERSION" echo "home: $JERBOA_HOME" @@ -362,6 +652,10 @@ case "${1:-}" in shift cmd_test "$@" ;; + wasm) + shift + cmd_wasm "$@" + ;; build) cmd_build ;; --- a/browser-repl/Cargo.toml +++ b/browser-repl/Cargo.toml @@ -8,9 +8,8 @@ publish = false crate-type = ["cdylib", "rlib"] [profile.release] -opt-level = "s" +opt-level = "z" lto = true codegen-units = 1 panic = "abort" strip = true - --- a/browser-repl/src/lib.rs +++ b/browser-repl/src/lib.rs @@ -1,19 +1,30 @@ use std::cell::{Cell, RefCell}; -use std::collections::BTreeMap; +use std::collections::{BTreeMap, BTreeSet}; use std::fmt::Write as _; use std::rc::Rc; const ABI_VERSION: u32 = 1; const MAX_SOURCE_BYTES: usize = 65_536; +const MAX_TOKENS: usize = 16_384; +const MAX_AST_NODES: usize = 16_384; const DEFAULT_STEPS: u32 = 250_000; const HARD_MAX_STEPS: u32 = 1_000_000; const MAX_DEPTH: u32 = 256; const MAX_OUTPUT_BYTES: usize = 131_072; -const SUBSET_REVISION: &str = "browser-subset-1"; +const MAX_RESULT_JSON_BYTES: usize = 262_144; +const MAX_TOP_LEVEL_EVALS: u32 = 256; +const MAX_USER_BINDINGS: usize = 2_048; +const MAX_STRING_BYTES: usize = 65_536; +const MAX_LIST_TRAVERSAL: usize = 16_384; +const UNICODE_SCALAR_COUNT: i64 = 0x110000 - 0x800; +const WASM_MEMORY_MAX_BYTES: usize = 33_554_432; +const SUBSET_REVISION: &str = "browser-subset-120"; const ENGINE_VERSION: &str = env!("CARGO_PKG_VERSION"); +const BROWSER_RANDOM_SEED: u64 = 0x5eed_5eed_c0de_cafe; thread_local! { static STATE: RefCell<State> = RefCell::new(State::new()); + static RANDOM_STATE: Cell<u64> = const { Cell::new(BROWSER_RANDOM_SEED) }; } struct State { @@ -106,64 +117,291 @@ pub extern "C" fn repl_engine_info() -> u32 { STATE.with(|state| { let mut state = state.borrow_mut(); let text = format!( - "{{\"abi\":{},\"status\":\"ok\",\"events\":[{{\"kind\":\"value\",\"text\":\"engine {} subset {} source_bytes {} default_steps {} max_steps {} depth {} output_bytes {}\"}}],\"steps\":0,\"error\":null}}", - ABI_VERSION, - json_text(ENGINE_VERSION), - json_text(SUBSET_REVISION), + "engine {} subset {} source_bytes {} tokens {} ast_nodes {} default_steps {} max_steps {} depth {} top_level_evals {} user_bindings {} string_bytes {} list_traversal {} output_bytes {} result_json_bytes {} wasm_memory_bytes {}", + ENGINE_VERSION, + SUBSET_REVISION, MAX_SOURCE_BYTES, + MAX_TOKENS, + MAX_AST_NODES, DEFAULT_STEPS, HARD_MAX_STEPS, MAX_DEPTH, - MAX_OUTPUT_BYTES + MAX_TOP_LEVEL_EVALS, + MAX_USER_BINDINGS, + MAX_STRING_BYTES, + MAX_LIST_TRAVERSAL, + MAX_OUTPUT_BYTES, + MAX_RESULT_JSON_BYTES, + WASM_MEMORY_MAX_BYTES ); - state.result = text.into_bytes(); + state.result = envelope("ok", &[Event::value(text)], 0, None).into_bytes(); 0 }) } -#[derive(Clone, Debug, PartialEq, Eq)] +#[derive(Clone, Debug, PartialEq)] enum Expr { Bool(bool), + Char(char), Int(i64), + Rational(i64, i64), + ExactComplex(i64, i64, i64, i64), + Float(f64), + Complex(f64, f64), Str(String), Symbol(String), + Keyword(String), + Eof, + Special(SpecialObject), List(Vec<Expr>), + BracketList(Vec<Expr>), + BraceList(Vec<Expr>), + Vector(Vec<Expr>), + ByteVector(Vec<u8>), + DottedList(Vec<Expr>, Box<Expr>), + BracketDottedList(Vec<Expr>, Box<Expr>), + Void, } #[derive(Clone)] enum Value { Nil, Bool(bool), + Char(char), Int(i64), - Str(String), + Rational(i64, i64), + ExactComplex(i64, i64, i64, i64), + Float(f64), + Complex(f64, f64), + Str(Rc<RefCell<String>>), Symbol(String), - Pair(Rc<(Value, Value)>), + UninternedSymbol(String), + Keyword(String), + Eof, + Special(SpecialObject), + Pair(Rc<RefCell<(Value, Value)>>), + Vector(Rc<RefCell<Vec<Value>>>), + ByteVector(Rc<RefCell<Vec<u8>>>), + HVector(Rc<RefCell<HVector>>), + CharSet(Rc<RefCell<CharSet>>), + Table(Rc<RefCell<TableObject>>), + HashTable(Rc<RefCell<Vec<(Value, Value)>>>), + SymbolicTable(Rc<RefCell<Vec<(Value, Value)>>>), + StructType(Rc<StructType>), + StructInstance(Rc<StructInstance>), + StructConstructor(Rc<StructType>), + StructPredicate(Rc<StructType>), + StructAccessor(Rc<StructType>, usize), + StructMutator(Rc<StructType>, usize), + BoundMethod(Rc<BoundMethod>), + InterfaceDescriptor(Rc<InterfaceDescriptor>), + InterfaceInstance(Rc<InterfaceInstance>), + InterfaceCaster(Rc<InterfaceDescriptor>, bool), + InterfacePredicate(Rc<InterfaceDescriptor>, InterfacePredicateKind), + InterfaceMethod(Rc<InterfaceDescriptor>, String, bool), + Thread(Rc<ThreadObject>), + Ast(Rc<AstObject>), + Box(Rc<RefCell<Value>>), + Promise(Rc<Promise>), + InputStringPort(Rc<RefCell<InputStringPort>>), + OutputStringPort(Rc<RefCell<String>>), + InputByteVectorPort(Rc<RefCell<InputByteVectorPort>>), + OutputByteVectorPort(Rc<RefCell<Vec<u8>>>), + InputVectorPort(Rc<RefCell<InputVectorPort>>), + OutputVectorPort(Rc<RefCell<Vec<Value>>>), + StdoutPort, + ErrorObject(Rc<ErrorObject>), + Parameter(Rc<Parameter>), + Values(Vec<Value>), Prim(fn(&[Value], &mut EvalContext) -> Result<Value, Error>), Closure(Rc<Closure>), + CaseClosure(Vec<Rc<Closure>>), Void, } +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +enum SpecialObject { + Key, + Rest, + Optional, + Absent, +} + +#[derive(Clone, Copy, PartialEq, Eq)] +enum TableEqMode { + Eq, + Eqv, + Equal, +} + +#[derive(Clone)] +struct TableObject { + entries: Vec<(Value, Value)>, + eq_mode: TableEqMode, +} + +#[derive(Clone, Copy, PartialEq, Eq)] +enum HVectorKind { + S8, + U16, + S16, + U32, + S32, + U64, + S64, + F32, + F64, +} + +#[derive(Clone)] +struct HVector { + kind: HVectorKind, + values: Vec<Value>, +} + +#[derive(Clone, PartialEq, Eq)] +struct CharSet { + inverted: bool, + chars: BTreeSet<char>, +} + +struct Promise { + state: RefCell<PromiseState>, +} + +struct InputStringPort { + chars: Vec<char>, + idx: usize, +} + +struct InputByteVectorPort { + bytes: Vec<u8>, + idx: usize, +} + +struct InputVectorPort { + values: Vec<Value>, + idx: usize, +} + +struct StructType { + id: String, + name: String, + fields: Vec<String>, + supers: Vec<Rc<StructType>>, + properties: Vec<(Value, Value)>, + constructor: Option<String>, + keyword_constructor: bool, + methods: RefCell<BTreeMap<String, Value>>, +} + +thread_local! { + static HASH_TABLE_TYPE: Rc<StructType> = Rc::new(make_static_struct_type("HashTable", &[], false)); + static THREAD_TYPE: Rc<StructType> = Rc::new(make_static_struct_type("thread", &[], false)); +} + +struct StructInstance { + typ: Rc<StructType>, + fields: RefCell<Vec<Value>>, +} + +struct BoundMethod { + object: Value, + proc: Value, +} + +struct InterfaceDescriptor { + name: String, + methods: Vec<String>, + typ: Rc<StructType>, +} + +struct InterfaceInstance { + descriptor: Rc<InterfaceDescriptor>, + object: Value, +} + +struct ThreadObject { + name: Option<String>, + group: Value, + result: Value, + actor: bool, +} + +#[derive(Clone, Copy)] +enum InterfacePredicateKind { + Exact, + Satisfies, +} + +struct AstObject { + datum: Value, + source: Value, +} + +enum PromiseState { + Unevaluated { expr: Expr, env: Env }, + Thunk(Value), + Evaluating, + Evaluated(Value), +} + +#[derive(Clone)] +struct ErrorObject { + error: Error, + irritants: Vec<Value>, +} + +struct Parameter { + value: RefCell<Value>, + converter: Option<Value>, +} + #[derive(Clone)] struct Closure { params: Vec<String>, + opt: Vec<OptionalParam>, + keywords: Vec<KeywordParam>, + rest: Option<String>, body: Vec<Expr>, env: Env, } +#[derive(Clone)] +struct OptionalParam { + name: String, + default: Expr, +} + +#[derive(Clone)] +struct KeywordParam { + keyword: String, + name: String, + default: Option<Expr>, +} + type Env = Rc<Frame>; struct Frame { parent: Option<Env>, values: RefCell<BTreeMap<String, Value>>, + constants: RefCell<BTreeSet<String>>, read_only: Cell<bool>, + max_bindings: Option<usize>, } impl Frame { fn new(parent: Option<Env>, read_only: bool) -> Env { + Self::with_limit(parent, read_only, None) + } + + fn with_limit(parent: Option<Env>, read_only: bool, max_bindings: Option<usize>) -> Env { Rc::new(Self { parent, values: RefCell::new(BTreeMap::new()), + constants: RefCell::new(BTreeSet::new()), read_only: Cell::new(read_only), + max_bindings, }) } @@ -171,13 +409,30 @@ impl Frame { if self.read_only.get() { return Err(Error::eval("cannot modify read-only environment")); } - self.values.borrow_mut().insert(name, value); + if self.constants.borrow().contains(&name) { + return Err(Error::eval("cannot redefine constant binding")); + } + let mut values = self.values.borrow_mut(); + if !values.contains_key(&name) + && self + .max_bindings + .is_some_and(|max_bindings| values.len() >= max_bindings) + { + return Err(Error::limit("user binding limit exceeded")); + } + values.insert(name, value); + Ok(()) + } + + fn define_const(&self, name: String, value: Value) -> Result<(), Error> { + self.define(name.clone(), value)?; + self.constants.borrow_mut().insert(name); Ok(()) } fn set(&self, name: &str, value: Value) -> Result<(), Error> { if self.values.borrow().contains_key(name) { - if self.read_only.get() { + if self.read_only.get() || self.constants.borrow().contains(name) { return Err(Error::eval("cannot modify read-only binding")); } self.values.borrow_mut().insert(name.to_owned(), value); @@ -200,6 +455,9 @@ impl Frame { struct Session { env: Env, + top_level_evals: u32, + thread_locals: Rc<RefCell<Vec<(Value, Value)>>>, + gensym_counter: Rc<Cell<u64>>, } impl Session { @@ -208,23 +466,51 @@ impl Session { install_primitives(&prim); prim.read_only_set(); Self { - env: Frame::new(Some(prim), false), + env: Frame::with_limit(Some(prim), false, Some(MAX_USER_BINDINGS)), + top_level_evals: 0, + thread_locals: Rc::new(RefCell::new(Vec::new())), + gensym_counter: Rc::new(Cell::new(0)), } } fn eval_source(&mut self, source: &str, step_budget: u32) -> Response { + if self.top_level_evals >= MAX_TOP_LEVEL_EVALS { + return Response::new( + "limit", + vec![], + 0, + Some(Error::limit( + "top-level evaluation limit exceeded; reset the session", + )), + ); + } let forms = match Reader::new(source).read_all() { Ok(forms) => forms, Err(err) => return Response::new("reader-error", vec![], 0, Some(err)), }; + if self.top_level_evals.saturating_add(forms.len() as u32) > MAX_TOP_LEVEL_EVALS { + return Response::new( + "limit", + vec![], + 0, + Some(Error::limit( + "top-level evaluation limit exceeded; reset the session", + )), + ); + } let mut cx = EvalContext { steps_left: step_budget, steps_used: 0, depth: 0, events: Vec::new(), stdout: String::new(), + current_input: None, + current_output: None, + thread_locals: self.thread_locals.clone(), + gensym_counter: self.gensym_counter.clone(), }; for form in forms { + self.top_level_evals += 1; match eval(&form, self.env.clone(), &mut cx) { Ok(value) => { if !cx.stdout.is_empty() { @@ -263,6 +549,83 @@ struct EvalContext { depth: u32, events: Vec<Event>, stdout: String, + current_input: Option<Rc<RefCell<InputStringPort>>>, + current_output: Option<Rc<RefCell<String>>>, + thread_locals: Rc<RefCell<Vec<(Value, Value)>>>, + gensym_counter: Rc<Cell<u64>>, +} + +fn make_builtin_class(name: &str) -> Value { + Value::StructType(Rc::new(make_static_struct_type(name, &[], false))) +} + +fn make_static_struct_type(name: &str, fields: &[&str], keyword_constructor: bool) -> StructType { + StructType { + id: name.to_owned(), + name: name.to_owned(), + fields: fields.iter().map(|field| (*field).to_owned()).collect(), + supers: Vec::new(), + properties: Vec::new(), + constructor: None, + keyword_constructor, + methods: RefCell::new(BTreeMap::new()), + } +} + +fn hash_table_type() -> Rc<StructType> { + HASH_TABLE_TYPE.with(Clone::clone) +} + +fn thread_type() -> Rc<StructType> { + THREAD_TYPE.with(Clone::clone) +} + +fn install_hash_table_interface(map: &mut BTreeMap<String, Value>, typ: Rc<StructType>) { + let methods = [ + "clear!", "copy", "delete!", "for-each", "length", "ref", "set!", "update!", + ] + .iter() + .map(|method| (*method).to_owned()) + .collect::<Vec<_>>(); + let descriptor = Rc::new(InterfaceDescriptor { + name: "HashTable".to_owned(), + methods: methods.clone(), + typ, + }); + map.insert( + "HashTable".to_owned(), + Value::InterfaceCaster(descriptor.clone(), false), + ); + map.insert( + "make-HashTable".to_owned(), + Value::InterfaceCaster(descriptor.clone(), false), + ); + map.insert( + "try-HashTable".to_owned(), + Value::InterfaceCaster(descriptor.clone(), true), + ); + map.insert( + "HashTable::interface".to_owned(), + Value::InterfaceDescriptor(descriptor.clone()), + ); + map.insert( + "HashTable?".to_owned(), + Value::InterfacePredicate(descriptor.clone(), InterfacePredicateKind::Exact), + ); + map.insert( + "is-HashTable?".to_owned(), + Value::InterfacePredicate(descriptor.clone(), InterfacePredicateKind::Satisfies), + ); + for method in methods { + map.insert( + format!("HashTable-{method}"), + Value::InterfaceMethod(descriptor.clone(), method.clone(), true), + ); + map.insert( + format!("&HashTable-{method}"), + Value::InterfaceMethod(descriptor.clone(), method, false), + ); + }