giles
9efbf4ad38
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 43s
lib/guest/reflective/env.sx — added refl-env-find-frame-with (returns
the scope where NAME is bound, or nil). Needed by consumers like
Smalltalk that mutate variables at the source frame rather than
shadowing at the current one. Also added refl-env-find-frame for
the canonical shape.
lib/smalltalk/eval.sx — new st-frame-cfg adapter for the kit.
st-lookup-local now delegates parent-walk to refl-env-find-frame-with
while preserving its Smalltalk-flavoured {:found :value :frame}
return shape (which is used to mutate at the binding's source
frame, not the current one).
lib/smalltalk/test.sh + compare.sh — load lib/guest/reflective/env.sx
before lib/smalltalk/eval.sx.
Three genuinely different wire shapes now share the parent-walk:
- Kernel: {:refl-tag :env :bindings :parent} mutable bindings
- Tcl: {:level :locals :parent} functional update
- Smalltalk: {:self :method-class :locals :parent mutable bindings,
:return-k :active-cell} rich metadata
All three consumers' full test suites unchanged: Smalltalk 847/847,
Kernel 322/322, Tcl 427/427. The cfg adapter pattern (modelled after
lib/guest/match.sx) cleanly handles all three.
92 lines
2.9 KiB
Bash
Executable File
92 lines
2.9 KiB
Bash
Executable File
#!/usr/bin/env bash
|
|
# Smalltalk-on-SX vs. GNU Smalltalk timing comparison.
|
|
#
|
|
# Runs a small benchmark (fibonacci 25, quicksort of a 50-element array,
|
|
# arithmetic sum 1..1000) on both runtimes and reports the ratio.
|
|
#
|
|
# GNU Smalltalk (`gst`) must be installed and on $PATH. If it isn't,
|
|
# the script prints a friendly message and exits with status 0 — this
|
|
# lets CI runs that don't have gst available pass cleanly.
|
|
#
|
|
# Usage: bash lib/smalltalk/compare.sh
|
|
|
|
set -uo pipefail
|
|
cd "$(git rev-parse --show-toplevel)"
|
|
|
|
OUT="lib/smalltalk/compare-results.txt"
|
|
|
|
if ! command -v gst >/dev/null 2>&1; then
|
|
echo "Note: GNU Smalltalk (gst) not found on \$PATH."
|
|
echo " The comparison harness is in place at $0 but cannot run"
|
|
echo " until gst is installed (\`apt-get install gnu-smalltalk\`"
|
|
echo " on Debian-derived systems). Skipping."
|
|
exit 0
|
|
fi
|
|
|
|
SX="hosts/ocaml/_build/default/bin/sx_server.exe"
|
|
if [ ! -x "$SX" ]; then
|
|
MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
|
|
SX="$MAIN_ROOT/$SX"
|
|
fi
|
|
|
|
# A trio of small benchmarks. Each is a Smalltalk expression that the
|
|
# canonical impls evaluate to the same value.
|
|
BENCH_FIB='Object subclass: #B instanceVariableNames: ""! !B methodsFor: "x"! fib: n n < 2 ifTrue: [^ n]. ^ (self fib: n - 1) + (self fib: n - 2)! ! Transcript show: (B new fib: 22) printString; nl'
|
|
|
|
run_sx () {
|
|
local label="$1"; local source="$2"
|
|
local tmp=$(mktemp)
|
|
cat > "$tmp" <<EOF
|
|
(epoch 1)
|
|
(load "lib/smalltalk/tokenizer.sx")
|
|
(load "lib/smalltalk/parser.sx")
|
|
(load "lib/smalltalk/runtime.sx")
|
|
(load "lib/guest/reflective/env.sx")
|
|
(load "lib/smalltalk/eval.sx")
|
|
(epoch 2)
|
|
(eval "(begin (st-bootstrap-classes!) (smalltalk-load \"Object subclass: #B instanceVariableNames: ''! !B methodsFor: 'x'! fib: n n < 2 ifTrue: [^ n]. ^ (self fib: n - 1) + (self fib: n - 2)! !\") (smalltalk-eval-program \"^ B new fib: 22\"))")
|
|
EOF
|
|
local start=$(date +%s.%N)
|
|
timeout 60 "$SX" < "$tmp" > /dev/null 2>&1
|
|
local rc=$?
|
|
local end=$(date +%s.%N)
|
|
rm -f "$tmp"
|
|
local elapsed=$(awk "BEGIN{print $end - $start}")
|
|
echo "$label: ${elapsed}s (rc=$rc)"
|
|
}
|
|
|
|
run_gst () {
|
|
local label="$1"
|
|
local tmp=$(mktemp)
|
|
cat > "$tmp" <<EOF
|
|
| start delta b |
|
|
b := Object subclass: #B
|
|
instanceVariableNames: ''
|
|
classVariableNames: ''
|
|
package: 'demo'.
|
|
b compile: 'fib: n n < 2 ifTrue: [^ n]. ^ (self fib: n - 1) + (self fib: n - 2)'.
|
|
start := Time millisecondClock.
|
|
B new fib: 22.
|
|
delta := Time millisecondClock - start.
|
|
Transcript show: 'gst ', delta printString, 'ms'; nl.
|
|
EOF
|
|
local start=$(date +%s.%N)
|
|
timeout 60 gst -q "$tmp" > /dev/null 2>&1
|
|
local rc=$?
|
|
local end=$(date +%s.%N)
|
|
rm -f "$tmp"
|
|
local elapsed=$(awk "BEGIN{print $end - $start}")
|
|
echo "$label: ${elapsed}s (rc=$rc)"
|
|
}
|
|
|
|
{
|
|
echo "Smalltalk-on-SX vs GNU Smalltalk — fibonacci(22)"
|
|
echo "Generated: $(date -u +%Y-%m-%dT%H:%M:%SZ)"
|
|
echo
|
|
run_sx "smalltalk-on-sx (call/cc + dict ivars)"
|
|
run_gst "gnu smalltalk"
|
|
} | tee "$OUT"
|
|
|
|
echo
|
|
echo "Saved: $OUT"
|