russell@unturf.com
81ac49ece0
Substrate for fork-per-accept pattern in gpu-worker.lsp — enables async bend dispatch with internal load balancing. c-tier (builtins.c): - bi_fork_self: fork() wrapper, returns 0 in child / pid in parent / #f on fail - bi_waitpid_nonblock: waitpid(-1, WNOHANG), returns reaped pid or 0 - bi_exit_immediate: _exit() wrapper — REQUIRED in fork-self children, regular exit() runs atexit handlers against shared parent state and hangs the child (observed empirically 2026-06-11 via vm-runner.sh). - bi_sleep: real wall-clock sleep(3) — yields CPU. Replaces busy-loop patterns that would (a) burn CPU and (b) SIGKILL in cgroup-limited VMs (observed: 100M iter let-loop SIGKILL'd after 5s in qemu vm). python-tier (lumbda.py): _fork_self / _waitpid_nonblock / _exit_immediate / _sleep mirrors via os.fork / os.waitpid / os._exit / time.sleep. Tested in vm-runner.sh VM (Ubuntu 2G/2vCPU): 3-child fork-cycle test spawns + reaps cleanly 3/3 in both c-tier + python-tier. The exact test pattern that crashed neoblanka host pre-fix now works fine. Asm tier: deferred. Lock retained at chmod a-x ~/git/lumbda/asm/lumbda* per CLAUDE.md threat model.
4352 lines
187 KiB
Python
4352 lines
187 KiB
Python
#!/usr/bin/env python3
|
||
"""
|
||
lumbda — a Lisp in one Python file.
|
||
Usage: python3 lumbda.py [script.lsp] # run a file
|
||
python3 lumbda.py # interactive REPL
|
||
python3 lumbda.py -e '(+ 1 2)' # eval expression
|
||
"""
|
||
import sys, re, math, itertools, os as _os
|
||
from fractions import Fraction
|
||
try: import readline
|
||
except ImportError: pass
|
||
|
||
###############################################################################
|
||
# Types
|
||
###############################################################################
|
||
|
||
class Symbol(str):
|
||
"""Interned symbol — identity comparison works."""
|
||
_t: dict = {}
|
||
def __new__(cls, s):
|
||
if s not in cls._t: cls._t[s] = str.__new__(cls, s)
|
||
return cls._t[s]
|
||
def __repr__(self): return str(self)
|
||
|
||
S = Symbol # short alias
|
||
|
||
class _Nil:
|
||
_i = None
|
||
def __new__(cls):
|
||
if cls._i is None: cls._i = super().__new__(cls)
|
||
return cls._i
|
||
def __repr__(self): return '()'
|
||
def __bool__(self): return False
|
||
def __iter__(self): return iter(())
|
||
def __len__(self): return 0
|
||
|
||
NIL = _Nil()
|
||
|
||
class Pair:
|
||
__slots__ = ('car', 'cdr', '_line')
|
||
def __init__(self, a, d): self.car = a; self.cdr = d; self._line = None
|
||
def __iter__(self):
|
||
n = self
|
||
while isinstance(n, Pair): yield n.car; n = n.cdr
|
||
if n is not NIL: raise TypeError('improper list')
|
||
def __len__(self):
|
||
c = 0; n = self
|
||
while isinstance(n, Pair): c += 1; n = n.cdr
|
||
return c
|
||
def __repr__(self):
|
||
parts = []; n = self
|
||
while isinstance(n, Pair): parts.append(show(n.car)); n = n.cdr
|
||
return '(' + ' '.join(parts) + ('' if n is NIL else ' . ' + show(n)) + ')'
|
||
|
||
def _has_internal_defines(body):
|
||
"""Check if body starts with a define form (for fast path in _body_env)."""
|
||
return bool(body) and isinstance(body[0], Pair) and (
|
||
body[0].car is S('define') or body[0].car is S('begin'))
|
||
|
||
class Proc:
|
||
__slots__ = ('params', 'rest', 'body', 'env', 'name', 'has_defs')
|
||
def __init__(self, params, rest, body, env, name=None):
|
||
self.params = params; self.rest = rest
|
||
self.body = body; self.env = env; self.name = name
|
||
self.has_defs = _has_internal_defines(body)
|
||
def __repr__(self): return f'#<procedure {self.name or "λ"}>'
|
||
|
||
class Macro:
|
||
__slots__ = ('xfm',)
|
||
def __init__(self, xfm): self.xfm = xfm
|
||
def __repr__(self):
|
||
name = getattr(self.xfm, 'name', None) or '?'
|
||
return f'#<macro {name}>'
|
||
|
||
class _EllBind(list):
|
||
"""Marks a binding as an ellipsis (list of matched items), not a vector."""
|
||
pass
|
||
|
||
class _SyntaxTransformer:
|
||
"""Implements (syntax-rules (lit ...) (pattern template) ...)."""
|
||
def __init__(self, literals, rules, def_env):
|
||
self.literals = frozenset(str(x) for x in _L(literals))
|
||
self.rules = []
|
||
for r in _L(rules):
|
||
rl = _L(r); self.rules.append((rl[0], rl[1]))
|
||
self.def_env = def_env
|
||
|
||
def __call__(self, args, use_env):
|
||
form = _P(args)
|
||
for pat, tmpl in self.rules:
|
||
# pat.cdr is the actual pattern (skip keyword)
|
||
b = {}
|
||
if self._match(pat.cdr if isinstance(pat, Pair) else NIL, form, b):
|
||
return self._expand(tmpl, b)
|
||
raise LispErr(f'syntax error: no matching syntax-rules pattern')
|
||
|
||
def _pat_vars(self, pat):
|
||
if isinstance(pat, Symbol):
|
||
return {pat} if str(pat) not in self.literals and pat is not S('_') and pat is not S('...') else set()
|
||
if isinstance(pat, Pair): return self._pat_vars(pat.car) | self._pat_vars(pat.cdr)
|
||
return set()
|
||
|
||
def _match(self, pat, form, b):
|
||
if pat is NIL: return form is NIL
|
||
if isinstance(pat, bool): return pat == form
|
||
if isinstance(pat, (int, float, str)) and not isinstance(pat, Symbol): return pat == form
|
||
if isinstance(pat, Symbol):
|
||
if str(pat) in self.literals: return isinstance(form, Symbol) and str(form) == str(pat)
|
||
if pat is S('_'): return True
|
||
b[str(pat)] = form; return True
|
||
if not isinstance(pat, Pair): return pat == form
|
||
# Ellipsis: (sub_pat ... . rest_pat)
|
||
if isinstance(pat.cdr, Pair) and pat.cdr.car is S('...'):
|
||
sub_pat = pat.car; rest_pat = pat.cdr.cdr
|
||
pvars = self._pat_vars(sub_pat)
|
||
eb = {str(v): _EllBind() for v in pvars}
|
||
# count required tail elements
|
||
n_rest = 0; rp = rest_pat
|
||
while isinstance(rp, Pair): n_rest += 1; rp = rp.cdr
|
||
items = list(form) if isinstance(form, Pair) else []
|
||
n_ell = len(items) - n_rest
|
||
if n_ell < 0: return False
|
||
for item in items[:n_ell]:
|
||
ib = {}
|
||
if not self._match(sub_pat, item, ib): return False
|
||
for v in pvars: eb[str(v)].append(ib.get(str(v), VOID))
|
||
b.update(eb)
|
||
rest_form = _P(items[n_ell:])
|
||
return self._match(rest_pat, rest_form, b)
|
||
# Normal pair
|
||
if not isinstance(form, Pair): return False
|
||
return self._match(pat.car, form.car, b) and self._match(pat.cdr, form.cdr, b)
|
||
|
||
def _ell_vars(self, tmpl, b):
|
||
"""Symbols in tmpl that have _EllBind bindings."""
|
||
result = set()
|
||
if isinstance(tmpl, Symbol):
|
||
if str(tmpl) in b and isinstance(b[str(tmpl)], _EllBind): result.add(str(tmpl))
|
||
elif isinstance(tmpl, Pair):
|
||
result |= self._ell_vars(tmpl.car, b); result |= self._ell_vars(tmpl.cdr, b)
|
||
return result
|
||
|
||
def _expand(self, tmpl, b):
|
||
if tmpl is NIL or isinstance(tmpl, bool) or isinstance(tmpl, (int, float)): return tmpl
|
||
if isinstance(tmpl, str) and not isinstance(tmpl, Symbol): return tmpl
|
||
if isinstance(tmpl, Symbol):
|
||
if str(tmpl) in b:
|
||
v = b[str(tmpl)]
|
||
if isinstance(v, _EllBind): raise LispErr(f'syntax-rules: {tmpl} used without ...')
|
||
return v
|
||
return tmpl
|
||
if not isinstance(tmpl, Pair): return tmpl
|
||
# Ellipsis in template: (sub_tmpl ...)
|
||
if isinstance(tmpl.cdr, Pair) and tmpl.cdr.car is S('...'):
|
||
sub_tmpl = tmpl.car; rest_tmpl = tmpl.cdr.cdr
|
||
evars = self._ell_vars(sub_tmpl, b)
|
||
if not evars: raise LispErr(f'syntax-rules: no ellipsis var in {show(sub_tmpl)}')
|
||
n = len(b[next(iter(evars))])
|
||
expanded = []
|
||
for i in range(n):
|
||
sb = dict(b)
|
||
for v in evars: sb[v] = b[v][i]
|
||
expanded.append(self._expand(sub_tmpl, sb))
|
||
rest = self._expand(rest_tmpl, b)
|
||
for x in reversed(expanded): rest = Pair(x, rest)
|
||
return rest
|
||
return Pair(self._expand(tmpl.car, b), self._expand(tmpl.cdr, b))
|
||
|
||
class _Void:
|
||
_i = None
|
||
def __new__(cls):
|
||
if cls._i is None: cls._i = super().__new__(cls)
|
||
return cls._i
|
||
def __repr__(self): return ''
|
||
|
||
VOID = _Void()
|
||
|
||
class _EOF:
|
||
_i = None
|
||
def __new__(cls):
|
||
if cls._i is None: cls._i = super().__new__(cls)
|
||
return cls._i
|
||
def __repr__(self): return '#<eof>'
|
||
|
||
EOF = _EOF()
|
||
|
||
class LispErr(Exception):
|
||
def __init__(self, msg, obj=None):
|
||
super().__init__(msg); self.obj = obj # obj is ErrorObject or None
|
||
self.call_stack = list(_call_stack)
|
||
self.source_line = None # filled in by VM when source map available
|
||
|
||
class ErrorObject:
|
||
"""R7RS error object — carried by LispErr when raised via (error ...)."""
|
||
__slots__ = ('msg', 'irritants')
|
||
def __init__(self, msg, irritants=()):
|
||
self.msg = msg; self.irritants = list(irritants)
|
||
def __str__(self):
|
||
if self.irritants:
|
||
return self.msg + ': ' + ' '.join(show(x) for x in self.irritants)
|
||
return self.msg
|
||
def __repr__(self): return f'#<error-object {self.msg!r}>'
|
||
|
||
class StringInputPort:
|
||
"""String input port — (open-input-string s)."""
|
||
def __init__(self, s): self._src = s; self._pos = 0
|
||
def read(self, n=-1):
|
||
if n < 0: r = self._src[self._pos:]; self._pos = len(self._src); return r
|
||
r = self._src[self._pos:self._pos+n]; self._pos += len(r); return r
|
||
def readline(self):
|
||
end = self._src.find('\n', self._pos)
|
||
if end < 0: r = self._src[self._pos:]; self._pos = len(self._src)
|
||
else: r = self._src[self._pos:end+1]; self._pos = end+1
|
||
return r
|
||
def read_datum(self):
|
||
"""Read one Lisp datum, advance position past it."""
|
||
remaining = self._src[self._pos:]
|
||
tok_spans = [(m.group(), m.end()) for m in _TOK_RE.finditer(remaining)
|
||
if not m.group().startswith(';')]
|
||
if not tok_spans: return EOF
|
||
toks = [t for t, _ in tok_spans]
|
||
try:
|
||
expr, n = _read(toks, 0)
|
||
self._pos += tok_spans[n - 1][1]
|
||
return expr
|
||
except (LispErr, IndexError): return EOF
|
||
def peek_char(self):
|
||
return self._src[self._pos] if self._pos < len(self._src) else EOF
|
||
def char_ready(self): return self._pos < len(self._src)
|
||
def close(self): pass
|
||
|
||
class StringOutputPort:
|
||
"""String output port — (open-output-string)."""
|
||
def __init__(self): self._buf = []
|
||
def write(self, s): self._buf.append(s); return len(s)
|
||
def flush(self): pass
|
||
def close(self): pass
|
||
def getvalue(self): return ''.join(self._buf)
|
||
|
||
class MutableString:
|
||
"""Mutable string for R7RS string-set!, string-copy!, string-fill!."""
|
||
__slots__ = ('_c',)
|
||
def __init__(self, s):
|
||
self._c = list(s) if isinstance(s, str) else list(s._c) if isinstance(s, MutableString) else list(s)
|
||
def __len__(self): return len(self._c)
|
||
def __getitem__(self, k):
|
||
if isinstance(k, slice): return ''.join(self._c[k])
|
||
return self._c[k]
|
||
def __setitem__(self, k, v): self._c[k] = v
|
||
def __str__(self): return ''.join(self._c)
|
||
def __repr__(self): return '"' + str(self) + '"'
|
||
def __eq__(self, o):
|
||
if isinstance(o, MutableString): return self._c == o._c
|
||
if isinstance(o, str): return str(self) == o
|
||
return NotImplemented
|
||
def __hash__(self): return hash(str(self))
|
||
def __contains__(self, x): return x in str(self)
|
||
def __add__(self, o): return str(self) + (str(o) if isinstance(o, MutableString) else o)
|
||
def __radd__(self, o): return o + str(self)
|
||
# String-like methods for compatibility
|
||
def upper(self): return str(self).upper()
|
||
def lower(self): return str(self).lower()
|
||
def strip(self): return str(self).strip()
|
||
def rstrip(self): return str(self).rstrip()
|
||
def split(self, *a): return str(self).split(*a)
|
||
def find(self, *a): return str(self).find(*a)
|
||
def replace(self, *a): return str(self).replace(*a)
|
||
def startswith(self, *a): return str(self).startswith(*a)
|
||
def endswith(self, *a): return str(self).endswith(*a)
|
||
def join(self, it): return str(self).join(str(x) if isinstance(x, MutableString) else x for x in it)
|
||
|
||
###############################################################################
|
||
# Printer
|
||
###############################################################################
|
||
|
||
def show(x, display=False):
|
||
if x is NIL: return '()'
|
||
if x is VOID: return ''
|
||
if x is True: return '#t'
|
||
if x is False: return '#f'
|
||
if isinstance(x, ErrorObject): return repr(x)
|
||
if isinstance(x, (CompiledProc, FullCont)): return repr(x)
|
||
if isinstance(x, Fraction): return f'{x.numerator}/{x.denominator}'
|
||
if isinstance(x, Pair): return repr(x)
|
||
if isinstance(x, list): # vector
|
||
return '#(' + ' '.join(show(e) for e in x) + ')'
|
||
if isinstance(x, MutableString):
|
||
if display: return str(x)
|
||
return ('"' + str(x).replace('\\', '\\\\').replace('"', '\\"')
|
||
.replace('\n', '\\n').replace('\t', '\\t') + '"')
|
||
if isinstance(x, str):
|
||
if isinstance(x, Symbol): return str(x)
|
||
if display: return x
|
||
return ('"' + x.replace('\\', '\\\\').replace('"', '\\"')
|
||
.replace('\n', '\\n').replace('\t', '\\t') + '"')
|
||
if isinstance(x, float):
|
||
if math.isinf(x): return '+inf.0' if x > 0 else '-inf.0'
|
||
if math.isnan(x): return '+nan.0'
|
||
s = repr(x)
|
||
# Ensure a decimal point for Scheme compatibility
|
||
if '.' not in s and 'e' not in s and 'n' not in s and 'i' not in s:
|
||
s += '.0'
|
||
return s
|
||
return repr(x)
|
||
|
||
###############################################################################
|
||
# Tokenizer
|
||
###############################################################################
|
||
|
||
_TOK_RE = re.compile(r'''
|
||
;[^\n]* | # line comment
|
||
"(?:[^"\\]|\\.)*" | # string literal
|
||
,@ | # unquote-splicing
|
||
[()\'`,] | # single-char tokens
|
||
\#[tf] | # booleans
|
||
\#\( | # vector #(
|
||
\#\\(?:space|newline|tab|return|null|escape|[^\s]) | # character
|
||
[^\s()"\'`,;]+ # atom
|
||
''', re.VERBOSE | re.IGNORECASE)
|
||
|
||
def _tokenize(src):
|
||
return [t for t in _TOK_RE.findall(src) if not t.startswith(';')]
|
||
|
||
def _tokenize_lines(src):
|
||
"""Tokenize with line numbers: returns list of (token, line_number) tuples.
|
||
|
||
MOAD-0001 fix: precompute line-start offsets once (one pass over src),
|
||
then bisect_right to map any token position -> line in O(log M).
|
||
Total cost: O(M + N log M) instead of the old O(N*M) scan sediment.
|
||
"""
|
||
# line_starts[k] = byte offset where line (k+1) begins; line 1 starts at 0.
|
||
line_starts = [0]
|
||
i = src.find('\n')
|
||
while i != -1:
|
||
line_starts.append(i + 1)
|
||
i = src.find('\n', i + 1)
|
||
from bisect import bisect_right
|
||
|
||
result = []
|
||
for m in _TOK_RE.finditer(src):
|
||
tok = m.group()
|
||
if tok.startswith(';'): continue
|
||
line = bisect_right(line_starts, m.start())
|
||
result.append((tok, line))
|
||
return result
|
||
|
||
###############################################################################
|
||
# Parser
|
||
###############################################################################
|
||
|
||
_QQ = {"'": S('quote'), '`': S('quasiquote'),
|
||
',': S('unquote'), ',@': S('unquote-splicing')}
|
||
|
||
def _read(toks, i):
|
||
if i >= len(toks): raise LispErr('unexpected EOF')
|
||
t = toks[i]; i += 1
|
||
# Support both plain tokens and (token, line) tuples
|
||
if isinstance(t, tuple): t, line = t
|
||
else: line = None
|
||
if t in _QQ:
|
||
v, i = _read(toks, i)
|
||
p = Pair(_QQ[t], Pair(v, NIL)); p._line = line
|
||
return p, i
|
||
if t == '(':
|
||
items = []; item_lines = []; tail = None
|
||
while True:
|
||
if i >= len(toks): raise LispErr('unclosed (')
|
||
ti = toks[i]; tiv = ti[0] if isinstance(ti, tuple) else ti
|
||
if tiv == ')': i += 1; break
|
||
if tiv == '.':
|
||
i += 1; tail, i = _read(toks, i)
|
||
ti2 = toks[i] if i < len(toks) else None
|
||
tiv2 = ti2[0] if isinstance(ti2, tuple) else ti2
|
||
if tiv2 != ')': raise LispErr('. without )')
|
||
i += 1; break
|
||
v, i = _read(toks, i); items.append(v)
|
||
r = NIL if tail is None else tail
|
||
for x in reversed(items): r = Pair(x, r)
|
||
if isinstance(r, Pair): r._line = line
|
||
return r, i
|
||
if t == '#(': # vector literal
|
||
items = []
|
||
while True:
|
||
if i >= len(toks): raise LispErr('unclosed #(')
|
||
ti = toks[i]; tiv = ti[0] if isinstance(ti, tuple) else ti
|
||
if tiv == ')': i += 1; break
|
||
v, i = _read(toks, i); items.append(v)
|
||
return items, i
|
||
if t == ')': raise LispErr('unexpected )')
|
||
return _atom(t), i
|
||
|
||
def _atom(t):
|
||
if t == '#t' or t == '#T': return True
|
||
if t == '#f' or t == '#F': return False
|
||
if t.startswith('#\\'):
|
||
n = t[2:]
|
||
return {'space': ' ', 'newline': '\n', 'tab': '\t',
|
||
'return': '\r', 'null': '\0', 'escape': '\x1b'}.get(n.lower(), n[0])
|
||
if t.startswith('"'):
|
||
return (t[1:-1].replace('\\"', '"').replace('\\n', '\n')
|
||
.replace('\\t', '\t').replace('\\\\', '\\').replace('\\r', '\r'))
|
||
try: return int(t)
|
||
except (ValueError, OverflowError): pass
|
||
# Float parse: gate against Python's float() accepting bare 'inf',
|
||
# 'infinity', 'nan' as IEEE specials — R7RS spells those +inf.0 /
|
||
# -inf.0 / +nan.0 explicitly. Without this guard, '(infinity) reads
|
||
# as (+inf.0) and '(nan) reads as (+nan.0).
|
||
if t == '+inf.0': return math.inf
|
||
if t == '-inf.0': return -math.inf
|
||
if t in ('+nan.0', '-nan.0'): return float('nan')
|
||
if re.fullmatch(r'[+-]?(\d+\.\d*|\.\d+|\d+)([eE][+-]?\d+)?', t):
|
||
try: return float(t)
|
||
except (ValueError, OverflowError): pass
|
||
# Rational literal n/d (e.g. 1/3, -2/5)
|
||
if re.fullmatch(r'-?\d+/-?\d+', t):
|
||
try:
|
||
f = Fraction(t)
|
||
return f if f.denominator != 1 else f.numerator
|
||
except (ValueError, ZeroDivisionError): pass
|
||
return S(t)
|
||
|
||
def read_all(src, track_lines=False):
|
||
toks = _tokenize_lines(src) if track_lines else _tokenize(src)
|
||
exprs = []; i = 0
|
||
while i < len(toks): e, i = _read(toks, i); exprs.append(e)
|
||
return exprs
|
||
|
||
###############################################################################
|
||
# Helpers
|
||
###############################################################################
|
||
|
||
def _L(x):
|
||
"""Lisp list → Python list (validates proper list)."""
|
||
if x is NIL: return []
|
||
if isinstance(x, Pair): return list(x)
|
||
raise LispErr(f'not a list: {show(x)}')
|
||
|
||
def _P(lst):
|
||
"""Python list → Lisp list."""
|
||
r = NIL
|
||
for x in reversed(lst): r = Pair(x, r)
|
||
return r
|
||
|
||
def _truthy(x): return x is not False
|
||
|
||
def _formals(f):
|
||
"""Parse lambda formals → (params: [Symbol], rest: Symbol|None)."""
|
||
if isinstance(f, Symbol): return [], f
|
||
if f is NIL: return [], None
|
||
ps = []; n = f
|
||
while isinstance(n, Pair):
|
||
if not isinstance(n.car, Symbol):
|
||
raise LispErr(f'param must be symbol: {show(n.car)}')
|
||
ps.append(n.car); n = n.cdr
|
||
if n is NIL: return ps, None
|
||
if not isinstance(n, Symbol): raise LispErr(f'rest param must be symbol: {show(n)}')
|
||
return ps, n
|
||
|
||
def _raise(e): raise e
|
||
|
||
def _body_env(forms, env):
|
||
"""Implement R7RS letrec* semantics for body internal defines.
|
||
Scans leading (define ...) forms, pre-declares all names as VOID in env,
|
||
returns the full form list unchanged (defines are re-evaluated sequentially).
|
||
This allows mutual recursion: both names exist before either body runs.
|
||
Short-circuits immediately when first form is not a define (common case)."""
|
||
# Fast path: no internal defines
|
||
if not forms: return forms
|
||
if not (isinstance(forms[0], Pair) and (forms[0].car is S('define') or forms[0].car is S('begin'))):
|
||
return forms
|
||
i = 0
|
||
while i < len(forms):
|
||
f = forms[i]
|
||
if isinstance(f, Pair) and f.car is S('define'):
|
||
a = _L(f.cdr)
|
||
name = a[0].car if isinstance(a[0], Pair) else a[0]
|
||
if isinstance(name, Symbol): env.define(name, VOID)
|
||
i += 1
|
||
elif isinstance(f, Pair) and f.car is S('begin'):
|
||
# Splice top-level begin (R7RS splicing begin in body)
|
||
spliced = _L(f.cdr)
|
||
forms = list(forms[:i]) + spliced + list(forms[i+1:])
|
||
else:
|
||
break
|
||
return forms
|
||
|
||
###############################################################################
|
||
# Environment
|
||
###############################################################################
|
||
|
||
class Env:
|
||
__slots__ = ('b', 'p', 'g')
|
||
def __init__(self, parent=None):
|
||
self.b = {}; self.p = parent
|
||
self.g = parent.g if parent else None # global env shortcut
|
||
|
||
def lookup(self, k):
|
||
# Walk local → parents → global. Previously there was a
|
||
# shortcut that checked self.g (global) right after self.b
|
||
# (local), which skipped any intermediate parent frame that
|
||
# shadowed a global name. That broke e.g. a let-loop named
|
||
# `count` (a SRFI-1 builtin) when an inner `(let ((next ...)))`
|
||
# pushed a new frame between the loop body and the loop
|
||
# binding: self.b lacked `count`, global had the builtin, and
|
||
# the shortcut returned the builtin instead of walking up to
|
||
# the parent frame that held the loop parameter.
|
||
e = self
|
||
while e is not None:
|
||
b = e.b
|
||
if k in b: return b[k]
|
||
e = e.p
|
||
raise LispErr(f'undefined: {k}')
|
||
|
||
def define(self, k, v): self.b[k] = v
|
||
|
||
def set(self, k, v):
|
||
e = self
|
||
while e:
|
||
if k in e.b: e.b[k] = v; return
|
||
e = e.p
|
||
raise LispErr(f"set! undefined: {k}")
|
||
|
||
def child(self, params, rest, args):
|
||
n = len(params)
|
||
if len(args) < n:
|
||
raise LispErr(f'arity: need {n}, got {len(args)}')
|
||
if rest is None and len(args) > n:
|
||
raise LispErr(f'arity: need {n}, got {len(args)}')
|
||
c = Env(self)
|
||
for p, a in zip(params, args): c.b[p] = a
|
||
if rest is not None: c.b[rest] = _P(args[n:])
|
||
return c
|
||
|
||
|
||
def _deep_copy_env(env):
|
||
"""Deep-copy env chain up to (but not including) the global env.
|
||
Global env (builtins) is shared. Returns a fresh chain for multi-shot continuations."""
|
||
if env is None: return None
|
||
g = env.g
|
||
if env is g: return env # don't copy global env
|
||
new = Env.__new__(Env)
|
||
new.b = dict(env.b)
|
||
new.g = g
|
||
new.p = _deep_copy_env(env.p)
|
||
return new
|
||
|
||
###############################################################################
|
||
# Quasiquote expander
|
||
###############################################################################
|
||
|
||
def _qq(tmpl, env, depth=0):
|
||
if not isinstance(tmpl, Pair): return tmpl
|
||
if tmpl.car is S('quasiquote'):
|
||
return Pair(S('quasiquote'), Pair(_qq(tmpl.cdr.car, env, depth + 1), NIL))
|
||
if tmpl.car is S('unquote'):
|
||
if depth == 0: return leval(tmpl.cdr.car, env)
|
||
return Pair(S('unquote'), Pair(_qq(tmpl.cdr.car, env, depth - 1), NIL))
|
||
parts = []; n = tmpl
|
||
while isinstance(n, Pair):
|
||
item = n.car
|
||
if isinstance(item, Pair) and item.car is S('unquote-splicing'):
|
||
if depth == 0:
|
||
parts.extend(_L(leval(item.cdr.car, env)))
|
||
else:
|
||
parts.append(Pair(S('unquote-splicing'),
|
||
Pair(_qq(item.cdr.car, env, depth - 1), NIL)))
|
||
else:
|
||
parts.append(_qq(item, env, depth))
|
||
n = n.cdr
|
||
tail = _qq(n, env, depth) if n is not NIL else NIL
|
||
r = tail
|
||
for p in reversed(parts): r = Pair(p, r)
|
||
return r
|
||
|
||
###############################################################################
|
||
# Evaluator (TCO via explicit loop)
|
||
###############################################################################
|
||
|
||
def _define_record_type(a, env):
|
||
"""Implement (define-record-type name [(inherit parent)] ctor pred slot...)
|
||
Representation: (tag field...) as a Lisp list.
|
||
(inherit parent) establishes the subtype relationship so parent? is true
|
||
of child instances. The child ctor lists ALL fields it stores (not auto-inherited).
|
||
Parent accessors work on child instances when child preserves parent's field layout."""
|
||
name = a[0]
|
||
rest = a[1:]
|
||
|
||
# Check for (inherit parent) clause
|
||
parent_name = None
|
||
if rest and isinstance(rest[0], Pair) and rest[0].car is S('inherit'):
|
||
parent_name = str(_L(rest[0])[1])
|
||
rest = rest[1:]
|
||
|
||
# ctor-spec: (constructor field-name...)
|
||
ctor_spec = _L(rest[0])
|
||
ctor_name = ctor_spec[0]
|
||
all_fields = [str(s) for s in ctor_spec[1:]]
|
||
field_map = {f: i for i, f in enumerate(all_fields)} # MOAD-0001: O(1) field lookup
|
||
pred_name = rest[1]
|
||
slot_specs = [_L(s) for s in rest[2:]]
|
||
|
||
# Register in type registry (for subtype checks)
|
||
_record_types[str(name)] = {'fields': all_fields, 'parent': parent_name}
|
||
|
||
# Constructor: produces (name field1 field2 ...)
|
||
tag = Pair(S('quote'), Pair(name, NIL))
|
||
all_syms = [S(f) for f in all_fields]
|
||
ctor_body = Pair(S('list'), Pair(tag, _P(all_syms)))
|
||
ctor_proc = Proc(all_syms, None, [ctor_body], env, name=str(ctor_name))
|
||
env.define(ctor_name, ctor_proc)
|
||
|
||
# Predicate: true if instance's type tag is `name` or a subtype of `name`
|
||
def _is_subtype(child_tag, ancestor):
|
||
"""Is child_tag equal to or a descendant of ancestor?"""
|
||
if child_tag == ancestor: return True
|
||
rt = _record_types.get(child_tag)
|
||
while rt and rt['parent']:
|
||
if rt['parent'] == ancestor: return True
|
||
rt = _record_types.get(rt['parent'])
|
||
return False
|
||
|
||
def _make_pred(type_name):
|
||
sname = str(type_name)
|
||
def pred(args, _env):
|
||
x = args[0]
|
||
if not isinstance(x, Pair): return False
|
||
t = x.car
|
||
return isinstance(t, Symbol) and _is_subtype(str(t), sname)
|
||
return pred
|
||
env.define(pred_name, _make_pred(name))
|
||
|
||
# Accessors / mutators: each slot spec is (field-name getter) or (field-name getter setter)
|
||
# field-name in the spec is the slot identity tag (for documentation); getter/setter are names
|
||
for spec in slot_specs:
|
||
field_tag = spec[0]
|
||
getter_name = spec[1]
|
||
setter_name = spec[2] if len(spec) > 2 else None
|
||
field_str = str(field_tag)
|
||
if field_str not in field_map: # MOAD-0001: O(1) lookup via dict
|
||
raise LispErr(f'define-record-type {name}: field {field_str!r} not in {all_fields}')
|
||
idx = field_map[field_str] + 1 # +1 to skip type tag
|
||
|
||
def _make_getter(i):
|
||
def getter_fn(args, _):
|
||
lst = args[0]
|
||
for _ in range(i): lst = _pair_val(lst).cdr
|
||
return _pair_val(lst).car
|
||
return getter_fn
|
||
|
||
def _make_setter(i):
|
||
def setter_fn(args, _):
|
||
lst = args[0]
|
||
for _ in range(i - 1): lst = _pair_val(lst).cdr
|
||
lst.cdr.car = args[1]
|
||
return VOID
|
||
return setter_fn
|
||
|
||
env.define(getter_name, _make_getter(idx))
|
||
if setter_name:
|
||
env.define(setter_name, _make_setter(idx))
|
||
|
||
return VOID
|
||
|
||
|
||
def leval(expr, env):
|
||
"""Evaluate expr in env. Tail-call safe via while loop."""
|
||
while True:
|
||
# Self-evaluating atoms
|
||
if (expr is NIL or expr is VOID or expr is True or expr is False
|
||
or isinstance(expr, (int, float, _EOF, list))
|
||
or (isinstance(expr, str) and not isinstance(expr, Symbol))):
|
||
return expr
|
||
|
||
# Symbol lookup
|
||
if isinstance(expr, Symbol):
|
||
return env.lookup(expr)
|
||
|
||
if not isinstance(expr, Pair):
|
||
return expr
|
||
|
||
head = expr.car
|
||
tail = expr.cdr # unevaluated args as Lisp list
|
||
|
||
# ── Special forms ────────────────────────────────────────────────────
|
||
|
||
if head is S('quote'):
|
||
return tail.car
|
||
|
||
if head is S('if'):
|
||
a = _L(tail)
|
||
if not 2 <= len(a) <= 3: raise LispErr('if: need 2-3 subforms')
|
||
expr = a[1] if _truthy(leval(a[0], env)) else (a[2] if len(a) == 3 else VOID)
|
||
continue
|
||
|
||
if head is S('cond'):
|
||
result = VOID
|
||
for cl in _L(tail):
|
||
cl = _L(cl)
|
||
if not cl: raise LispErr('cond: empty clause')
|
||
if cl[0] is S('else') or _truthy(leval(cl[0], env)):
|
||
if len(cl) == 1:
|
||
result = leval(cl[0], env) if cl[0] is not S('else') else VOID
|
||
break
|
||
if len(cl) == 3 and cl[1] is S('=>'):
|
||
v = leval(cl[0], env); f = leval(cl[2], env)
|
||
if isinstance(f, Proc):
|
||
env = f.env.child(f.params, f.rest, [v])
|
||
expr = Pair(S('begin'), _P(f.body)); break
|
||
return f([v], env)
|
||
for e in cl[1:-1]: leval(e, env)
|
||
expr = cl[-1]; break
|
||
else:
|
||
return result
|
||
continue
|
||
|
||
if head is S('and'):
|
||
a = _L(tail)
|
||
if not a: return True
|
||
for e in a[:-1]:
|
||
v = leval(e, env)
|
||
if not _truthy(v): return False
|
||
expr = a[-1]; continue
|
||
|
||
if head is S('or'):
|
||
a = _L(tail)
|
||
if not a: return False
|
||
for e in a[:-1]:
|
||
v = leval(e, env)
|
||
if _truthy(v): return v
|
||
expr = a[-1]; continue
|
||
|
||
if head is S('when'):
|
||
a = _L(tail)
|
||
if _truthy(leval(a[0], env)):
|
||
for e in a[1:-1]: leval(e, env)
|
||
expr = a[-1]; continue
|
||
return VOID
|
||
|
||
if head is S('unless'):
|
||
a = _L(tail)
|
||
if not _truthy(leval(a[0], env)):
|
||
for e in a[1:-1]: leval(e, env)
|
||
expr = a[-1]; continue
|
||
return VOID
|
||
|
||
if head is S('begin'):
|
||
a = _L(tail)
|
||
if not a: return VOID
|
||
for e in a[:-1]: leval(e, env)
|
||
expr = a[-1]; continue
|
||
|
||
if head is S('define'):
|
||
a = _L(tail)
|
||
if not a: raise LispErr('define: empty')
|
||
if isinstance(a[0], Pair): # (define (f x) body...)
|
||
fname = a[0].car; ps, rest = _formals(a[0].cdr)
|
||
p = Proc(ps, rest, a[1:], env, name=str(fname))
|
||
if _auto_compile[0]:
|
||
try: p = bc_compile_proc(p, env)
|
||
except Exception: pass
|
||
env.define(fname, p)
|
||
else:
|
||
name = a[0]
|
||
if not isinstance(name, Symbol): raise LispErr(f'define: name must be symbol, got {show(name)}')
|
||
val = leval(a[1], env) if len(a) > 1 else VOID
|
||
if isinstance(val, Proc) and not val.name: val.name = str(name)
|
||
if _auto_compile[0] and isinstance(val, Proc):
|
||
try: val = bc_compile_proc(val, env)
|
||
except Exception: pass
|
||
env.define(name, val)
|
||
return VOID
|
||
|
||
if head is S('define-values'):
|
||
a = _L(tail); names = _L(a[0])
|
||
vals = leval(a[1], env)
|
||
vs = list(vals) if isinstance(vals, tuple) else [vals]
|
||
for n, v in zip(names, vs): env.define(n, v)
|
||
return VOID
|
||
|
||
if head is S('set!'):
|
||
a = _L(tail); env.set(a[0], leval(a[1], env)); return VOID
|
||
|
||
if head is S('lambda') or head is S('λ'):
|
||
a = _L(tail)
|
||
if not a: raise LispErr('lambda: empty')
|
||
ps, rest = _formals(a[0])
|
||
p = Proc(ps, rest, a[1:], env)
|
||
if _auto_compile[0]:
|
||
try: p = bc_compile_proc(p, env)
|
||
except Exception: pass
|
||
return p
|
||
|
||
if head is S('let'):
|
||
a = _L(tail)
|
||
if not a: raise LispErr('let: empty')
|
||
if isinstance(a[0], Symbol): # named let
|
||
name = a[0]; binds = _L(a[1]); body = a[2:]
|
||
bps = [_L(b)[0] for b in binds]
|
||
bvs = [leval(_L(b)[1], env) for b in binds]
|
||
c = Env(env)
|
||
p = Proc(bps, None, body, c, name=str(name))
|
||
c.define(name, p)
|
||
env = c.child(bps, None, bvs)
|
||
if _has_internal_defines(body): body = _body_env(body, env)
|
||
expr = Pair(S('begin'), _P(body)); continue
|
||
binds = _L(a[0]); body = a[1:]
|
||
c = Env(env)
|
||
for b in binds:
|
||
bp = _L(b); c.define(bp[0], leval(bp[1], env))
|
||
env = c
|
||
if _has_internal_defines(body): body = _body_env(body, env)
|
||
expr = Pair(S('begin'), _P(body)); continue
|
||
|
||
if head is S('let*'):
|
||
a = _L(tail)
|
||
c = Env(env)
|
||
for b in _L(a[0]):
|
||
bp = _L(b); c.define(bp[0], leval(bp[1], c))
|
||
body = a[1:]
|
||
if _has_internal_defines(body): body = _body_env(body, c)
|
||
env = c; expr = Pair(S('begin'), _P(body)); continue
|
||
|
||
if head is S('letrec') or head is S('letrec*'):
|
||
a = _L(tail); binds = _L(a[0])
|
||
c = Env(env)
|
||
for b in binds: c.define(_L(b)[0], VOID)
|
||
for b in binds:
|
||
bp = _L(b); c.set(bp[0], leval(bp[1], c))
|
||
body = a[1:]
|
||
if _has_internal_defines(body): body = _body_env(body, c)
|
||
env = c; expr = Pair(S('begin'), _P(body)); continue
|
||
|
||
if head is S('let-values'):
|
||
a = _L(tail); binds = _L(a[0]); body = a[1:]
|
||
c = Env(env)
|
||
for bind in binds:
|
||
bp = _L(bind); formals = bp[0]; val = leval(bp[1], env)
|
||
vs = list(val) if isinstance(val, tuple) else [val]
|
||
fmls = _L(formals) if isinstance(formals, Pair) else ([formals] if isinstance(formals, Symbol) else [])
|
||
for name, v in zip(fmls, vs): c.define(name, v)
|
||
body2 = _body_env(body, c) if _has_internal_defines(body) else body
|
||
env = c; expr = Pair(S('begin'), _P(body2)); continue
|
||
|
||
if head is S('let*-values'):
|
||
a = _L(tail); binds = _L(a[0]); body = a[1:]
|
||
c = Env(env)
|
||
for bind in binds:
|
||
bp = _L(bind); formals = bp[0]; val = leval(bp[1], c)
|
||
vs = list(val) if isinstance(val, tuple) else [val]
|
||
fmls = _L(formals) if isinstance(formals, Pair) else ([formals] if isinstance(formals, Symbol) else [])
|
||
for name, v in zip(fmls, vs): c.define(name, v)
|
||
body2 = _body_env(body, c) if _has_internal_defines(body) else body
|
||
env = c; expr = Pair(S('begin'), _P(body2)); continue
|
||
|
||
if head is S('do'):
|
||
a = _L(tail)
|
||
vcs = _L(a[0]); term = _L(a[1]); body = a[2:]
|
||
c = Env(env)
|
||
specs = [_L(vc) for vc in vcs]
|
||
for sp in specs: c.define(sp[0], leval(sp[1], env))
|
||
steps = [sp[2] if len(sp) > 2 else sp[0] for sp in specs]
|
||
while True:
|
||
if _truthy(leval(term[0], c)):
|
||
if len(term) == 1: return VOID
|
||
for e in term[1:-1]: leval(e, c)
|
||
expr = term[-1]; env = c; break
|
||
for b in body: leval(b, c)
|
||
nvs = [leval(s, c) for s in steps]
|
||
for sp, nv in zip(specs, nvs): c.set(sp[0], nv)
|
||
continue
|
||
|
||
if head is S('quasiquote'):
|
||
return _qq(tail.car, env)
|
||
|
||
if head is S('define-macro') or head is S('defmacro'):
|
||
a = _L(tail)
|
||
if isinstance(a[0], Pair): # (define-macro (name params...) body...)
|
||
name = a[0].car; ps, rest = _formals(a[0].cdr)
|
||
body = a[1:]
|
||
else: # (define-macro name (params...) body...)
|
||
name = a[0]; ps, rest = _formals(a[1])
|
||
body = a[2:]
|
||
xfm = Proc(ps, rest, body, env, name=str(name))
|
||
env.define(name, Macro(xfm)); return VOID
|
||
|
||
if head is S('define-syntax'):
|
||
a = _L(tail)
|
||
val = leval(a[1], env)
|
||
if isinstance(val, _SyntaxTransformer):
|
||
env.define(a[0], Macro(val))
|
||
else:
|
||
env.define(a[0], val)
|
||
return VOID
|
||
|
||
if head is S('let-syntax'):
|
||
a = _L(tail); body = a[1:]
|
||
c = Env(env)
|
||
for b in _L(a[0]):
|
||
bp = _L(b); c.define(bp[0], Macro(leval(bp[1], env)))
|
||
env = c; expr = Pair(S('begin'), _P(body)); continue
|
||
|
||
if head is S('letrec-syntax'):
|
||
a = _L(tail); body = a[1:]
|
||
c = Env(env)
|
||
for b in _L(a[0]):
|
||
bp = _L(b); c.define(bp[0], Macro(leval(bp[1], c)))
|
||
env = c; expr = Pair(S('begin'), _P(body)); continue
|
||
|
||
if head is S('syntax-rules'):
|
||
a = _L(tail)
|
||
return _SyntaxTransformer(a[0], _P(a[1:]), env)
|
||
|
||
if head is S('values'):
|
||
vals = [leval(e, env) for e in _L(tail)]
|
||
return vals[0] if len(vals) == 1 else tuple(vals)
|
||
|
||
if head is S('call-with-values'):
|
||
a = _L(tail)
|
||
prod = leval(a[0], env); cons_ = leval(a[1], env)
|
||
r = _call(prod, [], env)
|
||
args = list(r) if isinstance(r, tuple) else [r]
|
||
return _call(cons_, args, env)
|
||
|
||
if head is S('call/cc') or head is S('call-with-current-continuation'):
|
||
a = _L(tail); proc = leval(a[0], env)
|
||
class Escape(Exception):
|
||
def __init__(self, v): self.v = v
|
||
def kont(args, _env): raise Escape(args[0] if args else VOID)
|
||
try: return _call(proc, [kont], env)
|
||
except Escape as e: return e.v
|
||
|
||
if head is S('apply'):
|
||
a = _L(tail)
|
||
proc = leval(a[0], env)
|
||
pre = [leval(x, env) for x in a[1:-1]]
|
||
last = leval(a[-1], env)
|
||
args = pre + _L(last)
|
||
if isinstance(proc, Proc):
|
||
env = proc.env.child(proc.params, proc.rest, args)
|
||
body = _body_env(proc.body, env) if proc.has_defs else proc.body
|
||
if len(body) == 1: expr = body[0]
|
||
else: expr = Pair(S('begin'), _P(body))
|
||
continue
|
||
if callable(proc): return proc(args, env)
|
||
raise LispErr(f'apply: not callable: {show(proc)}')
|
||
|
||
if head is S('eval'):
|
||
# Evaluate the argument in the current env (so the caller can
|
||
# pass a local expression), but evaluate the RESULT in the
|
||
# global env. This matches asm's bi_eval and lets portal
|
||
# resume — (eval (read-from-string ...)) — install bindings
|
||
# that outlive the evaluating function.
|
||
a = _L(tail); expr = leval(a[0], env); env = env.g; continue
|
||
|
||
if head is S('error'):
|
||
a = _L(tail)
|
||
msg = show(leval(a[0], env), display=True)
|
||
irr = [leval(x, env) for x in a[1:]]
|
||
obj = ErrorObject(msg, irr)
|
||
raise LispErr(str(obj), obj=obj)
|
||
|
||
if head is S('define-record-type'):
|
||
return _define_record_type(_L(tail), env)
|
||
|
||
if head is S('module'):
|
||
# (module name (export sym ...) body...)
|
||
a = _L(tail)
|
||
mod_name = str(a[0])
|
||
export_list = _L(a[1]) if isinstance(a[1], Pair) and a[1].car is S('export') else []
|
||
explicit_exports = [str(s) for s in export_list[1:]] if export_list else []
|
||
body = a[2:]
|
||
mod_env = Env(env)
|
||
for e in body[:-1]: leval(e, mod_env)
|
||
if body: leval(body[-1], mod_env)
|
||
exports = explicit_exports if explicit_exports else list(mod_env.b.keys())
|
||
_modules[mod_name] = mod_env
|
||
_mod_exports[mod_name] = exports
|
||
return VOID
|
||
|
||
if head is S('import'):
|
||
# (import module-name) or (import (module-name sym ...))
|
||
for spec in _L(tail):
|
||
if isinstance(spec, Symbol):
|
||
name = str(spec)
|
||
if name not in _modules: raise LispErr(f'import: unknown module: {name}')
|
||
mod = _modules[name]
|
||
for k in _mod_exports.get(name, list(mod.b.keys())):
|
||
if k in mod.b: env.define(S(k), mod.b[k])
|
||
elif isinstance(spec, Pair):
|
||
items = _L(spec)
|
||
name = str(items[0])
|
||
if name not in _modules: raise LispErr(f'import: unknown module: {name}')
|
||
mod = _modules[name]
|
||
syms = [str(s) for s in items[1:]] if len(items) > 1 else _mod_exports.get(name, list(mod.b.keys()))
|
||
for k in syms:
|
||
if k in mod.b: env.define(S(k), mod.b[k])
|
||
else: raise LispErr(f'import: {name} has no export: {k}')
|
||
return VOID
|
||
|
||
if head is S('load'):
|
||
a = _L(tail); _load(leval(a[0], env), env); return VOID
|
||
|
||
if head is S('include'):
|
||
for path_expr in _L(tail):
|
||
_load(show(leval(path_expr, env), display=True), env)
|
||
return VOID
|
||
|
||
if head is S('parameterize'):
|
||
a = _L(tail); binds = _L(a[0]); body = a[1:]
|
||
params_new = [(leval(_L(bp)[0], env), leval(_L(bp)[1], env)) for bp in binds]
|
||
saved = [(p, _call(p, [], env)) for p, _ in params_new]
|
||
for p, nv in params_new: _call(p, [nv], env)
|
||
try:
|
||
for e in body[:-1]: leval(e, env)
|
||
return leval(body[-1], env)
|
||
finally:
|
||
for p, ov in saved: _call(p, [ov], env)
|
||
|
||
if head is S('dynamic-wind'):
|
||
a = _L(tail)
|
||
before = leval(a[0], env); thunk = leval(a[1], env); after = leval(a[2], env)
|
||
_call(before, [], env)
|
||
try: r = _call(thunk, [], env)
|
||
finally: _call(after, [], env)
|
||
return r
|
||
|
||
if head is S('with-exception-handler'):
|
||
a = _L(tail)
|
||
handler = leval(a[0], env); thunk = leval(a[1], env)
|
||
try: return _call(thunk, [], env)
|
||
except LispErr as e: return _call(handler, [e.obj if e.obj else str(e)], env)
|
||
except Exception as e: return _call(handler, [str(e)], env)
|
||
|
||
if head is S('guard'):
|
||
a = _L(tail); var_clauses = _L(a[0]); body = a[1:]
|
||
var = var_clauses[0]; clauses = var_clauses[1:]
|
||
try:
|
||
for e in body[:-1]: leval(e, env)
|
||
return leval(body[-1], env)
|
||
except LispErr as exc:
|
||
c = Env(env); c.define(var, exc.obj if exc.obj else str(exc))
|
||
for cl in clauses:
|
||
cl = _L(cl)
|
||
if cl[0] is S('else') or _truthy(leval(cl[0], c)):
|
||
for e in cl[1:-1]: leval(e, c)
|
||
return leval(cl[-1], c)
|
||
raise
|
||
|
||
# ── Macro expansion ──────────────────────────────────────────────────
|
||
hval = leval(head, env)
|
||
if isinstance(hval, Macro):
|
||
expr = _call(hval.xfm, _L(tail), env); continue
|
||
|
||
# ── Procedure application ────────────────────────────────────────────
|
||
proc = hval
|
||
args = [leval(a, env) for a in _L(tail)]
|
||
|
||
if isinstance(proc, CompiledProc):
|
||
try:
|
||
return vm_exec(proc.code,
|
||
proc.env.child(proc.params, proc.rest, args))
|
||
except _ContInvoked as ci:
|
||
if _vm_depth[0] > 0: raise
|
||
return _cont_resume(ci)
|
||
|
||
if isinstance(proc, Proc):
|
||
env = proc.env.child(proc.params, proc.rest, args)
|
||
body = _body_env(proc.body, env) if proc.has_defs else proc.body
|
||
if len(body) == 1: expr = body[0]
|
||
else: expr = Pair(S('begin'), _P(body))
|
||
continue
|
||
|
||
if callable(proc):
|
||
try: return proc(args, env)
|
||
except _ContInvoked as ci:
|
||
if _vm_depth[0] > 0: raise
|
||
return _cont_resume(ci)
|
||
|
||
raise LispErr(f'not callable: {show(proc)}')
|
||
|
||
|
||
def _cont_resume(ci):
|
||
"""Resume an escaped continuation (multi-shot safe: deep-copies env)."""
|
||
c = ci.cont
|
||
frames = [(i, p, _deep_copy_env(e), list(s)) for i, p, e, s in c.frames]
|
||
stack = list(c.stack); stack.append(ci.val)
|
||
env = _deep_copy_env(c.env)
|
||
try:
|
||
return _vm_loop(c.instrs, c.ip, stack, env, frames, c.vm_id)
|
||
except _ContInvoked as ci2:
|
||
return _cont_resume(ci2)
|
||
|
||
def _call(proc, args, env):
|
||
"""Non-tail recursive call (for use inside builtins)."""
|
||
if isinstance(proc, CompiledProc):
|
||
try:
|
||
return vm_exec(proc.code,
|
||
proc.env.child(proc.params, proc.rest, args))
|
||
except _ContInvoked as ci:
|
||
if _vm_depth[0] > 0: raise
|
||
return _cont_resume(ci)
|
||
if isinstance(proc, Proc):
|
||
c = proc.env.child(proc.params, proc.rest, args)
|
||
body = _body_env(proc.body, c) if proc.has_defs else proc.body
|
||
frame = proc.name or 'λ'
|
||
_call_stack.append(frame)
|
||
try:
|
||
for e in body[:-1]: leval(e, c)
|
||
return leval(body[-1], c)
|
||
finally:
|
||
if _call_stack: _call_stack.pop()
|
||
if callable(proc): return proc(args, env)
|
||
raise LispErr(f'not callable: {show(proc)}')
|
||
|
||
|
||
def _load(path, env):
|
||
try:
|
||
with open(path) as f:
|
||
src = f.read()
|
||
except UnicodeDecodeError:
|
||
raise LispErr(f'{path}: not a text file (binary data encountered)')
|
||
for expr in read_all(src, track_lines=True): leval(expr, env)
|
||
|
||
###############################################################################
|
||
# Bytecode Compiler & VM
|
||
###############################################################################
|
||
|
||
# Opcodes
|
||
OP_CONST = 0; OP_LOOKUP = 1; OP_SET = 2; OP_DEFINE = 3
|
||
OP_POP = 4; OP_DUP = 5; OP_VOID = 6
|
||
OP_JUMP = 10; OP_JUMP_IF_FALSE = 11
|
||
OP_JUMP_IF_FALSE_KEEP = 12 # and: if falsy keep & jump, else pop
|
||
OP_JUMP_IF_TRUE_KEEP = 13 # or: if truthy keep & jump, else pop
|
||
OP_CALL = 20; OP_TAIL_CALL = 21; OP_RETURN = 22
|
||
OP_MAKE_CLOSURE = 30
|
||
OP_PUSH_ENV = 40; OP_POP_ENV = 41; OP_BIND = 42
|
||
OP_EVAL = 50 # fallback to tree-walker
|
||
OP_CALL_CC = 51 # call/cc
|
||
# Specialized opcodes (avoid LOOKUP+CALL for hot builtins)
|
||
OP_ADD = 60; OP_SUB = 61; OP_MUL = 62; OP_NEG = 63
|
||
OP_NUM_EQ = 64; OP_LT = 65; OP_GT = 66; OP_LE = 67; OP_GE = 68
|
||
OP_ADD1 = 69; OP_SUB1 = 70
|
||
OP_CAR = 71; OP_CDR = 72; OP_CONS = 73
|
||
OP_NULL_P = 74; OP_PAIR_P = 75; OP_NOT = 76; OP_ZERO_P = 77
|
||
OP_VEC_REF = 78; OP_VEC_SET = 79
|
||
# Superinstructions (fused opcode pairs for hot paths)
|
||
OP_LOOK_LOOK = 80 # push two lookups: arg = (sym1, sym2)
|
||
OP_LOOK_ADD1 = 81 # lookup + increment: arg = sym
|
||
OP_LOOK_SUB1 = 82 # lookup + decrement: arg = sym
|
||
OP_CONST_EQ_JF = 83 # push const, compare TOS, branch: arg = (const, jump_addr)
|
||
OP_LOOK_CONST_CALL2 = 84 # lookup func, push const, call(2): arg = (sym, const)
|
||
OP_SELF_TAIL_CALL = 85 # self-recursive tail call (reuse env): arg = (n_args, params_tuple)
|
||
|
||
# Specialization table: {symbol: {arity: opcode}}
|
||
_BC_SPECIALIZE = {
|
||
S('+'): {2: OP_ADD}, S('-'): {2: OP_SUB, 1: OP_NEG}, S('*'): {2: OP_MUL},
|
||
S('='): {2: OP_NUM_EQ}, S('<'): {2: OP_LT}, S('>'): {2: OP_GT},
|
||
S('<='): {2: OP_LE}, S('>='): {2: OP_GE},
|
||
S('car'): {1: OP_CAR}, S('cdr'): {1: OP_CDR}, S('cons'): {2: OP_CONS},
|
||
S('null?'): {1: OP_NULL_P}, S('pair?'): {1: OP_PAIR_P},
|
||
S('not'): {1: OP_NOT}, S('zero?'): {1: OP_ZERO_P},
|
||
S('vector-ref'): {2: OP_VEC_REF}, S('vector-set!'): {3: OP_VEC_SET},
|
||
}
|
||
|
||
# Constant folding tables
|
||
def _bc_is_global(sym, env):
|
||
"""Check if sym is not locally shadowed (resolves to global env)."""
|
||
e = env
|
||
g = e.g
|
||
while e is not None and e is not g:
|
||
if sym in e.b: return False
|
||
e = e.p
|
||
return True
|
||
|
||
def _bc_is_const(expr):
|
||
"""Is expr a compile-time constant?"""
|
||
if isinstance(expr, (int, float, Fraction)): return True
|
||
if isinstance(expr, bool): return True
|
||
if isinstance(expr, str) and not isinstance(expr, Symbol): return True
|
||
if expr is NIL or expr is VOID or expr is True or expr is False: return True
|
||
return False
|
||
|
||
import operator as _op, functools as _ft
|
||
_BC_FOLDABLE = {
|
||
S('+'): lambda a: _ft.reduce(_op.add, a, 0),
|
||
S('-'): lambda a: -a[0] if len(a) == 1 else _ft.reduce(_op.sub, a[1:], a[0]),
|
||
S('*'): lambda a: _ft.reduce(_op.mul, a, 1),
|
||
S('='): lambda a: a[0] == a[1],
|
||
S('<'): lambda a: a[0] < a[1],
|
||
S('>'): lambda a: a[0] > a[1],
|
||
S('<='): lambda a: a[0] <= a[1],
|
||
S('>='): lambda a: a[0] >= a[1],
|
||
S('not'): lambda a: not _truthy(a[0]),
|
||
S('zero?'): lambda a: a[0] == 0,
|
||
S('positive?'): lambda a: a[0] > 0,
|
||
S('negative?'): lambda a: a[0] < 0,
|
||
S('abs'): lambda a: abs(a[0]),
|
||
S('min'): lambda a: min(a),
|
||
S('max'): lambda a: max(a),
|
||
S('string-length'): lambda a: len(a[0]) if isinstance(a[0], str) else None,
|
||
S('string-append'): lambda a: ''.join(a),
|
||
}
|
||
|
||
class CodeObj:
|
||
"""Compiled bytecode chunk."""
|
||
__slots__ = ('instrs', 'name', 'source_map', 'ic', '_cur_line', '_self_name', '_self_params')
|
||
def __init__(self, name=None):
|
||
self.instrs = []; self.name = name
|
||
self.source_map = [] # parallel to instrs: line number or None
|
||
self.ic = None # inline cache (populated at runtime)
|
||
self._cur_line = None # current source line during compilation
|
||
def emit(self, op, arg=None):
|
||
idx = len(self.instrs); self.instrs.append((op, arg))
|
||
self.source_map.append(self._cur_line)
|
||
return idx
|
||
def patch(self, addr, arg):
|
||
self.instrs[addr] = (self.instrs[addr][0], arg)
|
||
|
||
class CompiledProc:
|
||
"""A bytecode-compiled procedure."""
|
||
__slots__ = ('code', 'params', 'rest', 'env', 'name')
|
||
def __init__(self, code, params, rest, env, name=None):
|
||
self.code = code; self.params = params; self.rest = rest
|
||
self.env = env; self.name = name
|
||
def __repr__(self): return f'#<compiled {self.name or "λ"}>'
|
||
|
||
# Forms that fall back to leval
|
||
_BC_FALLBACK = frozenset(map(S, [
|
||
'quasiquote', 'define-macro', 'defmacro', 'define-syntax',
|
||
'let-syntax', 'letrec-syntax', 'syntax-rules',
|
||
'define-values', 'let-values', 'let*-values',
|
||
'define-record-type', 'module', 'import', 'include', 'load',
|
||
'parameterize', 'dynamic-wind', 'with-exception-handler',
|
||
'guard', 'call-with-values', 'values', 'eval', 'error',
|
||
'case',
|
||
]))
|
||
|
||
|
||
def _bc(expr, code, env, tail=False):
|
||
"""Compile expr into bytecode instructions in code."""
|
||
# Track source line from Pair nodes
|
||
if isinstance(expr, Pair) and expr._line is not None:
|
||
code._cur_line = expr._line
|
||
# Self-evaluating
|
||
if expr is VOID: code.emit(OP_VOID); return
|
||
if expr is NIL or expr is True or expr is False:
|
||
code.emit(OP_CONST, expr); return
|
||
if isinstance(expr, (int, float, Fraction)):
|
||
code.emit(OP_CONST, expr); return
|
||
if isinstance(expr, str) and not isinstance(expr, Symbol):
|
||
code.emit(OP_CONST, expr); return
|
||
if isinstance(expr, list):
|
||
code.emit(OP_CONST, expr); return
|
||
if isinstance(expr, Symbol):
|
||
code.emit(OP_LOOKUP, expr); return
|
||
if not isinstance(expr, Pair):
|
||
code.emit(OP_CONST, expr); return
|
||
|
||
head = expr.car; args = expr.cdr
|
||
|
||
# --- Fallback forms ---
|
||
if isinstance(head, Symbol) and head in _BC_FALLBACK:
|
||
code.emit(OP_EVAL, expr); return
|
||
|
||
# --- quote ---
|
||
if head is S('quote'):
|
||
code.emit(OP_CONST, args.car); return
|
||
|
||
# --- if ---
|
||
if head is S('if'):
|
||
a = _L(args)
|
||
_bc(a[0], code, env)
|
||
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
||
_bc(a[1], code, env, tail=tail)
|
||
je = code.emit(OP_JUMP, None)
|
||
code.patch(jf, len(code.instrs))
|
||
if len(a) > 2:
|
||
_bc(a[2], code, env, tail=tail)
|
||
else:
|
||
code.emit(OP_VOID)
|
||
code.patch(je, len(code.instrs))
|
||
return
|
||
|
||
# --- begin ---
|
||
if head is S('begin'):
|
||
a = _L(args)
|
||
if not a: code.emit(OP_VOID); return
|
||
for e in a[:-1]: _bc(e, code, env); code.emit(OP_POP)
|
||
_bc(a[-1], code, env, tail=tail); return
|
||
|
||
# --- and ---
|
||
if head is S('and'):
|
||
a = _L(args)
|
||
if not a: code.emit(OP_CONST, True); return
|
||
if len(a) == 1: _bc(a[0], code, env, tail=tail); return
|
||
ends = []
|
||
for e in a[:-1]:
|
||
_bc(e, code, env)
|
||
ends.append(code.emit(OP_JUMP_IF_FALSE_KEEP, None))
|
||
_bc(a[-1], code, env, tail=tail)
|
||
end = len(code.instrs)
|
||
for j in ends: code.patch(j, end)
|
||
return
|
||
|
||
# --- or ---
|
||
if head is S('or'):
|
||
a = _L(args)
|
||
if not a: code.emit(OP_CONST, False); return
|
||
if len(a) == 1: _bc(a[0], code, env, tail=tail); return
|
||
ends = []
|
||
for e in a[:-1]:
|
||
_bc(e, code, env)
|
||
ends.append(code.emit(OP_JUMP_IF_TRUE_KEEP, None))
|
||
_bc(a[-1], code, env, tail=tail)
|
||
end = len(code.instrs)
|
||
for j in ends: code.patch(j, end)
|
||
return
|
||
|
||
# --- when ---
|
||
if head is S('when'):
|
||
a = _L(args)
|
||
_bc(a[0], code, env)
|
||
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
||
for e in a[1:-1]: _bc(e, code, env); code.emit(OP_POP)
|
||
_bc(a[-1], code, env, tail=tail)
|
||
je = code.emit(OP_JUMP, None)
|
||
code.patch(jf, len(code.instrs))
|
||
code.emit(OP_VOID)
|
||
code.patch(je, len(code.instrs))
|
||
return
|
||
|
||
# --- unless ---
|
||
if head is S('unless'):
|
||
a = _L(args)
|
||
_bc(a[0], code, env)
|
||
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
||
code.emit(OP_VOID)
|
||
je = code.emit(OP_JUMP, None)
|
||
code.patch(jf, len(code.instrs))
|
||
for e in a[1:-1]: _bc(e, code, env); code.emit(OP_POP)
|
||
_bc(a[-1], code, env, tail=tail)
|
||
code.patch(je, len(code.instrs))
|
||
return
|
||
|
||
# --- cond ---
|
||
if head is S('cond'):
|
||
clauses = _L(args); ends = []
|
||
for cl_raw in clauses:
|
||
cl = _L(cl_raw)
|
||
if cl[0] is S('else'):
|
||
for e in (cl[1:] or [VOID])[:-1]: _bc(e, code, env); code.emit(OP_POP)
|
||
_bc((cl[1:] or [VOID])[-1], code, env, tail=tail); break
|
||
if (len(cl) >= 3 and cl[1] is S('=>')) or len(cl) == 1:
|
||
code.emit(OP_EVAL, expr); return # fallback for => and bare test
|
||
_bc(cl[0], code, env)
|
||
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
||
for e in cl[1:-1]: _bc(e, code, env); code.emit(OP_POP)
|
||
_bc(cl[-1], code, env, tail=tail)
|
||
ends.append(code.emit(OP_JUMP, None))
|
||
code.patch(jf, len(code.instrs))
|
||
else:
|
||
code.emit(OP_VOID)
|
||
end = len(code.instrs)
|
||
for j in ends: code.patch(j, end)
|
||
return
|
||
|
||
# --- define ---
|
||
if head is S('define'):
|
||
a = _L(args)
|
||
if isinstance(a[0], Pair):
|
||
fname = a[0].car; ps, rest = _formals(a[0].cdr)
|
||
inner = _bc_lambda(a[1:], ps, rest, env, name=str(fname))
|
||
code.emit(OP_MAKE_CLOSURE, (inner, ps, rest))
|
||
code.emit(OP_DEFINE, fname)
|
||
else:
|
||
_bc(a[1], code, env) if len(a) > 1 else code.emit(OP_VOID)
|
||
code.emit(OP_DEFINE, a[0])
|
||
code.emit(OP_VOID); return
|
||
|
||
# --- set! ---
|
||
if head is S('set!'):
|
||
a = _L(args)
|
||
_bc(a[1], code, env)
|
||
code.emit(OP_SET, a[0])
|
||
code.emit(OP_VOID); return
|
||
|
||
# --- lambda ---
|
||
if head is S('lambda') or head is S('λ'):
|
||
a = _L(args); ps, rest = _formals(a[0])
|
||
inner = _bc_lambda(a[1:], ps, rest, env)
|
||
code.emit(OP_MAKE_CLOSURE, (inner, ps, rest)); return
|
||
|
||
# --- let ---
|
||
if head is S('let'):
|
||
a = _L(args)
|
||
if isinstance(a[0], Symbol):
|
||
# Named let: (let loop ((v init)...) body...)
|
||
name = a[0]; binds = _L(a[1]); body = a[2:]
|
||
bps = [_L(b)[0] for b in binds]
|
||
inner = _bc_lambda(body, bps, None, env, name=str(name),
|
||
self_name=str(name), self_params=bps)
|
||
code.emit(OP_PUSH_ENV)
|
||
code.emit(OP_MAKE_CLOSURE, (inner, bps, None))
|
||
code.emit(OP_DUP)
|
||
code.emit(OP_BIND, name)
|
||
for b in binds: _bc(_L(b)[1], code, env)
|
||
code.emit(OP_TAIL_CALL if tail else OP_CALL, len(binds))
|
||
if not tail: code.emit(OP_POP_ENV)
|
||
return
|
||
# Regular let
|
||
binds = _L(a[0]); body = a[1:]
|
||
for b in binds: _bc(_L(b)[1], code, env)
|
||
code.emit(OP_PUSH_ENV)
|
||
for b in reversed(binds): code.emit(OP_BIND, _L(b)[0])
|
||
body_env = Env(env)
|
||
for b in binds: body_env.define(_L(b)[0], VOID)
|
||
_bc_body(body, code, body_env, tail=tail)
|
||
if not tail: code.emit(OP_POP_ENV)
|
||
return
|
||
|
||
# --- let* ---
|
||
if head is S('let*'):
|
||
a = _L(args); binds = _L(a[0]); body = a[1:]
|
||
code.emit(OP_PUSH_ENV)
|
||
body_env = Env(env)
|
||
for b in binds:
|
||
bp = _L(b); _bc(bp[1], code, body_env); code.emit(OP_BIND, bp[0])
|
||
body_env.define(bp[0], VOID)
|
||
_bc_body(body, code, body_env, tail=tail)
|
||
if not tail: code.emit(OP_POP_ENV)
|
||
return
|
||
|
||
# --- letrec / letrec* ---
|
||
if head is S('letrec') or head is S('letrec*'):
|
||
a = _L(args); binds = _L(a[0]); body = a[1:]
|
||
code.emit(OP_PUSH_ENV)
|
||
body_env = Env(env)
|
||
for b in binds: code.emit(OP_VOID); code.emit(OP_BIND, _L(b)[0]); body_env.define(_L(b)[0], VOID)
|
||
for b in binds:
|
||
bp = _L(b); _bc(bp[1], code, body_env)
|
||
code.emit(OP_SET, bp[0])
|
||
_bc_body(body, code, body_env, tail=tail)
|
||
if not tail: code.emit(OP_POP_ENV)
|
||
return
|
||
|
||
# --- do ---
|
||
if head is S('do'):
|
||
a = _L(args); vcs = _L(a[0]); term = _L(a[1]); body_exprs = a[2:]
|
||
specs = [_L(vc) for vc in vcs]
|
||
for sp in specs: _bc(sp[1], code, env)
|
||
code.emit(OP_PUSH_ENV)
|
||
for sp in reversed(specs): code.emit(OP_BIND, sp[0])
|
||
loop_start = len(code.instrs)
|
||
_bc(term[0], code, env)
|
||
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
||
if len(term) > 1:
|
||
for e in term[1:-1]: _bc(e, code, env); code.emit(OP_POP)
|
||
_bc(term[-1], code, env, tail=tail)
|
||
else:
|
||
code.emit(OP_VOID)
|
||
je = code.emit(OP_JUMP, None)
|
||
code.patch(jf, len(code.instrs))
|
||
for b in body_exprs: _bc(b, code, env); code.emit(OP_POP)
|
||
for sp in specs:
|
||
step = sp[2] if len(sp) > 2 else sp[0]
|
||
_bc(step, code, env)
|
||
for sp in reversed(specs): code.emit(OP_SET, sp[0])
|
||
code.emit(OP_JUMP, loop_start)
|
||
code.patch(je, len(code.instrs))
|
||
if not tail: code.emit(OP_POP_ENV)
|
||
return
|
||
|
||
# --- call/cc ---
|
||
if head is S('call/cc') or head is S('call-with-current-continuation'):
|
||
a = _L(args)
|
||
_bc(a[0], code, env)
|
||
code.emit(OP_CALL_CC); return
|
||
|
||
# --- apply ---
|
||
if head is S('apply'):
|
||
a = _L(args)
|
||
# Compile all args, emit OP_EVAL as fallback for TCO correctness
|
||
code.emit(OP_EVAL, expr); return
|
||
|
||
# --- Macro expansion at compile time ---
|
||
if isinstance(head, Symbol):
|
||
try:
|
||
hval = env.lookup(head)
|
||
if isinstance(hval, Macro):
|
||
expanded = _call(hval.xfm, _L(args), env)
|
||
_bc(expanded, code, env, tail=tail); return
|
||
except LispErr:
|
||
pass
|
||
|
||
# --- Constant folding (only for unshadowed globals) ---
|
||
call_args = _L(args)
|
||
if isinstance(head, Symbol) and head in _BC_FOLDABLE and all(_bc_is_const(a) for a in call_args):
|
||
if _bc_is_global(head, env):
|
||
try:
|
||
result = _BC_FOLDABLE[head]([a for a in call_args])
|
||
code.emit(OP_CONST, result); return
|
||
except Exception:
|
||
pass
|
||
|
||
# --- Specialized opcodes for hot builtins (only unshadowed) ---
|
||
if isinstance(head, Symbol) and _bc_is_global(head, env):
|
||
n = len(call_args)
|
||
spec = _BC_SPECIALIZE.get(head)
|
||
if spec and n in spec:
|
||
# Fused: (+ sym 1) → LOOK_ADD1, (- sym 1) → LOOK_SUB1
|
||
if head is S('+') and n == 2:
|
||
if _bc_is_const(call_args[1]) and call_args[1] == 1:
|
||
if isinstance(call_args[0], Symbol):
|
||
code.emit(OP_LOOK_ADD1, call_args[0]); return
|
||
_bc(call_args[0], code, env); code.emit(OP_ADD1); return
|
||
if _bc_is_const(call_args[0]) and call_args[0] == 1:
|
||
if isinstance(call_args[1], Symbol):
|
||
code.emit(OP_LOOK_ADD1, call_args[1]); return
|
||
_bc(call_args[1], code, env); code.emit(OP_ADD1); return
|
||
if head is S('-') and n == 2:
|
||
if _bc_is_const(call_args[1]) and call_args[1] == 1:
|
||
if isinstance(call_args[0], Symbol):
|
||
code.emit(OP_LOOK_SUB1, call_args[0]); return
|
||
_bc(call_args[0], code, env); code.emit(OP_SUB1); return
|
||
for arg in call_args: _bc(arg, code, env)
|
||
code.emit(spec[n]); return
|
||
|
||
# --- Self tail call optimization ---
|
||
if tail and isinstance(head, Symbol) and hasattr(code, '_self_name') and str(head) == code._self_name:
|
||
params = code._self_params
|
||
for arg in call_args: _bc(arg, code, env)
|
||
code.emit(OP_SELF_TAIL_CALL, (len(call_args), tuple(params))); return
|
||
|
||
# --- Function call ---
|
||
_bc(head, code, env)
|
||
for arg in call_args: _bc(arg, code, env)
|
||
code.emit(OP_TAIL_CALL if tail else OP_CALL, len(call_args))
|
||
|
||
|
||
def _bc_body(body, code, env, tail=False):
|
||
"""Compile body expressions (like begin)."""
|
||
if not body: code.emit(OP_VOID); return
|
||
for e in body[:-1]: _bc(e, code, env); code.emit(OP_POP)
|
||
_bc(body[-1], code, env, tail=tail)
|
||
|
||
|
||
def _bc_lambda(body, params, rest, env, name=None, self_name=None, self_params=None):
|
||
"""Compile a lambda body into a CodeObj."""
|
||
inner = CodeObj(name=name)
|
||
if self_name:
|
||
inner._self_name = self_name
|
||
inner._self_params = self_params
|
||
# Handle internal defines (letrec* semantics)
|
||
def_names = []
|
||
body_list = list(body)
|
||
i = 0
|
||
while i < len(body_list):
|
||
f = body_list[i]
|
||
if isinstance(f, Pair) and f.car is S('define'):
|
||
a = _L(f.cdr)
|
||
nm = a[0].car if isinstance(a[0], Pair) else a[0]
|
||
if isinstance(nm, Symbol): def_names.append(nm)
|
||
i += 1
|
||
elif isinstance(f, Pair) and f.car is S('begin'):
|
||
spliced = _L(f.cdr)
|
||
body_list = body_list[:i] + spliced + body_list[i+1:]
|
||
else:
|
||
break
|
||
if def_names:
|
||
inner.emit(OP_PUSH_ENV)
|
||
for nm in def_names: inner.emit(OP_VOID); inner.emit(OP_BIND, nm)
|
||
_bc_body(body_list, inner, env, tail=True)
|
||
inner.emit(OP_RETURN)
|
||
_peephole(inner)
|
||
return inner
|
||
|
||
|
||
_JUMP_OPS = frozenset([OP_JUMP, OP_JUMP_IF_FALSE, OP_JUMP_IF_FALSE_KEEP,
|
||
OP_JUMP_IF_TRUE_KEEP])
|
||
|
||
def _peephole(code):
|
||
"""Peephole optimization: eliminate dead code and redundant ops."""
|
||
instrs = code.instrs
|
||
n = len(instrs)
|
||
if n < 2: return
|
||
# Mark instructions to remove
|
||
remove = set()
|
||
for i in range(n - 1):
|
||
op, arg = instrs[i]
|
||
nop, _ = instrs[i + 1]
|
||
# VOID POP → remove both
|
||
if op == OP_VOID and nop == OP_POP:
|
||
remove.add(i); remove.add(i + 1)
|
||
# Dead code after RETURN (unless it's a jump target)
|
||
if op == OP_RETURN and nop not in (OP_RETURN,) and i + 1 not in _jump_targets(instrs):
|
||
# Only remove if next instruction is not a jump target
|
||
if nop not in (OP_PUSH_ENV, OP_POP_ENV): # be conservative
|
||
pass # skip for safety — jump target analysis is complex
|
||
# JUMP to next instruction → remove
|
||
for i in range(n):
|
||
op, arg = instrs[i]
|
||
if op == OP_JUMP and arg == i + 1:
|
||
remove.add(i)
|
||
if not remove: return
|
||
# Build index mapping: old → new
|
||
mapping = {}; new_idx = 0
|
||
for i in range(n):
|
||
mapping[i] = new_idx
|
||
if i not in remove: new_idx += 1
|
||
mapping[n] = new_idx # for jumps pointing past the end
|
||
# Rebuild with adjusted jumps and source map
|
||
new_instrs = []; new_smap = []
|
||
smap = code.source_map
|
||
for i in range(n):
|
||
if i in remove: continue
|
||
op, arg = instrs[i]
|
||
if op in _JUMP_OPS and isinstance(arg, int):
|
||
new_instrs.append((op, mapping.get(arg, arg)))
|
||
else:
|
||
new_instrs.append((op, arg))
|
||
new_smap.append(smap[i] if i < len(smap) else None)
|
||
code.instrs = new_instrs
|
||
code.source_map = new_smap
|
||
|
||
|
||
def _jump_targets(instrs):
|
||
"""Return set of instruction indices that are jump targets."""
|
||
targets = set()
|
||
for op, arg in instrs:
|
||
if op in _JUMP_OPS and isinstance(arg, int):
|
||
targets.add(arg)
|
||
return targets
|
||
|
||
|
||
class _ContInvoked(Exception):
|
||
"""Raised when a full continuation is invoked."""
|
||
__slots__ = ('cont', 'val')
|
||
def __init__(self, cont, val): self.cont = cont; self.val = val
|
||
|
||
class FullCont:
|
||
"""Full multi-shot continuation. Snapshots env at capture time."""
|
||
__slots__ = ('frames', 'stack', 'ip', 'instrs', 'env', 'vm_id')
|
||
def __init__(self, frames, stack, ip, instrs, env, vm_id):
|
||
self.frames = [(i, p, _deep_copy_env(e), list(s)) for i, p, e, s in frames]
|
||
self.stack = list(stack); self.ip = ip
|
||
self.instrs = instrs; self.env = _deep_copy_env(env); self.vm_id = vm_id
|
||
def __call__(self, args, _env):
|
||
raise _ContInvoked(self, args[0] if args else VOID)
|
||
def __repr__(self): return '#<continuation>'
|
||
|
||
_vm_depth = [0]
|
||
|
||
def vm_exec(code, env):
|
||
"""Execute compiled bytecode with explicit frame stack and continuation support."""
|
||
vm_id = object() # unique per invocation
|
||
_vm_depth[0] += 1
|
||
try:
|
||
instrs = code.instrs; ip = 0; stack = []; frames = []
|
||
smap = code.source_map
|
||
while True:
|
||
try:
|
||
return _vm_loop(instrs, ip, stack, env, frames, vm_id)
|
||
except _ContInvoked as ci:
|
||
if ci.cont.vm_id is not vm_id:
|
||
raise
|
||
c = ci.cont
|
||
frames = [(i, p, _deep_copy_env(e), list(s)) for i, p, e, s in c.frames]
|
||
stack = list(c.stack); stack.append(ci.val)
|
||
ip = c.ip; instrs = c.instrs; n_instrs = len(instrs)
|
||
env = _deep_copy_env(c.env)
|
||
smap = None
|
||
except LispErr as e:
|
||
if e.source_line is None and smap and ip > 0 and ip - 1 < len(smap):
|
||
e.source_line = smap[ip - 1]
|
||
raise
|
||
finally:
|
||
_vm_depth[0] -= 1
|
||
|
||
def _vm_loop(instrs, ip, stack, env, frames, vm_id):
|
||
"""Inner VM loop with explicit frame stack and inline caching."""
|
||
_ap = stack.append; _po = stack.pop
|
||
_isinstance = isinstance; _CP = CompiledProc; _Pr = Proc
|
||
_ic = {} # inline cache: {instr_idx: (cached_env, cached_val)}
|
||
n_instrs = len(instrs)
|
||
while ip < n_instrs:
|
||
op, arg = instrs[ip]; ip += 1
|
||
if op == OP_CONST: _ap(arg)
|
||
elif op == OP_LOOKUP:
|
||
idx = ip - 1
|
||
cached = _ic.get(idx)
|
||
if cached is not None:
|
||
ce, _ = cached
|
||
# Cache valid only if no intermediate frame shadows
|
||
# the name between env and ce (the cached env, always
|
||
# the global env). Previously only `arg not in env.b`
|
||
# was checked, which missed parent-frame shadows such
|
||
# as a let-loop param sharing a global builtin name.
|
||
# We still read the value fresh from ce.b so that
|
||
# set! on globals is observed immediately.
|
||
e = env; shadowed = False
|
||
while e is not ce:
|
||
if e is None: shadowed = True; break
|
||
if arg in e.b: shadowed = True; break
|
||
e = e.p
|
||
if not shadowed and arg in ce.b:
|
||
_ap(ce.b[arg]); continue
|
||
val = env.lookup(arg)
|
||
# Cache only if the resolved value came from global —
|
||
# i.e. no intermediate frame shadowed on the way.
|
||
g = env.g
|
||
if g is not None and arg in g.b and val is g.b[arg]:
|
||
_ic[idx] = (g, val)
|
||
_ap(val)
|
||
elif op == OP_SET: env.set(arg, _po())
|
||
elif op == OP_DEFINE: env.define(arg, _po())
|
||
elif op == OP_POP: _po()
|
||
elif op == OP_DUP: _ap(stack[-1])
|
||
elif op == OP_VOID: _ap(VOID)
|
||
elif op == OP_JUMP:
|
||
ip = arg
|
||
if _portal_checkpoint[0] is not None:
|
||
_check_portal_checkpoint(instrs, ip, stack, env, frames, vm_id)
|
||
elif op == OP_JUMP_IF_FALSE:
|
||
if _po() is False: ip = arg
|
||
elif op == OP_JUMP_IF_FALSE_KEEP:
|
||
if stack[-1] is False: ip = arg
|
||
else: _po()
|
||
elif op == OP_JUMP_IF_TRUE_KEEP:
|
||
if stack[-1] is not False: ip = arg
|
||
else: _po()
|
||
elif op == OP_CALL:
|
||
n = arg
|
||
if n: args_ = stack[-n:]; del stack[-n:]
|
||
else: args_ = []
|
||
func = _po()
|
||
if _isinstance(func, _CP):
|
||
frames.append((instrs, ip, env, stack))
|
||
env = func.env.child(func.params, func.rest, args_)
|
||
instrs = func.code.instrs; ip = 0; n_instrs = len(instrs)
|
||
stack = []; _ap = stack.append; _po = stack.pop
|
||
continue
|
||
elif _isinstance(func, _Pr):
|
||
_ap(_call(func, args_, env))
|
||
elif callable(func):
|
||
_ap(func(args_, env))
|
||
else: raise LispErr(f'not callable: {show(func)}')
|
||
elif op == OP_TAIL_CALL:
|
||
n = arg
|
||
if n: args_ = stack[-n:]; del stack[-n:]
|
||
else: args_ = []
|
||
func = _po()
|
||
if _isinstance(func, _CP):
|
||
env = func.env.child(func.params, func.rest, args_)
|
||
instrs = func.code.instrs; ip = 0; n_instrs = len(instrs)
|
||
stack.clear()
|
||
if _portal_checkpoint[0] is not None:
|
||
_check_portal_checkpoint(instrs, ip, stack, env, frames, vm_id)
|
||
continue
|
||
elif _isinstance(func, _Pr):
|
||
c = func.env.child(func.params, func.rest, args_)
|
||
body = _body_env(func.body, c) if func.has_defs else func.body
|
||
for e in body[:-1]: leval(e, c)
|
||
ret = leval(body[-1], c)
|
||
if not frames: return ret
|
||
instrs, ip, env, stack = frames.pop(); n_instrs = len(instrs)
|
||
_ap = stack.append; _po = stack.pop
|
||
_ap(ret); continue
|
||
elif callable(func):
|
||
ret = func(args_, env)
|
||
if not frames: return ret
|
||
instrs, ip, env, stack = frames.pop(); n_instrs = len(instrs)
|
||
_ap = stack.append; _po = stack.pop
|
||
_ap(ret); continue
|
||
else: raise LispErr(f'not callable: {show(func)}')
|
||
elif op == OP_RETURN:
|
||
ret = _po() if stack else VOID
|
||
if not frames: return ret
|
||
instrs, ip, env, stack = frames.pop(); n_instrs = len(instrs)
|
||
_ap = stack.append; _po = stack.pop
|
||
_ap(ret); continue
|
||
elif op == OP_MAKE_CLOSURE:
|
||
inner_code, params, rest = arg
|
||
_ap(_CP(inner_code, params, rest, env, inner_code.name))
|
||
elif op == OP_PUSH_ENV: env = Env(env)
|
||
elif op == OP_POP_ENV: env = env.p
|
||
elif op == OP_BIND: env.define(arg, _po())
|
||
elif op == OP_EVAL: _ap(leval(arg, env))
|
||
elif op == OP_CALL_CC:
|
||
proc = _po()
|
||
cont = FullCont(frames, stack, ip, instrs, env, vm_id)
|
||
if _isinstance(proc, _CP):
|
||
frames.append((instrs, ip, env, stack))
|
||
env = proc.env.child(proc.params, proc.rest, [cont])
|
||
instrs = proc.code.instrs; ip = 0; n_instrs = len(instrs)
|
||
stack = []; _ap = stack.append; _po = stack.pop
|
||
continue
|
||
elif _isinstance(proc, _Pr):
|
||
_ap(_call(proc, [cont], env))
|
||
elif callable(proc):
|
||
_ap(proc([cont], env))
|
||
else: raise LispErr(f'call/cc: not callable: {show(proc)}')
|
||
# ── Specialized opcodes ──────────────────────────────────────────
|
||
elif op == OP_ADD: b = _po(); stack[-1] = stack[-1] + b
|
||
elif op == OP_SUB: b = _po(); stack[-1] = stack[-1] - b
|
||
elif op == OP_MUL: b = _po(); stack[-1] = stack[-1] * b
|
||
elif op == OP_NEG: stack[-1] = -stack[-1]
|
||
elif op == OP_ADD1: stack[-1] = stack[-1] + 1
|
||
elif op == OP_SUB1: stack[-1] = stack[-1] - 1
|
||
elif op == OP_NUM_EQ: b = _po(); stack[-1] = stack[-1] == b
|
||
elif op == OP_LT: b = _po(); stack[-1] = stack[-1] < b
|
||
elif op == OP_GT: b = _po(); stack[-1] = stack[-1] > b
|
||
elif op == OP_LE: b = _po(); stack[-1] = stack[-1] <= b
|
||
elif op == OP_GE: b = _po(); stack[-1] = stack[-1] >= b
|
||
elif op == OP_CAR: stack[-1] = stack[-1].car
|
||
elif op == OP_CDR: stack[-1] = stack[-1].cdr
|
||
elif op == OP_CONS: d = _po(); stack[-1] = Pair(stack[-1], d)
|
||
elif op == OP_NULL_P: stack[-1] = stack[-1] is NIL
|
||
elif op == OP_PAIR_P: stack[-1] = _isinstance(stack[-1], Pair)
|
||
elif op == OP_NOT: stack[-1] = stack[-1] is False
|
||
elif op == OP_ZERO_P: stack[-1] = stack[-1] == 0
|
||
elif op == OP_VEC_REF: i = _po(); stack[-1] = stack[-1][i]
|
||
elif op == OP_VEC_SET:
|
||
v = _po(); i = _po(); stack[-1][i] = v; stack[-1] = VOID
|
||
# ── Superinstructions ────────────────────────────────────────
|
||
elif op == OP_LOOK_LOOK:
|
||
s1, s2 = arg; _ap(env.lookup(s1)); _ap(env.lookup(s2))
|
||
elif op == OP_LOOK_ADD1:
|
||
_ap(env.lookup(arg) + 1)
|
||
elif op == OP_LOOK_SUB1:
|
||
_ap(env.lookup(arg) - 1)
|
||
elif op == OP_CONST_EQ_JF:
|
||
c, addr = arg
|
||
if _po() != c: ip = addr
|
||
elif op == OP_SELF_TAIL_CALL:
|
||
n, params = arg
|
||
if n: args_ = stack[-n:]; del stack[-n:]
|
||
else: args_ = []
|
||
b = env.b
|
||
for p, a in zip(params, args_): b[p] = a
|
||
ip = 0; stack.clear(); continue
|
||
elif op == OP_LOOK_CONST_CALL2:
|
||
sym, c = arg
|
||
func = env.lookup(sym)
|
||
if _isinstance(func, _CP):
|
||
frames.append((instrs, ip, env, stack))
|
||
env = func.env.child(func.params, func.rest, [stack[-1], c])
|
||
del stack[-1:]
|
||
instrs = func.code.instrs; ip = 0; n_instrs = len(instrs)
|
||
stack = []; _ap = stack.append; _po = stack.pop
|
||
continue
|
||
elif callable(func):
|
||
v = stack[-1]; stack[-1] = func([v, c], env)
|
||
else: _ap(func([stack.pop(), c], env))
|
||
return stack[-1] if stack else VOID
|
||
|
||
|
||
###############################################################################
|
||
# Bytecode Serialization
|
||
###############################################################################
|
||
|
||
import json as _json
|
||
|
||
def _serialize_operand(val):
|
||
"""Serialize a bytecode operand to a JSON-compatible value."""
|
||
if val is None: return None
|
||
if val is True: return {'t': 'bool', 'v': True}
|
||
if val is False: return {'t': 'bool', 'v': False}
|
||
if isinstance(val, int): return val # JSON native
|
||
if isinstance(val, float):
|
||
if math.isinf(val): return {'t': 'float', 'v': '+inf' if val > 0 else '-inf'}
|
||
if math.isnan(val): return {'t': 'float', 'v': 'nan'}
|
||
return {'t': 'float', 'v': val}
|
||
if isinstance(val, Fraction): return {'t': 'frac', 'n': val.numerator, 'd': val.denominator}
|
||
if isinstance(val, Symbol): return {'t': 'sym', 'v': str(val)}
|
||
if isinstance(val, MutableString): return {'t': 'str', 'v': str(val)}
|
||
if isinstance(val, str): return {'t': 'str', 'v': val}
|
||
if val is NIL: return {'t': 'nil'}
|
||
if val is VOID: return {'t': 'void'}
|
||
if val is EOF: return {'t': 'eof'}
|
||
if isinstance(val, Pair): return {'t': 'pair', 'car': _serialize_operand(val.car),
|
||
'cdr': _serialize_operand(val.cdr)}
|
||
if isinstance(val, list): # vector
|
||
return {'t': 'vec', 'v': [_serialize_operand(x) for x in val]}
|
||
if isinstance(val, tuple):
|
||
# OP_MAKE_CLOSURE: (CodeObj, params, rest)
|
||
if len(val) == 3 and isinstance(val[0], CodeObj):
|
||
code, params, rest = val
|
||
return {'t': 'closure', 'code': _serialize_code(code),
|
||
'params': [str(p) for p in params],
|
||
'rest': str(rest) if rest else None}
|
||
# OP_SELF_TAIL_CALL: (n_args, params_tuple)
|
||
if len(val) == 2 and isinstance(val[0], int) and isinstance(val[1], tuple):
|
||
return {'t': 'stc', 'n': val[0], 'p': [str(p) for p in val[1]]}
|
||
return {'t': 'repr', 'v': repr(val)}
|
||
|
||
def _deserialize_operand(data):
|
||
"""Deserialize a bytecode operand from JSON data."""
|
||
if data is None: return None
|
||
if isinstance(data, int): return data
|
||
if isinstance(data, dict):
|
||
t = data.get('t')
|
||
if t == 'bool': return data['v']
|
||
if t == 'float':
|
||
v = data['v']
|
||
if v == '+inf': return math.inf
|
||
if v == '-inf': return -math.inf
|
||
if v == 'nan': return float('nan')
|
||
return v
|
||
if t == 'frac': return Fraction(data['n'], data['d'])
|
||
if t == 'sym': return S(data['v'])
|
||
if t == 'str': return data['v']
|
||
if t == 'nil': return NIL
|
||
if t == 'void': return VOID
|
||
if t == 'eof': return EOF
|
||
if t == 'pair': return Pair(_deserialize_operand(data['car']),
|
||
_deserialize_operand(data['cdr']))
|
||
if t == 'vec': return [_deserialize_operand(x) for x in data['v']]
|
||
if t == 'closure':
|
||
code = _deserialize_code(data['code'])
|
||
params = [S(p) for p in data['params']]
|
||
rest = S(data['rest']) if data['rest'] else None
|
||
return (code, params, rest)
|
||
if t == 'stc':
|
||
return (data['n'], tuple(S(p) for p in data['p']))
|
||
return data
|
||
|
||
def _serialize_code(code):
|
||
"""Serialize a CodeObj to a JSON-compatible dict."""
|
||
return {
|
||
'name': code.name,
|
||
'instrs': [[op, _serialize_operand(arg)] for op, arg in code.instrs],
|
||
'source_map': code.source_map,
|
||
}
|
||
|
||
def _deserialize_code(data):
|
||
"""Deserialize a CodeObj from a JSON dict."""
|
||
code = CodeObj(name=data.get('name'))
|
||
code.instrs = [(op, _deserialize_operand(arg)) for op, arg in data['instrs']]
|
||
code.source_map = data.get('source_map', [None] * len(code.instrs))
|
||
return code
|
||
|
||
def save_compiled(path, proc):
|
||
"""Save a compiled procedure to a .lspc file."""
|
||
if not isinstance(proc, CompiledProc):
|
||
raise LispErr(f'save-compiled: not a compiled procedure: {show(proc)}')
|
||
data = {
|
||
'format': 'lspc-v1',
|
||
'name': proc.name,
|
||
'params': [str(p) for p in proc.params],
|
||
'rest': str(proc.rest) if proc.rest else None,
|
||
'code': _serialize_code(proc.code),
|
||
}
|
||
with open(path, 'w') as f:
|
||
_json.dump(data, f, separators=(',', ':'))
|
||
|
||
def load_compiled(path, env):
|
||
"""Load a compiled procedure from a .lspc file."""
|
||
with open(path) as f:
|
||
data = _json.load(f)
|
||
if data.get('format') != 'lspc-v1':
|
||
raise LispErr(f'load-compiled: unsupported format: {data.get("format")}')
|
||
code = _deserialize_code(data['code'])
|
||
params = [S(p) for p in data['params']]
|
||
rest = S(data['rest']) if data['rest'] else None
|
||
return CompiledProc(code, params, rest, env, data.get('name'))
|
||
|
||
|
||
###############################################################################
|
||
# xoshiro256** — deterministic, portable PRNG shared with C and asm impls.
|
||
# Portal serializes this state so simulations continue across processes with
|
||
# a bit-identical random stream. Reference: Blackman & Vigna 2018.
|
||
###############################################################################
|
||
|
||
_MASK64 = (1 << 64) - 1
|
||
_rng_state = [0, 0, 0, 0]
|
||
|
||
|
||
def _rng_splitmix64_step(z): # noqa: E501 forward decl — _rng_seed(0) runs below
|
||
"""Returns (output, next_counter). Reference: Vigna splitmix64.
|
||
The persistent counter advances only by the constant; the mixing
|
||
is on a local copy."""
|
||
z = (z + 0x9e3779b97f4a7c15) & _MASK64
|
||
r = z
|
||
r = ((r ^ (r >> 30)) * 0xbf58476d1ce4e5b9) & _MASK64
|
||
r = ((r ^ (r >> 27)) * 0x94d049bb133111eb) & _MASK64
|
||
return (r ^ (r >> 31)) & _MASK64, z
|
||
|
||
|
||
def _rng_seed(k):
|
||
z = k & _MASK64
|
||
for i in range(4):
|
||
_rng_state[i], z = _rng_splitmix64_step(z)
|
||
|
||
|
||
def _rng_next():
|
||
s = _rng_state
|
||
v = (s[1] * 5) & _MASK64
|
||
result = ((((v << 7) & _MASK64) | (v >> 57)) * 9) & _MASK64
|
||
t = (s[1] << 17) & _MASK64
|
||
s[2] ^= s[0]
|
||
s[3] ^= s[1]
|
||
s[1] ^= s[2]
|
||
s[0] ^= s[3]
|
||
s[2] ^= t
|
||
s[3] = (((s[3] << 45) & _MASK64) | (s[3] >> 19)) & _MASK64
|
||
return result
|
||
|
||
|
||
def _rng_random_float():
|
||
return (_rng_next() >> 11) / (1 << 53)
|
||
|
||
|
||
def _rng_random_int(n):
|
||
if n <= 0: raise LispErr(f'random-int: n must be positive, got {n}')
|
||
return _rng_next() % n
|
||
|
||
|
||
def _rng_state_to_halves():
|
||
out = []
|
||
for w in _rng_state:
|
||
out.append(w & 0xffffffff)
|
||
out.append((w >> 32) & 0xffffffff)
|
||
return out
|
||
|
||
|
||
def _rng_state_from_halves(halves):
|
||
if len(halves) != 8:
|
||
raise LispErr('random-state!: expected list of 8 integers')
|
||
for i in range(4):
|
||
lo = halves[2 * i] & 0xffffffff
|
||
hi = halves[2 * i + 1] & 0xffffffff
|
||
_rng_state[i] = (hi << 32) | lo
|
||
|
||
|
||
def _rng_seed_from_os():
|
||
"""Read 8 bytes from /dev/urandom and seed xoshiro256**. Opt-in entropy
|
||
for stochastic runs; determinism remains the default (seed=0 at startup).
|
||
See docs/tickets/0002-os-entropy-seed.md."""
|
||
with open('/dev/urandom', 'rb') as f:
|
||
b = f.read(8)
|
||
if len(b) != 8:
|
||
raise LispErr('random-seed-from-os!: short read from /dev/urandom')
|
||
_rng_seed(int.from_bytes(b, 'little', signed=False))
|
||
|
||
|
||
# Default seed = 0 at module load so (random) without (random-seed!) is
|
||
# deterministic and non-zero. All three impls agree on this startup state.
|
||
_rng_seed(0)
|
||
|
||
|
||
###############################################################################
|
||
# Portal — Serialize/resume full machine state across machines
|
||
###############################################################################
|
||
|
||
class _PortalSerializer:
|
||
"""Graph-aware serializer with identity tracking for shared references."""
|
||
def __init__(self):
|
||
self._memo = {} # id(obj) → ref_id
|
||
self._objs = [] # ref_id → serialized data
|
||
self._next = 0
|
||
|
||
def _ref(self, obj):
|
||
"""Get or assign a ref ID for an object."""
|
||
oid = id(obj)
|
||
if oid in self._memo:
|
||
return self._memo[oid], True # (ref_id, already_seen)
|
||
rid = self._next; self._next += 1
|
||
self._memo[oid] = rid
|
||
return rid, False
|
||
|
||
def serialize_value(self, val):
|
||
"""Serialize any Lisp value, tracking shared references."""
|
||
if val is None: return None
|
||
if val is True: return {'t': 'bool', 'v': True}
|
||
if val is False: return {'t': 'bool', 'v': False}
|
||
if val is NIL: return {'t': 'nil'}
|
||
if val is VOID: return {'t': 'void'}
|
||
if val is EOF: return {'t': 'eof'}
|
||
if isinstance(val, int) and not isinstance(val, bool): return val
|
||
if isinstance(val, float):
|
||
if math.isinf(val): return {'t': 'float', 'v': '+inf' if val > 0 else '-inf'}
|
||
if math.isnan(val): return {'t': 'float', 'v': 'nan'}
|
||
return {'t': 'float', 'v': val}
|
||
if isinstance(val, Fraction):
|
||
return {'t': 'frac', 'n': val.numerator, 'd': val.denominator}
|
||
if isinstance(val, Symbol): return {'t': 'sym', 'v': str(val)}
|
||
if isinstance(val, MutableString): return {'t': 'mstr', 'v': str(val)}
|
||
if isinstance(val, str): return {'t': 'str', 'v': val}
|
||
# Reference-tracked objects (may be shared)
|
||
if isinstance(val, Env): return self.serialize_env(val)
|
||
if isinstance(val, CompiledProc): return self.serialize_compiled_proc(val)
|
||
if isinstance(val, FullCont): return self.serialize_continuation(val)
|
||
if isinstance(val, Proc): return self.serialize_proc(val)
|
||
if isinstance(val, Pair): return self.serialize_pair(val)
|
||
if isinstance(val, CodeObj): return {'t': 'code', 'd': _serialize_code(val)}
|
||
if isinstance(val, list): # vector
|
||
return {'t': 'vec', 'v': [self.serialize_value(x) for x in val]}
|
||
if isinstance(val, dict): # hash table
|
||
return {'t': 'hash', 'entries': [[self.serialize_value(k), self.serialize_value(v)]
|
||
for k, v in val.items()]}
|
||
if isinstance(val, tuple):
|
||
if len(val) == 3 and isinstance(val[0], CodeObj):
|
||
code, params, rest = val
|
||
return {'t': 'closure_tuple', 'code': _serialize_code(code),
|
||
'params': [str(p) for p in params],
|
||
'rest': str(rest) if rest else None}
|
||
return {'t': 'tuple', 'v': [self.serialize_value(x) for x in val]}
|
||
if callable(val):
|
||
return {'t': 'builtin', 'name': getattr(val, '__name__', repr(val))}
|
||
return {'t': 'opaque', 'repr': repr(val)[:100]}
|
||
|
||
def serialize_env(self, env):
|
||
"""Serialize an env with shared reference tracking."""
|
||
if env is None: return None
|
||
rid, seen = self._ref(env)
|
||
if seen: return {'t': 'env_ref', 'id': rid}
|
||
is_global = (env.g is env)
|
||
# Only serialize user-defined bindings (skip builtins for global env)
|
||
if is_global:
|
||
user_binds = {str(k): self.serialize_value(v)
|
||
for k, v in env.b.items()
|
||
if isinstance(v, (CompiledProc, Proc, int, float, Fraction,
|
||
str, bool, Pair, list, dict, MutableString))
|
||
or v is NIL or v is VOID or v is True or v is False
|
||
or isinstance(v, Symbol)}
|
||
else:
|
||
user_binds = {str(k): self.serialize_value(v) for k, v in env.b.items()}
|
||
data = {'t': 'env', 'id': rid, 'global': is_global,
|
||
'binds': user_binds,
|
||
'parent': self.serialize_env(env.p)}
|
||
self._objs.append(data)
|
||
return {'t': 'env_ref', 'id': rid}
|
||
|
||
def serialize_compiled_proc(self, proc):
|
||
rid, seen = self._ref(proc)
|
||
if seen: return {'t': 'cproc_ref', 'id': rid}
|
||
data = {'t': 'cproc', 'id': rid, 'name': proc.name,
|
||
'params': [str(p) for p in proc.params],
|
||
'rest': str(proc.rest) if proc.rest else None,
|
||
'code': _serialize_code(proc.code),
|
||
'env': self.serialize_env(proc.env)}
|
||
self._objs.append(data)
|
||
return {'t': 'cproc_ref', 'id': rid}
|
||
|
||
def serialize_proc(self, proc):
|
||
"""Serialize an interpreted Proc (body as source)."""
|
||
rid, seen = self._ref(proc)
|
||
if seen: return {'t': 'proc_ref', 'id': rid}
|
||
body_src = [show(e) for e in proc.body]
|
||
data = {'t': 'proc', 'id': rid, 'name': proc.name,
|
||
'params': [str(p) for p in proc.params],
|
||
'rest': str(proc.rest) if proc.rest else None,
|
||
'body': body_src,
|
||
'env': self.serialize_env(proc.env)}
|
||
self._objs.append(data)
|
||
return {'t': 'proc_ref', 'id': rid}
|
||
|
||
def serialize_pair(self, pair):
|
||
"""Serialize a Pair (no sharing tracking for simplicity)."""
|
||
return {'t': 'pair', 'car': self.serialize_value(pair.car),
|
||
'cdr': self.serialize_value(pair.cdr)}
|
||
|
||
def serialize_continuation(self, cont):
|
||
rid, seen = self._ref(cont)
|
||
if seen: return {'t': 'cont_ref', 'id': rid}
|
||
data = {'t': 'cont', 'id': rid,
|
||
'frames': [{'instrs': _serialize_code(CodeObj_from_instrs(i)),
|
||
'ip': p, 'env': self.serialize_env(e),
|
||
'stack': [self.serialize_value(v) for v in s]}
|
||
for i, p, e, s in cont.frames],
|
||
'stack': [self.serialize_value(v) for v in cont.stack],
|
||
'ip': cont.ip,
|
||
'instrs': _serialize_code(CodeObj_from_instrs(cont.instrs)),
|
||
'env': self.serialize_env(cont.env)}
|
||
self._objs.append(data)
|
||
return {'t': 'cont_ref', 'id': rid}
|
||
|
||
def finalize(self):
|
||
return self._objs
|
||
|
||
|
||
def CodeObj_from_instrs(instrs):
|
||
"""Wrap raw instruction list in a CodeObj for serialization."""
|
||
code = CodeObj()
|
||
code.instrs = list(instrs)
|
||
code.source_map = [None] * len(instrs)
|
||
return code
|
||
|
||
|
||
class _PortalDeserializer:
|
||
"""Rebuild machine state from serialized data."""
|
||
def __init__(self, base_env):
|
||
self._env = base_env # global env with builtins
|
||
self._refs = {} # ref_id → reconstructed object
|
||
|
||
def deserialize_value(self, data):
|
||
if data is None: return None
|
||
if isinstance(data, int): return data
|
||
if not isinstance(data, dict): return data
|
||
t = data.get('t')
|
||
if t == 'bool': return data['v']
|
||
if t == 'float':
|
||
v = data['v']
|
||
if v == '+inf': return math.inf
|
||
if v == '-inf': return -math.inf
|
||
if v == 'nan': return float('nan')
|
||
return v
|
||
if t == 'frac': return Fraction(data['n'], data['d'])
|
||
if t == 'sym': return S(data['v'])
|
||
if t == 'str': return data['v']
|
||
if t == 'mstr': return MutableString(data['v'])
|
||
if t == 'nil': return NIL
|
||
if t == 'void': return VOID
|
||
if t == 'eof': return EOF
|
||
if t == 'pair': return Pair(self.deserialize_value(data['car']),
|
||
self.deserialize_value(data['cdr']))
|
||
if t == 'vec': return [self.deserialize_value(x) for x in data['v']]
|
||
if t == 'hash':
|
||
return {self.deserialize_value(k): self.deserialize_value(v)
|
||
for k, v in data['entries']}
|
||
if t == 'tuple':
|
||
return tuple(self.deserialize_value(x) for x in data['v'])
|
||
if t == 'closure_tuple':
|
||
code = _deserialize_code(data['code'])
|
||
params = [S(p) for p in data['params']]
|
||
rest = S(data['rest']) if data['rest'] else None
|
||
return (code, params, rest)
|
||
if t == 'env_ref': return self._refs.get(data['id'], self._env)
|
||
if t == 'cproc_ref': return self._refs.get(data['id'])
|
||
if t == 'proc_ref': return self._refs.get(data['id'])
|
||
if t == 'cont_ref': return self._refs.get(data['id'])
|
||
if t == 'builtin': return self._env.lookup(S(data['name'])) if data['name'] else None
|
||
return VOID
|
||
|
||
def rebuild_objects(self, objs):
|
||
"""Two-pass rebuild: create shells, then fill in."""
|
||
# Pass 1: create empty shells
|
||
for obj in objs:
|
||
t = obj['t']; rid = obj['id']
|
||
if t == 'env':
|
||
e = Env.__new__(Env)
|
||
e.b = {}; e.p = None; e.g = None
|
||
self._refs[rid] = e
|
||
elif t == 'cproc':
|
||
cp = CompiledProc.__new__(CompiledProc)
|
||
self._refs[rid] = cp
|
||
elif t == 'proc':
|
||
p = Proc.__new__(Proc)
|
||
self._refs[rid] = p
|
||
elif t == 'cont':
|
||
c = FullCont.__new__(FullCont)
|
||
self._refs[rid] = c
|
||
|
||
# Pass 2: fill in
|
||
for obj in objs:
|
||
t = obj['t']; rid = obj['id']
|
||
if t == 'env':
|
||
e = self._refs[rid]
|
||
e.p = self.deserialize_value(obj['parent'])
|
||
is_global = obj.get('global', False)
|
||
if is_global:
|
||
e.g = e
|
||
# Merge user bindings into existing global env
|
||
for k, v in obj['binds'].items():
|
||
val = self.deserialize_value(v)
|
||
if val is not None:
|
||
self._env.define(S(k), val)
|
||
# Use the actual global env
|
||
self._refs[rid] = self._env
|
||
else:
|
||
e.g = self._env.g if self._env else None
|
||
for k, v in obj['binds'].items():
|
||
e.b[S(k)] = self.deserialize_value(v)
|
||
elif t == 'cproc':
|
||
cp = self._refs[rid]
|
||
cp.code = _deserialize_code(obj['code'])
|
||
cp.params = [S(p) for p in obj['params']]
|
||
cp.rest = S(obj['rest']) if obj['rest'] else None
|
||
cp.name = obj.get('name')
|
||
cp.env = self.deserialize_value(obj['env'])
|
||
elif t == 'proc':
|
||
p = self._refs[rid]
|
||
p.params = [S(x) for x in obj['params']]
|
||
p.rest = S(obj['rest']) if obj['rest'] else None
|
||
p.name = obj.get('name')
|
||
p.body = [read_all(s)[0] for s in obj['body']]
|
||
p.env = self.deserialize_value(obj['env'])
|
||
p.has_defs = _has_internal_defines(p.body)
|
||
elif t == 'cont':
|
||
c = self._refs[rid]
|
||
c.vm_id = object()
|
||
c.ip = obj['ip']
|
||
c.instrs = _deserialize_code(obj['instrs']).instrs
|
||
c.env = self.deserialize_value(obj['env'])
|
||
c.stack = [self.deserialize_value(v) for v in obj['stack']]
|
||
c.frames = []
|
||
for f in obj['frames']:
|
||
fi = _deserialize_code(f['instrs']).instrs
|
||
fp = f['ip']
|
||
fe = self.deserialize_value(f['env'])
|
||
fs = [self.deserialize_value(v) for v in f['stack']]
|
||
c.frames.append((fi, fp, fe, fs))
|
||
|
||
|
||
def portal_save(env, path, continuation=None):
|
||
"""Save machine state to a .portal file."""
|
||
ser = _PortalSerializer()
|
||
state = {
|
||
'format': 'lumbda-portal-v1',
|
||
'env': ser.serialize_env(env),
|
||
'continuation': ser.serialize_continuation(continuation) if continuation else None,
|
||
'auto_compile': _auto_compile[0],
|
||
'rng': {'algo': 'xoshiro256**', 'state': _rng_state_to_halves()},
|
||
}
|
||
state['objects'] = ser.finalize()
|
||
with open(path, 'w') as f:
|
||
_json.dump(state, f, indent=1)
|
||
|
||
|
||
def portal_resume(path, base_env=None):
|
||
"""Resume machine state from a .portal file. Returns (env, continuation_or_None)."""
|
||
with open(path) as f:
|
||
state = _json.load(f)
|
||
if state.get('format') != 'lumbda-portal-v1':
|
||
raise LispErr(f'portal: unsupported format: {state.get("format")}')
|
||
if base_env is None:
|
||
base_env = make_global_env()
|
||
for expr in read_all(PRELUDE): leval(expr, base_env)
|
||
des = _PortalDeserializer(base_env)
|
||
des.rebuild_objects(state.get('objects', []))
|
||
_auto_compile[0] = state.get('auto_compile', False)
|
||
rng = state.get('rng')
|
||
if rng and 'state' in rng:
|
||
_rng_state_from_halves(rng['state'])
|
||
cont = None
|
||
if state.get('continuation'):
|
||
cont = des.deserialize_value(state['continuation'])
|
||
return base_env, cont
|
||
|
||
|
||
# Portal checkpoint for mid-execution save
|
||
# MOAD-0002: Module-level global — intentional coupling. This is checked in the VM hot
|
||
# loop (OP_JUMP, OP_TAIL_CALL) so passing it as a parameter would add overhead to every
|
||
# iteration. The mutable list wrapper allows portal-checkpoint! to signal the VM without
|
||
# requiring a context object threaded through vm_exec/vm_loop.
|
||
_portal_checkpoint = [None] # set to a path to trigger save during VM execution
|
||
|
||
def _check_portal_checkpoint(instrs, ip, stack, env, frames, vm_id):
|
||
"""Check if a portal save was requested. Called from VM loop."""
|
||
path = _portal_checkpoint[0]
|
||
if path is None: return
|
||
_portal_checkpoint[0] = None
|
||
cont = FullCont(frames, stack, ip, instrs, env, vm_id)
|
||
portal_save(env, path, continuation=cont)
|
||
|
||
|
||
# Auto-compile flag
|
||
_auto_compile = [False]
|
||
|
||
|
||
def bc_compile_proc(proc, env):
|
||
"""Compile a Proc into a CompiledProc."""
|
||
if isinstance(proc, CompiledProc): return proc
|
||
if not isinstance(proc, Proc): raise LispErr(f'compile: not a procedure: {show(proc)}')
|
||
code = _bc_lambda(proc.body, proc.params, proc.rest, env, name=proc.name)
|
||
return CompiledProc(code, proc.params, proc.rest, proc.env, proc.name)
|
||
|
||
|
||
###############################################################################
|
||
# JIT: Transpile bytecode to Python source, exec() it
|
||
###############################################################################
|
||
|
||
def _jit_compile(proc):
|
||
"""JIT a Proc/CompiledProc to a native Python function via AST transpilation."""
|
||
if isinstance(proc, CompiledProc):
|
||
# Need the original AST — can't JIT from bytecode alone
|
||
return None
|
||
if not isinstance(proc, Proc): return None
|
||
if proc.rest: return None # rest args too complex
|
||
|
||
params = [_jit_pyname(p) for p in proc.params]
|
||
name = proc.name or '_fn'
|
||
pyname = _jit_pyname(name)
|
||
|
||
try:
|
||
body_src = _jit_expr(proc.body, params)
|
||
except _JitBail:
|
||
return None
|
||
|
||
source = f'def {pyname}({", ".join(params)}):\n return {body_src}'
|
||
ns = {'Pair': Pair, 'NIL': NIL, 'VOID': VOID, 'S': S, 'Fraction': Fraction,
|
||
'True': True, 'False': False}
|
||
# Add self-reference for recursion
|
||
try:
|
||
exec(source, ns)
|
||
fn = ns[pyname]
|
||
# For recursive functions, bind self
|
||
if name in source:
|
||
ns[pyname] = fn
|
||
exec(source, ns)
|
||
fn = ns[pyname]
|
||
def jit_wrapper(args, env):
|
||
return fn(*args)
|
||
jit_wrapper._jit_source = source
|
||
jit_wrapper._jit_name = name
|
||
return jit_wrapper
|
||
except Exception:
|
||
return None
|
||
|
||
|
||
class _JitBail(Exception): pass
|
||
|
||
def _jit_pyname(s):
|
||
"""Sanitize a Scheme identifier to a valid Python identifier."""
|
||
r = str(s).replace('-', '_').replace('?', '_p').replace('!', '_b').replace('>', '_gt').replace('<', '_lt').replace('/', '_sl').replace('*', '_st').replace('+', '_pl').replace('=', '_eq')
|
||
if not r or r[0].isdigit(): r = '_' + r
|
||
if r in ('and', 'or', 'not', 'if', 'else', 'return', 'while', 'for', 'in', 'is',
|
||
'True', 'False', 'None', 'def', 'class', 'lambda', 'pass', 'break', 'continue'):
|
||
r = r + '_'
|
||
return r
|
||
|
||
def _jit_expr(body, params):
|
||
"""Transpile Scheme body (list of exprs) to a Python expression string."""
|
||
if len(body) == 1: return _jit_one(body[0], params)
|
||
# begin: evaluate all, return last (only works if non-last are side-effect-free)
|
||
# For JIT, bail on side effects in non-tail position
|
||
return _jit_one(body[-1], params)
|
||
|
||
def _jit_one(expr, params):
|
||
"""Transpile a single Scheme expression to a Python expression string."""
|
||
if expr is True: return 'True'
|
||
if expr is False: return 'False'
|
||
if expr is NIL: return 'NIL'
|
||
if isinstance(expr, (int, float)): return repr(expr)
|
||
if isinstance(expr, Fraction): return f'Fraction({expr.numerator},{expr.denominator})'
|
||
if isinstance(expr, str) and not isinstance(expr, Symbol): return repr(expr)
|
||
if isinstance(expr, Symbol):
|
||
return _jit_pyname(expr)
|
||
if not isinstance(expr, Pair): raise _JitBail()
|
||
|
||
head = expr.car; args = _L(expr.cdr)
|
||
|
||
# Special forms
|
||
if head is S('if'):
|
||
test = _jit_one(args[0], params)
|
||
then = _jit_one(args[1], params)
|
||
els = _jit_one(args[2], params) if len(args) > 2 else 'VOID'
|
||
return f'({then} if {test} else {els})'
|
||
|
||
if head is S('cond'):
|
||
return _jit_cond(args, params)
|
||
|
||
if head is S('begin'):
|
||
return _jit_one(args[-1], params)
|
||
|
||
if head is S('let'):
|
||
if isinstance(args[0], Symbol):
|
||
# Named let → while loop as a helper function
|
||
return _jit_named_let(args, params)
|
||
# Regular let → inline
|
||
binds = _L(args[0]); body = args[1:]
|
||
bind_strs = []
|
||
new_params = list(params)
|
||
for b in binds:
|
||
bp = _L(b)
|
||
bind_strs.append(f'{bp[0]}={_jit_one(bp[1], params)}')
|
||
new_params.append(str(bp[0]))
|
||
body_str = _jit_expr(body, new_params)
|
||
return f'(lambda {",".join(str(_L(b)[0]) for b in binds)}: {body_str})({",".join(_jit_one(_L(b)[1], params) for b in binds)})'
|
||
|
||
if head is S('and'):
|
||
if not args: return 'True'
|
||
parts = [_jit_one(a, params) for a in args]
|
||
return ' and '.join(f'({p})' for p in parts)
|
||
|
||
if head is S('or'):
|
||
if not args: return 'False'
|
||
parts = [_jit_one(a, params) for a in args]
|
||
return ' or '.join(f'({p})' for p in parts)
|
||
|
||
if head is S('quote'):
|
||
raise _JitBail() # can't represent arbitrary quoted data
|
||
|
||
# Known pure functions → inline Python
|
||
_PYOP = {
|
||
S('+'): '+', S('-'): '-', S('*'): '*',
|
||
S('='): '==', S('<'): '<', S('>'): '>',
|
||
S('<='): '<=', S('>='): '>=',
|
||
}
|
||
if head in _PYOP and len(args) == 2:
|
||
a = _jit_one(args[0], params); b = _jit_one(args[1], params)
|
||
return f'({a} {_PYOP[head]} {b})'
|
||
if head is S('+') and len(args) == 1: return _jit_one(args[0], params)
|
||
if head is S('-') and len(args) == 1: return f'(-{_jit_one(args[0], params)})'
|
||
if head is S('not'): return f'(not {_jit_one(args[0], params)})'
|
||
if head is S('zero?'): return f'({_jit_one(args[0], params)} == 0)'
|
||
if head is S('null?'): return f'({_jit_one(args[0], params)} is NIL)'
|
||
if head is S('pair?'): return f'isinstance({_jit_one(args[0], params)}, Pair)'
|
||
if head is S('car'): return f'{_jit_one(args[0], params)}.car'
|
||
if head is S('cdr'): return f'{_jit_one(args[0], params)}.cdr'
|
||
if head is S('cons'): return f'Pair({_jit_one(args[0], params)},{_jit_one(args[1], params)})'
|
||
if head is S('remainder'): return f'({_jit_one(args[0], params)} % {_jit_one(args[1], params)})'
|
||
if head is S('modulo'): return f'({_jit_one(args[0], params)} % {_jit_one(args[1], params)})'
|
||
if head is S('abs'): return f'abs({_jit_one(args[0], params)})'
|
||
if head is S('expt'): return f'({_jit_one(args[0], params)} ** {_jit_one(args[1], params)})'
|
||
|
||
# Generic function call
|
||
if isinstance(head, Symbol):
|
||
fn = _jit_pyname(head)
|
||
call_args = ', '.join(_jit_one(a, params) for a in args)
|
||
return f'{fn}({call_args})'
|
||
|
||
raise _JitBail()
|
||
|
||
|
||
def _jit_cond(clauses, params):
|
||
"""Transpile cond to nested ternary."""
|
||
if not clauses: return 'VOID'
|
||
cl = _L(clauses[0])
|
||
if cl[0] is S('else'):
|
||
return _jit_expr(cl[1:], params)
|
||
test = _jit_one(cl[0], params)
|
||
then = _jit_expr(cl[1:], params) if len(cl) > 1 else test
|
||
rest = _jit_cond(clauses[1:], params)
|
||
return f'({then} if {test} else {rest})'
|
||
|
||
|
||
def _jit_named_let(args, params):
|
||
"""Transpile named let to a Python helper with while loop.
|
||
Returns a Python expression that calls the helper."""
|
||
name = str(args[0])
|
||
binds = _L(args[1]); body = args[2:]
|
||
bparams = [str(_L(b)[0]) for b in binds]
|
||
all_params = list(params) + bparams + [name]
|
||
|
||
# The body becomes a while-True loop with return/continue
|
||
body_expr = _jit_expr(body, all_params)
|
||
|
||
# For simple tail-recursive patterns (if test return_val (loop ...)),
|
||
# we can generate a while loop. But for the general case,
|
||
# use recursive Python function.
|
||
init_args = ', '.join(_jit_one(_L(b)[1], params) for b in binds)
|
||
# Generate as a local recursive function
|
||
raise _JitBail() # named-let needs statement-level code, not expression
|
||
|
||
|
||
def _jit_transpile(instrs, params, name, has_self_tc):
|
||
"""Transpile bytecode to Python source lines using recursive descent."""
|
||
lines = [f'def {name}({", ".join(params)}):']
|
||
indent = ' '
|
||
if has_self_tc:
|
||
lines.append(f'{indent}while True:')
|
||
indent = ' '
|
||
|
||
def _expr(ip):
|
||
"""Transpile expression starting at ip, return (python_expr_string, next_ip)."""
|
||
if ip >= len(instrs): raise _JitBail()
|
||
op, arg = instrs[ip]
|
||
if op == OP_CONST:
|
||
if arg is True: return 'True', ip+1
|
||
if arg is False: return 'False', ip+1
|
||
if arg is NIL: return 'NIL', ip+1
|
||
if isinstance(arg, str) and not isinstance(arg, Symbol): return repr(arg), ip+1
|
||
return repr(arg), ip+1
|
||
if op == OP_LOOKUP: return str(arg), ip+1
|
||
if op == OP_LOOK_ADD1: return f'({arg} + 1)', ip+1
|
||
if op == OP_LOOK_SUB1: return f'({arg} - 1)', ip+1
|
||
if op == OP_VOID: return 'VOID', ip+1
|
||
# Binary ops: left expr, right expr, op
|
||
if op in (OP_ADD, OP_SUB, OP_MUL, OP_NUM_EQ, OP_LT, OP_GT, OP_LE, OP_GE,
|
||
OP_CONS, OP_VEC_REF):
|
||
raise _JitBail() # handled by stack below
|
||
raise _JitBail()
|
||
|
||
def _block(ip, end):
|
||
"""Transpile a block of instructions [ip, end), return list of (stmt, next_ip)."""
|
||
stmts = []; stack = []
|
||
while ip < end:
|
||
op, arg = instrs[ip]
|
||
if op == OP_CONST:
|
||
if arg is True: stack.append('True')
|
||
elif arg is False: stack.append('False')
|
||
elif arg is NIL: stack.append('NIL')
|
||
elif isinstance(arg, str) and not isinstance(arg, Symbol):
|
||
stack.append(repr(arg))
|
||
else: stack.append(repr(arg))
|
||
ip += 1
|
||
elif op == OP_LOOKUP: stack.append(str(arg)); ip += 1
|
||
elif op == OP_LOOK_ADD1: stack.append(f'({arg} + 1)'); ip += 1
|
||
elif op == OP_LOOK_SUB1: stack.append(f'({arg} - 1)'); ip += 1
|
||
elif op == OP_VOID: stack.append('VOID'); ip += 1
|
||
elif op == OP_ADD: b=stack.pop(); a=stack.pop(); stack.append(f'({a} + {b})'); ip+=1
|
||
elif op == OP_SUB: b=stack.pop(); a=stack.pop(); stack.append(f'({a} - {b})'); ip+=1
|
||
elif op == OP_MUL: b=stack.pop(); a=stack.pop(); stack.append(f'({a} * {b})'); ip+=1
|
||
elif op == OP_NEG: a=stack.pop(); stack.append(f'(-{a})'); ip+=1
|
||
elif op == OP_ADD1: a=stack.pop(); stack.append(f'({a} + 1)'); ip+=1
|
||
elif op == OP_SUB1: a=stack.pop(); stack.append(f'({a} - 1)'); ip+=1
|
||
elif op == OP_NUM_EQ: b=stack.pop(); a=stack.pop(); stack.append(f'({a} == {b})'); ip+=1
|
||
elif op == OP_LT: b=stack.pop(); a=stack.pop(); stack.append(f'({a} < {b})'); ip+=1
|
||
elif op == OP_GT: b=stack.pop(); a=stack.pop(); stack.append(f'({a} > {b})'); ip+=1
|
||
elif op == OP_LE: b=stack.pop(); a=stack.pop(); stack.append(f'({a} <= {b})'); ip+=1
|
||
elif op == OP_GE: b=stack.pop(); a=stack.pop(); stack.append(f'({a} >= {b})'); ip+=1
|
||
elif op == OP_NOT: a=stack.pop(); stack.append(f'(not {a})'); ip+=1
|
||
elif op == OP_ZERO_P: a=stack.pop(); stack.append(f'({a} == 0)'); ip+=1
|
||
elif op == OP_NULL_P: a=stack.pop(); stack.append(f'({a} is NIL)'); ip+=1
|
||
elif op == OP_PAIR_P: a=stack.pop(); stack.append(f'isinstance({a}, Pair)'); ip+=1
|
||
elif op == OP_CAR: a=stack.pop(); stack.append(f'{a}.car'); ip+=1
|
||
elif op == OP_CDR: a=stack.pop(); stack.append(f'{a}.cdr'); ip+=1
|
||
elif op == OP_CONS: d=stack.pop(); a=stack.pop(); stack.append(f'Pair({a},{d})'); ip+=1
|
||
elif op == OP_VEC_REF: i=stack.pop(); v=stack.pop(); stack.append(f'{v}[{i}]'); ip+=1
|
||
elif op == OP_POP: stack.pop() if stack else None; ip+=1
|
||
elif op == OP_DUP: stack.append(stack[-1]); ip+=1
|
||
elif op == OP_JUMP: ip = arg # forward jump = skip to target
|
||
elif op == OP_JUMP_IF_FALSE:
|
||
cond = stack.pop()
|
||
else_ip = arg
|
||
# Find JUMP at end of then-block → end of if
|
||
# Pattern: [then-block] JUMP end [else-block] end:
|
||
then_end = else_ip - 1
|
||
if then_end >= 0 and instrs[then_end][0] == OP_JUMP:
|
||
end_ip = instrs[then_end][1]
|
||
then_stmts = _block(ip, then_end)
|
||
else_stmts = _block(else_ip, end_ip)
|
||
stmts.append(('if', cond, then_stmts, else_stmts))
|
||
ip = end_ip
|
||
else:
|
||
# No else: if (not cond) skip
|
||
then_stmts = _block(ip, else_ip)
|
||
stmts.append(('if', cond, then_stmts, []))
|
||
ip = else_ip
|
||
elif op == OP_RETURN:
|
||
val = stack.pop() if stack else 'VOID'
|
||
stmts.append(('return', val)); ip+=1
|
||
elif op == OP_SELF_TAIL_CALL:
|
||
tc_n, tc_params = arg
|
||
pnames = [str(p) for p in tc_params]
|
||
args = [];
|
||
for _ in range(tc_n): args.insert(0, stack.pop())
|
||
stmts.append(('self_tc', pnames, args)); ip+=1
|
||
elif op == OP_CALL:
|
||
call_args = [];
|
||
for _ in range(arg): call_args.insert(0, stack.pop())
|
||
func = stack.pop()
|
||
stack.append(f'{func}({",".join(call_args)})'); ip+=1
|
||
elif op == OP_TAIL_CALL:
|
||
call_args = []
|
||
for _ in range(arg): call_args.insert(0, stack.pop())
|
||
func = stack.pop()
|
||
stmts.append(('return', f'{func}({",".join(call_args)})')); ip+=1
|
||
elif op == OP_SET:
|
||
val = stack.pop()
|
||
stmts.append(('assign', str(arg), val)); ip+=1
|
||
elif op == OP_DEFINE:
|
||
val = stack.pop()
|
||
stmts.append(('assign', str(arg), val)); ip+=1
|
||
else:
|
||
raise _JitBail()
|
||
return stmts
|
||
|
||
def _emit(stmts, ind):
|
||
for s in stmts:
|
||
if s[0] == 'return':
|
||
lines.append(f'{ind}return {s[1]}')
|
||
elif s[0] == 'self_tc':
|
||
pnames, args = s[1], s[2]
|
||
lines.append(f'{ind}{", ".join(pnames)} = {", ".join(args)}')
|
||
lines.append(f'{ind}continue')
|
||
elif s[0] == 'assign':
|
||
lines.append(f'{ind}{s[1]} = {s[2]}')
|
||
elif s[0] == 'if':
|
||
_, cond, then_s, else_s = s
|
||
lines.append(f'{ind}if {cond}:')
|
||
if then_s: _emit(then_s, ind + ' ')
|
||
else: lines.append(f'{ind} pass')
|
||
if else_s:
|
||
lines.append(f'{ind}else:')
|
||
_emit(else_s, ind + ' ')
|
||
|
||
stmts = _block(0, len(instrs))
|
||
_emit(stmts, indent)
|
||
return lines
|
||
|
||
|
||
def _jit_try(proc, env):
|
||
"""Try to JIT a procedure. Returns JIT'd callable or original proc."""
|
||
if not isinstance(proc, (CompiledProc, Proc)): return proc
|
||
if isinstance(proc, Proc):
|
||
proc = bc_compile_proc(proc, env)
|
||
jit_fn = _jit_compile(proc)
|
||
return jit_fn if jit_fn else proc
|
||
|
||
|
||
def _disassemble(proc):
|
||
"""Return human-readable bytecode listing."""
|
||
if isinstance(proc, Proc):
|
||
return f'#<interpreted {proc.name or "λ"}> — not compiled'
|
||
if not isinstance(proc, CompiledProc):
|
||
return f'not a procedure: {show(proc)}'
|
||
_OP_NAMES = {
|
||
OP_CONST: 'CONST', OP_LOOKUP: 'LOOKUP', OP_SET: 'SET',
|
||
OP_DEFINE: 'DEFINE', OP_POP: 'POP', OP_DUP: 'DUP', OP_VOID: 'VOID',
|
||
OP_JUMP: 'JUMP', OP_JUMP_IF_FALSE: 'JUMP_IF_FALSE',
|
||
OP_JUMP_IF_FALSE_KEEP: 'JUMP_IF_FALSE_KEEP',
|
||
OP_JUMP_IF_TRUE_KEEP: 'JUMP_IF_TRUE_KEEP',
|
||
OP_CALL: 'CALL', OP_TAIL_CALL: 'TAIL_CALL', OP_RETURN: 'RETURN',
|
||
OP_MAKE_CLOSURE: 'MAKE_CLOSURE',
|
||
OP_PUSH_ENV: 'PUSH_ENV', OP_POP_ENV: 'POP_ENV', OP_BIND: 'BIND',
|
||
OP_EVAL: 'EVAL', OP_CALL_CC: 'CALL_CC',
|
||
OP_ADD: 'ADD', OP_SUB: 'SUB', OP_MUL: 'MUL', OP_NEG: 'NEG',
|
||
OP_ADD1: 'ADD1', OP_SUB1: 'SUB1',
|
||
OP_NUM_EQ: 'NUM_EQ', OP_LT: 'LT', OP_GT: 'GT', OP_LE: 'LE', OP_GE: 'GE',
|
||
OP_CAR: 'CAR', OP_CDR: 'CDR', OP_CONS: 'CONS',
|
||
OP_NULL_P: 'NULL?', OP_PAIR_P: 'PAIR?', OP_NOT: 'NOT', OP_ZERO_P: 'ZERO?',
|
||
OP_VEC_REF: 'VEC_REF', OP_VEC_SET: 'VEC_SET',
|
||
OP_LOOK_LOOK: 'LOOK²', OP_LOOK_ADD1: 'LOOK+1', OP_LOOK_SUB1: 'LOOK-1',
|
||
OP_CONST_EQ_JF: 'CONST=JF', OP_LOOK_CONST_CALL2: 'LOOK_C_CALL2',
|
||
OP_SELF_TAIL_CALL: 'SELF_TCALL',
|
||
}
|
||
lines = [f'--- {proc.name or "λ"} '
|
||
f'({" ".join(str(p) for p in proc.params)}'
|
||
f'{"" if not proc.rest else " . " + str(proc.rest)}) ---']
|
||
for i, (op, arg) in enumerate(proc.code.instrs):
|
||
name = _OP_NAMES.get(op, f'OP_{op}')
|
||
if op == OP_MAKE_CLOSURE:
|
||
inner_code, params, rest = arg
|
||
arg_str = f'({inner_code.name or "λ"} {" ".join(str(p) for p in params)})'
|
||
elif op == OP_EVAL:
|
||
arg_str = show(arg)[:50]
|
||
elif arg is not None:
|
||
arg_str = show(arg) if not isinstance(arg, int) or op in (
|
||
OP_CALL, OP_TAIL_CALL, OP_JUMP, OP_JUMP_IF_FALSE,
|
||
OP_JUMP_IF_FALSE_KEEP, OP_JUMP_IF_TRUE_KEEP) else show(arg)
|
||
else:
|
||
arg_str = ''
|
||
lines.append(f' {i:4d} {name:<22s} {arg_str}')
|
||
return '\n'.join(lines)
|
||
|
||
|
||
###############################################################################
|
||
# Built-ins
|
||
###############################################################################
|
||
|
||
_gensym_ctr = itertools.count()
|
||
_modules: dict = {} # module-name → Env
|
||
_mod_exports: dict = {} # module-name → [export-names]
|
||
_record_types: dict = {} # record-name → {'fields': [...], 'parent': name|None}
|
||
# MOAD-0002: Module-level global — intentional coupling. Only read in LispErr.__init__
|
||
# to snapshot the call stack for error messages. Kept global because threading it through
|
||
# every leval/apply call would add overhead to the common (non-error) path.
|
||
_call_stack: list = [] # call stack for error reporting
|
||
_traced_originals: dict = {} # name → original proc (for untrace)
|
||
|
||
def _num(x):
|
||
if isinstance(x, bool) or not isinstance(x, (int, float, Fraction)):
|
||
raise LispErr(f'not a number: {show(x)}')
|
||
return x
|
||
|
||
def _str_val(x):
|
||
if isinstance(x, MutableString): return x
|
||
if not isinstance(x, str) or isinstance(x, Symbol):
|
||
raise LispErr(f'not a string: {show(x)}')
|
||
return x
|
||
|
||
def _write_file(path, content):
|
||
try:
|
||
with open(path, 'w') as f:
|
||
f.write(str(content))
|
||
return True
|
||
except OSError:
|
||
return False
|
||
|
||
def _read_file_to_string(path):
|
||
try:
|
||
with open(path, 'r') as f:
|
||
return f.read()
|
||
except OSError:
|
||
return False
|
||
|
||
def _read_from_string(s):
|
||
"""Parse one S-expression from the given string. Returns first form."""
|
||
forms = list(read_all(s))
|
||
return forms[0] if forms else False
|
||
|
||
import socket as _sockmod
|
||
def _tcp_listen(port):
|
||
s = _sockmod.socket(_sockmod.AF_INET, _sockmod.SOCK_STREAM)
|
||
s.setsockopt(_sockmod.SOL_SOCKET, _sockmod.SO_REUSEADDR, 1)
|
||
s.bind(('0.0.0.0', port))
|
||
s.listen(128)
|
||
return s
|
||
|
||
def _tcp_accept(server):
|
||
client, _addr = server.accept()
|
||
return client
|
||
|
||
def _tcp_connect(host, port):
|
||
s = _sockmod.socket(_sockmod.AF_INET, _sockmod.SOCK_STREAM)
|
||
s.connect((host, port))
|
||
return s
|
||
|
||
def _tcp_recv(sock, n):
|
||
try:
|
||
data = sock.recv(n)
|
||
except OSError:
|
||
return False
|
||
# latin-1 = 1:1 byte mapping (codepoints 0-255 == bytes 0-255).
|
||
# Preserves arbitrary binary payloads for binary wire mode while
|
||
# still passing through every ASCII character cleanly. UTF-8 was
|
||
# mangling binary data with replacement chars before.
|
||
return data.decode('latin-1')
|
||
|
||
def _tcp_send(sock, s):
|
||
if isinstance(s, str):
|
||
# encode latin-1 to preserve byte values for binary wire mode.
|
||
# Falls back to utf-8 for strings containing codepoints >= 256
|
||
# (rare for our protocol but courteous).
|
||
try:
|
||
data = s.encode('latin-1')
|
||
except UnicodeEncodeError:
|
||
data = s.encode('utf-8')
|
||
else:
|
||
data = bytes(s)
|
||
try:
|
||
return sock.send(data)
|
||
except OSError:
|
||
return False
|
||
|
||
import subprocess as _subprocess
|
||
def _spawn_process_stdio(path, args):
|
||
"""Spawn `path args...` with stdin/stdout pipes; return a Pair
|
||
(stdin-port . stdout-port). Used by gpu-worker.lsp to hold a
|
||
long-lived daemon binary across many requests."""
|
||
proc = _subprocess.Popen(
|
||
[path] + [str(a) for a in args],
|
||
stdin=_subprocess.PIPE,
|
||
stdout=_subprocess.PIPE,
|
||
bufsize=1,
|
||
text=True,
|
||
)
|
||
return Pair(proc.stdin, proc.stdout)
|
||
|
||
import os as _os
|
||
def _fork_self():
|
||
"""fork() wrapper. Returns 0 in child, pid in parent, False on
|
||
failure. Used by gpu-worker.lsp for fork-per-accept pattern —
|
||
single PID parent, ephemeral children handle requests. Match for
|
||
lumbda c-tier bi_fork_self (builtins.c)."""
|
||
try:
|
||
pid = _os.fork()
|
||
except OSError:
|
||
return False
|
||
return pid
|
||
|
||
def _waitpid_nonblock():
|
||
"""waitpid(-1, WNOHANG) wrapper. Returns reaped pid or 0. Match
|
||
for c-tier bi_waitpid_nonblock."""
|
||
try:
|
||
pid, _status = _os.waitpid(-1, _os.WNOHANG)
|
||
except OSError:
|
||
return 0
|
||
return pid
|
||
|
||
import time as _time
|
||
def _sleep(secs):
|
||
"""Real wall-clock sleep. Match for c-tier bi_sleep."""
|
||
_time.sleep(int(secs))
|
||
return VOID
|
||
|
||
def _exit_immediate(code):
|
||
"""os._exit() wrapper. Skip atexit / stdio flush. REQUIRED in
|
||
fork-self children to avoid dual-cleanup hang. Match for c-tier
|
||
bi_exit_immediate."""
|
||
_os._exit(int(code))
|
||
|
||
def _flush_port(port):
|
||
"""Flush a write port. No-op if port has no flush method."""
|
||
if hasattr(port, 'flush'):
|
||
port.flush()
|
||
return VOID
|
||
|
||
def _write_binary_file(path, data):
|
||
"""Write Latin-1-encoded string to a binary file byte-for-byte.
|
||
Used by gpu-worker.lsp's binary wire mode to write portal files
|
||
without any encoding round-trip."""
|
||
with open(path, 'wb') as f:
|
||
f.write(data.encode('latin-1') if isinstance(data, str) else bytes(data))
|
||
return VOID
|
||
|
||
def _append_binary_file(path, data):
|
||
"""Append Latin-1-encoded string to a binary file byte-for-byte.
|
||
Pairs with write-binary-file so emit-stream can land header + body
|
||
without materializing a string-append concat at production widths
|
||
(multi-GB body would peak host RAM at 3x body size otherwise)."""
|
||
with open(path, 'ab') as f:
|
||
f.write(data.encode('latin-1') if isinstance(data, str) else bytes(data))
|
||
return VOID
|
||
|
||
def _append_port_to_binary_file(path, port):
|
||
"""Stream a string-output port's accumulated chunks directly to a
|
||
file. Avoids materializing (get-output-string port) — at multi-GB
|
||
body sizes that copy peaks host RAM unnecessarily."""
|
||
if not isinstance(port, StringOutputPort):
|
||
raise LispErr("append-port-to-binary-file: port must be a string output port")
|
||
with open(path, 'ab') as f:
|
||
for chunk in port._buf:
|
||
f.write(chunk.encode('latin-1') if isinstance(chunk, str) else bytes(chunk))
|
||
return VOID
|
||
|
||
class BinaryFilePort:
|
||
"""Wraps a Python binary file so write-char / write-string can pass
|
||
Scheme strings (str or MutableString) without an explicit encode.
|
||
Mirrors C tier's open-binary-output-file + port-set-position! pair
|
||
so emit-stream can write gates directly to disk without a string
|
||
output buffer."""
|
||
__slots__ = ('_f',)
|
||
def __init__(self, path): self._f = open(path, 'w+b')
|
||
def write(self, s):
|
||
if isinstance(s, MutableString):
|
||
s = ''.join(s._c)
|
||
if isinstance(s, str):
|
||
data = s.encode('latin-1')
|
||
elif isinstance(s, (bytes, bytearray)):
|
||
data = bytes(s)
|
||
else:
|
||
data = str(s).encode('latin-1')
|
||
self._f.write(data)
|
||
return len(data)
|
||
def flush(self): self._f.flush()
|
||
def close(self): self._f.close()
|
||
def seek(self, offset): self._f.seek(offset)
|
||
|
||
def _open_binary_output_file(path):
|
||
return BinaryFilePort(path)
|
||
|
||
def _port_set_position(port, offset):
|
||
port.seek(int(offset))
|
||
return VOID
|
||
|
||
def _read_binary_file(path):
|
||
"""Read a binary file as a Latin-1 string (1:1 byte mapping)."""
|
||
with open(path, 'rb') as f:
|
||
return f.read().decode('latin-1')
|
||
|
||
# walk-circuit-ops — host-side reimplementation of foxhop ecdsa's
|
||
# emit-ops-bin.lsp::point-add->ops walk loop. Walking ~32K lumbda ops
|
||
# inside the Scheme interpreter costs ~5-9 ms per iteration on Python
|
||
# tier (per-call closure / let* / cons / append overhead), so the toy
|
||
# p=11 emit ran past 4 minutes just on the walk. This primitive does
|
||
# the entire walk in pure Python and returns a Scheme list of 7-element
|
||
# vectors (kind q2 q1 qt ct cc rt) — the same op-spec shape Scheme
|
||
# would have produced — in O(N) wall, dispatch by interned-symbol
|
||
# identity per op.
|
||
#
|
||
# Op shapes recognized (mirror lumbda ecdsa/lumbda/emit-ops-bin.lsp
|
||
# walk-op):
|
||
# (alloc name width)
|
||
# (free name)
|
||
# (x (reg idx))
|
||
# (z (reg idx))
|
||
# (cx (reg idx) (reg idx))
|
||
# (cz (reg idx) (reg idx))
|
||
# (swap (reg idx) (reg idx))
|
||
# (ccx (reg idx) (reg idx) (reg idx))
|
||
# (ccz (reg idx) (reg idx) (reg idx))
|
||
# Anything else raises LispErr so a new op tag fails loud.
|
||
#
|
||
# Kind enum mirrors emit-ops-bin.lsp:
|
||
# 1 Register, 2 AppendToRegister, 6 X, 7 Z, 8 CX, 9 CZ, 10 Swap,
|
||
# 13 CCX, 14 CCZ. Sentinel NO_SLOT = u64::MAX = 2^64 - 1.
|
||
#
|
||
# alloc grows the layout & emits Register + width × AppendToRegister.
|
||
# free drops the name; we do NOT emit an upstream op (matches Bennett
|
||
# pattern where ancillae stay reserved). Each register name occupies
|
||
# one qubit-range; re-alloc of the same name (after a prior free) gets
|
||
# a fresh range with a new reg-id, which is the cumulative qubit base.
|
||
|
||
def _walk_circuit_ops(registers_lst, ops_lst):
|
||
NO_SLOT = 18446744073709551615
|
||
s_alloc = S('alloc'); s_free = S('free')
|
||
s_x = S('x'); s_z = S('z')
|
||
s_cx = S('cx'); s_cz = S('cz')
|
||
s_ccx = S('ccx'); s_ccz = S('ccz')
|
||
s_swap = S('swap')
|
||
|
||
layout = {} # name (Symbol) -> base (int)
|
||
next_q = 0
|
||
result = [] # list of 7-element op-spec records
|
||
|
||
def emit_register(name, width):
|
||
nonlocal next_q
|
||
base = next_q
|
||
reg_id = base
|
||
layout[name] = base
|
||
result.append([1, NO_SLOT, NO_SLOT, NO_SLOT, NO_SLOT, NO_SLOT, reg_id])
|
||
for i in range(width):
|
||
result.append([2, NO_SLOT, NO_SLOT, base + i, NO_SLOT, NO_SLOT, reg_id])
|
||
next_q += width
|
||
|
||
# Declared registers first (boilerplate before any ops).
|
||
n = registers_lst
|
||
while isinstance(n, Pair):
|
||
rec = n.car
|
||
# rec = (name width) — Pair(name, Pair(width, NIL))
|
||
rec_name = rec.car
|
||
rec_width = rec.cdr.car
|
||
emit_register(rec_name, rec_width)
|
||
n = n.cdr
|
||
|
||
# Now walk ops.
|
||
n = ops_lst
|
||
while isinstance(n, Pair):
|
||
op = n.car
|
||
tag = op.car
|
||
rest = op.cdr
|
||
if tag is s_ccx:
|
||
c1 = rest.car
|
||
c2 = rest.cdr.car
|
||
tgt = rest.cdr.cdr.car
|
||
q1 = layout[c1.car] + c1.cdr.car
|
||
q2 = layout[c2.car] + c2.cdr.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
result.append([13, q2, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT])
|
||
elif tag is s_cx:
|
||
c1 = rest.car
|
||
tgt = rest.cdr.car
|
||
q1 = layout[c1.car] + c1.cdr.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
result.append([8, NO_SLOT, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT])
|
||
elif tag is s_x:
|
||
tgt = rest.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
result.append([6, NO_SLOT, NO_SLOT, qt, NO_SLOT, NO_SLOT, NO_SLOT])
|
||
elif tag is s_alloc:
|
||
name = rest.car
|
||
width = rest.cdr.car
|
||
emit_register(name, width)
|
||
elif tag is s_free:
|
||
name = rest.car
|
||
if name in layout:
|
||
del layout[name]
|
||
elif tag is s_z:
|
||
tgt = rest.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
result.append([7, NO_SLOT, NO_SLOT, qt, NO_SLOT, NO_SLOT, NO_SLOT])
|
||
elif tag is s_cz:
|
||
c1 = rest.car
|
||
tgt = rest.cdr.car
|
||
q1 = layout[c1.car] + c1.cdr.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
result.append([9, NO_SLOT, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT])
|
||
elif tag is s_swap:
|
||
a = rest.car
|
||
b = rest.cdr.car
|
||
q1 = layout[a.car] + a.cdr.car
|
||
qt = layout[b.car] + b.cdr.car
|
||
result.append([10, NO_SLOT, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT])
|
||
elif tag is s_ccz:
|
||
c1 = rest.car
|
||
c2 = rest.cdr.car
|
||
tgt = rest.cdr.cdr.car
|
||
q1 = layout[c1.car] + c1.cdr.car
|
||
q2 = layout[c2.car] + c2.cdr.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
result.append([14, q2, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT])
|
||
else:
|
||
raise LispErr(f'walk-circuit-ops: unknown op tag: {show(tag)}')
|
||
n = n.cdr
|
||
|
||
return _P(result)
|
||
|
||
# op-specs->bytes — serialize a Scheme list of op-spec vectors
|
||
# (the output of walk-circuit-ops) into the QECCOPS1 body byte string.
|
||
# Each op-spec is a 7-element vector [kind, q2, q1, qt, ct, cc, rt]
|
||
# packed as 56 bytes little-endian: u32 kind, u32 pad, then 6× u64.
|
||
# Returns a Latin-1 string so the existing write-binary-file primitive
|
||
# ships it byte-for-byte. Replaces the Scheme-level op-spec->bytes +
|
||
# (apply string-append parts) pipeline in emit-ops-bin.lsp — that loop
|
||
# spent ~66 sec on 32K ops on Python tier through interpreter overhead;
|
||
# host runs the same packing in milliseconds via struct.pack + b''.join.
|
||
|
||
import struct as _struct
|
||
_OP_SPEC_PACK = _struct.Struct('<IIQQQQQQ').pack # u32 kind, u32 pad, 6× u64
|
||
|
||
def _op_specs_to_bytes(op_specs_lst):
|
||
chunks = []
|
||
n = op_specs_lst
|
||
while isinstance(n, Pair):
|
||
v = n.car
|
||
# v = [kind, q2, q1, qt, ct, cc, rt] (Python list, vector in Scheme)
|
||
chunks.append(_OP_SPEC_PACK(v[0], 0, v[1], v[2], v[3], v[4], v[5], v[6]))
|
||
n = n.cdr
|
||
# Latin-1 decode is byte-for-byte; write-binary-file re-encodes the
|
||
# same way. Round-trip identity holds.
|
||
return b''.join(chunks).decode('latin-1')
|
||
|
||
# emit-circuit-to-ops-bin-stream — streaming walker that writes ops.bin
|
||
# directly to disk one op at a time. O(1) host memory regardless of
|
||
# n_ops. Mirrors _walk_circuit_ops dispatch exactly so byte output is
|
||
# bit-identical to (op-specs->bytes (walk-circuit-ops ...)). Returns
|
||
# the count of upstream ops written.
|
||
#
|
||
# File format (QECCOPS1):
|
||
# magic 8B "QECCOPS1"
|
||
# n_ops 8B u64 LE (patched after walk completes via seek)
|
||
# body n_ops × 56B (per-op layout matches _op_specs_to_bytes)
|
||
#
|
||
# Memory profile vs accumulator path (n+1=257 secp256k1 ≈ 15M ops):
|
||
# old: list of 15M Python lists (~4 GB) + 840MB body bytes → OOM @ 8GB
|
||
# new: one 56B buffer per op, written + freed before next → ~MBs RSS
|
||
#
|
||
# Implementation notes:
|
||
# * Uses an 8 KiB Python list to batch op-spec packs before each
|
||
# file.write(). 8 KiB ≈ 146 ops per flush — keeps Python int
|
||
# allocations bounded yet amortizes Python file-write overhead.
|
||
# * Header n_ops field is written as a u64 LE placeholder zero up
|
||
# front, then patched by seek(8) + write at the tail. The seek
|
||
# requires a regular file (not a pipe); ops.bin output paths are
|
||
# all regular files in our pipeline.
|
||
# * Uses buffered I/O (default `open(... 'wb')` buffer) — file is
|
||
# flushed + closed at the tail before returning.
|
||
|
||
_BATCH_THRESH = 8192 # bytes; ~146 ops per batched write
|
||
|
||
def _emit_circuit_to_ops_bin_stream(out_path, registers_lst, ops_lst):
|
||
NO_SLOT = 18446744073709551615
|
||
s_alloc = S('alloc'); s_free = S('free')
|
||
s_x = S('x'); s_z = S('z')
|
||
s_cx = S('cx'); s_cz = S('cz')
|
||
s_ccx = S('ccx'); s_ccz = S('ccz')
|
||
s_swap = S('swap')
|
||
|
||
layout = {}
|
||
# Mutable container for next_q so nested helper can rebind without
|
||
# using nonlocal across the dispatch loop.
|
||
state = [0] # state[0] = next_q
|
||
count = [0] # count[0] = n_ops written
|
||
batch = []
|
||
batch_len = [0]
|
||
pack = _OP_SPEC_PACK
|
||
|
||
with open(out_path, 'wb') as f:
|
||
# Magic + placeholder n_ops (zero — we patch at the end).
|
||
f.write(b'QECCOPS1')
|
||
f.write(b'\x00' * 8)
|
||
|
||
def flush():
|
||
if batch:
|
||
f.write(b''.join(batch))
|
||
batch.clear()
|
||
batch_len[0] = 0
|
||
|
||
def emit(kind, q2, q1, qt, ct, cc, rt):
|
||
batch.append(pack(kind, 0, q2, q1, qt, ct, cc, rt))
|
||
batch_len[0] += 56
|
||
count[0] += 1
|
||
if batch_len[0] >= _BATCH_THRESH:
|
||
flush()
|
||
|
||
def emit_register(name, width):
|
||
base = state[0]
|
||
reg_id = base
|
||
layout[name] = base
|
||
emit(1, NO_SLOT, NO_SLOT, NO_SLOT, NO_SLOT, NO_SLOT, reg_id)
|
||
for i in range(width):
|
||
emit(2, NO_SLOT, NO_SLOT, base + i, NO_SLOT, NO_SLOT, reg_id)
|
||
state[0] += width
|
||
|
||
# Declared registers first (boilerplate before ops).
|
||
n = registers_lst
|
||
while isinstance(n, Pair):
|
||
rec = n.car
|
||
rec_name = rec.car
|
||
rec_width = rec.cdr.car
|
||
emit_register(rec_name, rec_width)
|
||
n = n.cdr
|
||
|
||
# Walk ops.
|
||
n = ops_lst
|
||
while isinstance(n, Pair):
|
||
op = n.car
|
||
tag = op.car
|
||
rest = op.cdr
|
||
if tag is s_ccx:
|
||
c1 = rest.car
|
||
c2 = rest.cdr.car
|
||
tgt = rest.cdr.cdr.car
|
||
q1 = layout[c1.car] + c1.cdr.car
|
||
q2 = layout[c2.car] + c2.cdr.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
emit(13, q2, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT)
|
||
elif tag is s_cx:
|
||
c1 = rest.car
|
||
tgt = rest.cdr.car
|
||
q1 = layout[c1.car] + c1.cdr.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
emit(8, NO_SLOT, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT)
|
||
elif tag is s_x:
|
||
tgt = rest.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
emit(6, NO_SLOT, NO_SLOT, qt, NO_SLOT, NO_SLOT, NO_SLOT)
|
||
elif tag is s_alloc:
|
||
name = rest.car
|
||
width = rest.cdr.car
|
||
emit_register(name, width)
|
||
elif tag is s_free:
|
||
name = rest.car
|
||
if name in layout:
|
||
del layout[name]
|
||
elif tag is s_z:
|
||
tgt = rest.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
emit(7, NO_SLOT, NO_SLOT, qt, NO_SLOT, NO_SLOT, NO_SLOT)
|
||
elif tag is s_cz:
|
||
c1 = rest.car
|
||
tgt = rest.cdr.car
|
||
q1 = layout[c1.car] + c1.cdr.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
emit(9, NO_SLOT, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT)
|
||
elif tag is s_swap:
|
||
a = rest.car
|
||
b = rest.cdr.car
|
||
q1 = layout[a.car] + a.cdr.car
|
||
qt = layout[b.car] + b.cdr.car
|
||
emit(10, NO_SLOT, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT)
|
||
elif tag is s_ccz:
|
||
c1 = rest.car
|
||
c2 = rest.cdr.car
|
||
tgt = rest.cdr.cdr.car
|
||
q1 = layout[c1.car] + c1.cdr.car
|
||
q2 = layout[c2.car] + c2.cdr.car
|
||
qt = layout[tgt.car] + tgt.cdr.car
|
||
emit(14, q2, q1, qt, NO_SLOT, NO_SLOT, NO_SLOT)
|
||
else:
|
||
raise LispErr(f'emit-circuit-to-ops-bin-stream: unknown op tag: {show(tag)}')
|
||
n = n.cdr
|
||
|
||
flush()
|
||
|
||
# Patch n_ops header. u64 LE at offset 8.
|
||
n_ops = count[0]
|
||
f.seek(8)
|
||
f.write(n_ops.to_bytes(8, 'little'))
|
||
|
||
return count[0]
|
||
|
||
# count-lumbda-ops — tally tags across a Scheme list of lumbda ops.
|
||
# Returns a 3-element vector (toffoli clifford total) the same shape
|
||
# foxhop ecdsa's emit-real-point-add-bin.lsp::count-ops produced in
|
||
# pure Scheme — which paid ~200 sec / 32K ops on Python tier through
|
||
# per-iteration interpreter overhead. Host walks once at native loop
|
||
# speed.
|
||
def _count_lumbda_ops(ops_lst):
|
||
s_ccx = S('ccx'); s_x = S('x'); s_cx = S('cx')
|
||
tof = cli = tot = 0
|
||
n = ops_lst
|
||
while isinstance(n, Pair):
|
||
op = n.car
|
||
tag = op.car if isinstance(op, Pair) else op
|
||
tot += 1
|
||
if tag is s_ccx:
|
||
tof += 1
|
||
elif tag is s_x or tag is s_cx:
|
||
cli += 1
|
||
n = n.cdr
|
||
return [tof, cli, tot]
|
||
|
||
def _sym_val(x):
|
||
if not isinstance(x, Symbol): raise LispErr(f'not a symbol: {show(x)}')
|
||
return x
|
||
|
||
def _pair_val(x):
|
||
if not isinstance(x, Pair): raise LispErr(f'not a pair: {show(x)}')
|
||
return x
|
||
|
||
def _equal(a, b):
|
||
if a is b: return True
|
||
_numeric = (int, float, Fraction)
|
||
if type(a) is not type(b) and not (isinstance(a, _numeric) and isinstance(b, _numeric)): return False
|
||
if isinstance(a, Pair): return _equal(a.car, b.car) and _equal(a.cdr, b.cdr)
|
||
if isinstance(a, list): return len(a) == len(b) and all(_equal(x, y) for x, y in zip(a, b))
|
||
return a == b
|
||
|
||
def _is_proper_list(x):
|
||
slow = x; fast = x
|
||
while True:
|
||
if fast is NIL: return True
|
||
if not isinstance(fast, Pair): return False
|
||
fast = fast.cdr
|
||
if fast is NIL: return True
|
||
if not isinstance(fast, Pair): return False
|
||
fast = fast.cdr; slow = slow.cdr
|
||
if fast is slow: return False
|
||
|
||
def _append(parts):
|
||
if not parts: return NIL
|
||
result = parts[-1]
|
||
for p in reversed(parts[:-1]):
|
||
for x in reversed(list(_L(p))): result = Pair(x, result)
|
||
return result
|
||
|
||
def _list_star(a):
|
||
if len(a) == 1: return a[0]
|
||
return Pair(a[0], _list_star(a[1:]))
|
||
|
||
def _list_tail(lst, n):
|
||
for _ in range(n): lst = _pair_val(lst).cdr
|
||
return lst
|
||
|
||
def _member(obj, lst, eq):
|
||
n = lst
|
||
while isinstance(n, Pair):
|
||
if eq(n.car, obj): return n
|
||
n = n.cdr
|
||
return False
|
||
|
||
def _assoc(key, lst, eq):
|
||
n = lst
|
||
while isinstance(n, Pair):
|
||
if isinstance(n.car, Pair) and eq(n.car.car, key): return n.car
|
||
n = n.cdr
|
||
return False
|
||
|
||
def _format(a):
|
||
fmt = _str_val(a[0]); it = iter(a[1:])
|
||
out = []; i = 0
|
||
while i < len(fmt):
|
||
if fmt[i] == '~' and i + 1 < len(fmt):
|
||
c = fmt[i + 1]; i += 2
|
||
if c == 'a': out.append(show(next(it), display=True))
|
||
elif c == 's': out.append(show(next(it)))
|
||
elif c == '%': out.append('\n')
|
||
elif c == '~': out.append('~')
|
||
elif c == 'b': out.append(format(int(_num(next(it))), 'b'))
|
||
elif c == 'o': out.append(format(int(_num(next(it))), 'o'))
|
||
elif c == 'x': out.append(format(int(_num(next(it))), 'x'))
|
||
elif c == 'd': out.append(str(int(_num(next(it)))))
|
||
else: out.append('~'); out.append(c)
|
||
else:
|
||
out.append(fmt[i]); i += 1
|
||
return ''.join(out)
|
||
|
||
|
||
def _pprint(x, indent=0, width=72):
|
||
"""Pretty-print a Lisp value with indentation."""
|
||
s = show(x)
|
||
if len(s) + indent <= width or not isinstance(x, Pair): return s
|
||
items = list(x)
|
||
if not items: return '()'
|
||
# (keyword arg1 arg2 ...) style: indent args under keyword
|
||
head = show(items[0])
|
||
if isinstance(items[0], Symbol) and len(items) > 1:
|
||
# Try to fit head + first arg on one line
|
||
first_col = indent + 2 + len(head)
|
||
parts = [_pprint(item, first_col, width) for item in items[1:]]
|
||
inner = ('\n' + ' ' * first_col).join(parts)
|
||
candidate = f'({head} {inner})'
|
||
if len(candidate.split('\n')[0]) + indent <= width or '\n' in inner:
|
||
return candidate
|
||
# Fall back: one item per line, indented by 1
|
||
col = indent + 1
|
||
parts = [_pprint(item, col, width) for item in items]
|
||
inner = ('\n' + ' ' * col).join(parts)
|
||
return f'({inner})'
|
||
|
||
|
||
def make_global_env():
|
||
g = Env()
|
||
g.g = g # global env shortcut: children skip directly here for builtins
|
||
d = g.define
|
||
|
||
# ── Arithmetic ───────────────────────────────────────────────────────────
|
||
def _add(a, _):
|
||
if not a: return 0
|
||
result = _num(a[0])
|
||
for x in a[1:]: result = result + _num(x)
|
||
return result.numerator if isinstance(result, Fraction) and result.denominator == 1 else result
|
||
def _sub(a, _):
|
||
if not a: raise LispErr('-: no args')
|
||
if len(a) == 1: return -_num(a[0])
|
||
result = _num(a[0])
|
||
for x in a[1:]: result = result - _num(x)
|
||
return result.numerator if isinstance(result, Fraction) and result.denominator == 1 else result
|
||
def _mul(a, _):
|
||
result = 1
|
||
for x in a: result = result * _num(x)
|
||
return result.numerator if isinstance(result, Fraction) and result.denominator == 1 else result
|
||
d(S('+'), _add)
|
||
d(S('-'), _sub)
|
||
d(S('*'), _mul)
|
||
|
||
def _div(a, _):
|
||
if not a: raise LispErr('/: no args')
|
||
if len(a) == 1:
|
||
n = _num(a[0])
|
||
return Fraction(1, n) if isinstance(n, int) else 1.0 / n
|
||
n = _num(a[0])
|
||
for x in a[1:]:
|
||
x = _num(x)
|
||
# Exact division: int/int or Fraction/int → Fraction, then simplify
|
||
if isinstance(n, (int, Fraction)) and isinstance(x, (int, Fraction)):
|
||
f = Fraction(n, x) if not isinstance(n, Fraction) else n / Fraction(x)
|
||
n = f.numerator if f.denominator == 1 else f
|
||
else:
|
||
n = float(n) / float(x)
|
||
return n
|
||
d(S('/'), _div)
|
||
d(S('quotient'), lambda a, _: (lambda x, y: -(abs(int(x)) // abs(int(y))) if (x < 0) != (y < 0) else abs(int(x)) // abs(int(y)))(_num(a[0]), _num(a[1])))
|
||
d(S('remainder'), lambda a, _: int(_num(a[0])) % int(_num(a[1])) * (1 if _num(a[0]) >= 0 else -1))
|
||
d(S('modulo'), lambda a, _: int(_num(a[0])) % int(_num(a[1])))
|
||
d(S('expt'), lambda a, _: _num(a[0]) ** _num(a[1]))
|
||
d(S('abs'), lambda a, _: abs(_num(a[0])))
|
||
d(S('floor'), lambda a, _: int(math.floor(_num(a[0]))))
|
||
d(S('ceiling'), lambda a, _: int(math.ceil(_num(a[0]))))
|
||
d(S('round'), lambda a, _: int(round(_num(a[0]))))
|
||
d(S('truncate'), lambda a, _: int(math.trunc(_num(a[0]))))
|
||
d(S('floor/'), lambda a, _: (math.floor(_num(a[0]) / _num(a[1])),
|
||
_num(a[0]) - _num(a[1]) * math.floor(_num(a[0]) / _num(a[1]))))
|
||
d(S('sqrt'), lambda a, _: math.sqrt(_num(a[0])))
|
||
d(S('isqrt'), lambda a, _: math.isqrt(int(_num(a[0]))))
|
||
d(S('log'), lambda a, _: math.log(_num(a[0])) if len(a) == 1 else math.log(_num(a[0]), _num(a[1])))
|
||
d(S('exp'), lambda a, _: math.exp(_num(a[0])))
|
||
d(S('sin'), lambda a, _: math.sin(_num(a[0])))
|
||
d(S('cos'), lambda a, _: math.cos(_num(a[0])))
|
||
d(S('tan'), lambda a, _: math.tan(_num(a[0])))
|
||
d(S('asin'), lambda a, _: math.asin(_num(a[0])))
|
||
d(S('acos'), lambda a, _: math.acos(_num(a[0])))
|
||
d(S('atan'), lambda a, _: math.atan(_num(a[0])) if len(a) == 1 else math.atan2(_num(a[0]), _num(a[1])))
|
||
d(S('floor'), lambda a, _: int(math.floor(_num(a[0]))))
|
||
d(S('min'), lambda a, _: min(_num(x) for x in a))
|
||
d(S('max'), lambda a, _: max(_num(x) for x in a))
|
||
d(S('gcd'), lambda a, _: math.gcd(int(_num(a[0])), int(_num(a[1]))))
|
||
d(S('lcm'), lambda a, _: abs(int(_num(a[0])) * int(_num(a[1]))) // (math.gcd(int(_num(a[0])), int(_num(a[1]))) or 1))
|
||
d(S('exact'), lambda a, _: (Fraction(_num(a[0])).limit_denominator() if isinstance(_num(a[0]), float) else _num(a[0])))
|
||
d(S('inexact'), lambda a, _: float(_num(a[0])))
|
||
d(S('exact->inexact'), lambda a, _: float(_num(a[0])))
|
||
d(S('inexact->exact'), lambda a, _: (Fraction(_num(a[0])).limit_denominator() if isinstance(_num(a[0]), float) else _num(a[0])))
|
||
d(S('numerator'), lambda a, _: _num(a[0]).numerator if isinstance(_num(a[0]), Fraction) else (int(_num(a[0])) if isinstance(_num(a[0]), int) else _num(a[0])))
|
||
d(S('denominator'),lambda a, _: _num(a[0]).denominator if isinstance(_num(a[0]), Fraction) else 1)
|
||
def _num_to_str(a):
|
||
n = _num(a[0])
|
||
if len(a) > 1:
|
||
base = int(_num(a[1]))
|
||
return format(int(n), {2: 'b', 8: 'o', 16: 'x'}.get(base, ''))
|
||
if isinstance(n, Fraction): return f'{n.numerator}/{n.denominator}'
|
||
return show(n) # uses show for floats (decimal point guaranteed)
|
||
d(S('number->string'), lambda a, _: _num_to_str(a))
|
||
d(S('zero?'), lambda a, _: _num(a[0]) == 0)
|
||
d(S('positive?'), lambda a, _: _num(a[0]) > 0)
|
||
d(S('negative?'), lambda a, _: _num(a[0]) < 0)
|
||
d(S('odd?'), lambda a, _: int(_num(a[0])) % 2 != 0)
|
||
d(S('even?'), lambda a, _: int(_num(a[0])) % 2 == 0)
|
||
d(S('nan?'), lambda a, _: isinstance(a[0], float) and math.isnan(a[0]))
|
||
d(S('infinite?'), lambda a, _: isinstance(a[0], float) and math.isinf(a[0]))
|
||
d(S('finite?'), lambda a, _: isinstance(a[0], (int, float)) and not isinstance(a[0], bool) and math.isfinite(a[0]))
|
||
d(S('truncate-quotient'), lambda a, _: int(math.trunc(_num(a[0]) / _num(a[1]))))
|
||
d(S('truncate-remainder'), lambda a, _: _num(a[0]) - int(math.trunc(_num(a[0]) / _num(a[1]))) * _num(a[1]))
|
||
d(S('floor-quotient'), lambda a, _: int(math.floor(_num(a[0]) / _num(a[1]))))
|
||
d(S('floor-remainder'), lambda a, _: _num(a[0]) - int(math.floor(_num(a[0]) / _num(a[1]))) * _num(a[1]))
|
||
d(S('square'), lambda a, _: _num(a[0]) ** 2)
|
||
d(S('exact-integer?'), lambda a, _: isinstance(a[0], int) and not isinstance(a[0], bool))
|
||
|
||
# ── Numeric comparison ───────────────────────────────────────────────────
|
||
for _nm, _op in [('=', lambda a,b: a==b), ('<', lambda a,b: a<b),
|
||
('>', lambda a,b: a>b), ('<=', lambda a,b: a<=b),
|
||
('>=', lambda a,b: a>=b)]:
|
||
def _cmp(a, _, op=_op):
|
||
for x, y in zip(a, a[1:]):
|
||
if not op(_num(x), _num(y)): return False
|
||
return True
|
||
d(S(_nm), _cmp)
|
||
|
||
# ── Booleans ─────────────────────────────────────────────────────────────
|
||
d(S('not'), lambda a, _: not _truthy(a[0]))
|
||
d(S('boolean?'), lambda a, _: isinstance(a[0], bool))
|
||
d(S('boolean=?'), lambda a, _: all(x == a[0] for x in a[1:]))
|
||
|
||
# ── Equality ─────────────────────────────────────────────────────────────
|
||
d(S('eq?'), lambda a, _: a[0] is a[1] or (a[0] == a[1] and isinstance(a[0], (int, bool, Symbol))))
|
||
d(S('eqv?'), lambda a, _: a[0] is a[1] or (a[0] == a[1] and isinstance(a[0], (int, float, bool, Symbol, str))))
|
||
d(S('equal?'), lambda a, _: _equal(a[0], a[1]))
|
||
|
||
# ── Type predicates ──────────────────────────────────────────────────────
|
||
d(S('number?'), lambda a, _: isinstance(a[0], (int, float, Fraction)) and not isinstance(a[0], bool))
|
||
d(S('integer?'), lambda a, _: (isinstance(a[0], int) and not isinstance(a[0], bool)) or (isinstance(a[0], float) and a[0].is_integer()) or (isinstance(a[0], Fraction) and a[0].denominator == 1))
|
||
d(S('real?'), lambda a, _: isinstance(a[0], (int, float, Fraction)) and not isinstance(a[0], bool))
|
||
d(S('rational?'), lambda a, _: isinstance(a[0], (int, Fraction)) and not isinstance(a[0], bool) or (isinstance(a[0], float) and math.isfinite(a[0])))
|
||
d(S('exact?'), lambda a, _: (isinstance(a[0], int) or isinstance(a[0], Fraction)) and not isinstance(a[0], bool))
|
||
d(S('inexact?'), lambda a, _: isinstance(a[0], float))
|
||
d(S('pair?'), lambda a, _: isinstance(a[0], Pair))
|
||
d(S('null?'), lambda a, _: a[0] is NIL)
|
||
d(S('list?'), lambda a, _: _is_proper_list(a[0]))
|
||
d(S('symbol?'), lambda a, _: isinstance(a[0], Symbol))
|
||
d(S('string?'), lambda a, _: isinstance(a[0], MutableString) or (isinstance(a[0], str) and not isinstance(a[0], Symbol)))
|
||
d(S('char?'), lambda a, _: isinstance(a[0], str) and not isinstance(a[0], Symbol) and len(a[0]) == 1)
|
||
d(S('vector?'), lambda a, _: isinstance(a[0], list))
|
||
d(S('boolean?'), lambda a, _: isinstance(a[0], bool))
|
||
d(S('procedure?'), lambda a, _: isinstance(a[0], (Proc, CompiledProc)) or (callable(a[0]) and not isinstance(a[0], (Macro, type))))
|
||
d(S('void?'), lambda a, _: a[0] is VOID)
|
||
d(S('eof-object?'),lambda a, _: isinstance(a[0], _EOF))
|
||
|
||
# ── Pairs & Lists ─────────────────────────────────────────────────────────
|
||
d(S('cons'), lambda a, _: Pair(a[0], a[1]))
|
||
d(S('car'), lambda a, _: _pair_val(a[0]).car)
|
||
d(S('cdr'), lambda a, _: _pair_val(a[0]).cdr)
|
||
d(S('set-car!'), lambda a, _: setattr(_pair_val(a[0]), 'car', a[1]) or VOID)
|
||
d(S('set-cdr!'), lambda a, _: setattr(_pair_val(a[0]), 'cdr', a[1]) or VOID)
|
||
d(S('list'), lambda a, _: _P(a))
|
||
d(S('list*'), lambda a, _: _list_star(a))
|
||
d(S('cons*'), lambda a, _: _list_star(a))
|
||
d(S('length'), lambda a, _: len(_L(a[0])))
|
||
d(S('append'), lambda a, _: _append(a))
|
||
d(S('reverse'), lambda a, _: _P(list(_L(a[0]))[::-1]))
|
||
d(S('list-tail'), lambda a, _: _list_tail(a[0], int(_num(a[1]))))
|
||
d(S('list-ref'), lambda a, _: _list_tail(a[0], int(_num(a[1]))).car)
|
||
d(S('list-set!'), lambda a, _: setattr(_list_tail(a[0], int(_num(a[1]))), 'car', a[2]) or VOID)
|
||
d(S('list-copy'), lambda a, _: _P(list(_L(a[0]))))
|
||
d(S('make-list'), lambda a, _: _P([a[1] if len(a) > 1 else False] * int(_num(a[0]))))
|
||
d(S('iota'), lambda a, _: _P(list(range(int(_num(a[0]))) if len(a) == 1 else
|
||
range(int(_num(a[1])), int(_num(a[1])) + int(_num(a[0]))) if len(a) == 2 else
|
||
range(int(_num(a[1])), int(_num(a[1])) + int(_num(a[0])) * int(_num(a[2])), int(_num(a[2]))))))
|
||
d(S('last-pair'), lambda a, _: (lambda n: [n := n.cdr or n for _ in iter(lambda: isinstance(n.cdr, Pair) and True, False)] and n)(a[0]))
|
||
d(S('memq'), lambda a, _: _member(a[0], a[1], lambda x, y: x is y or (x == y and isinstance(x, (int, bool, Symbol)))))
|
||
d(S('memv'), lambda a, _: _member(a[0], a[1], lambda x, y: x == y))
|
||
d(S('member'), lambda a, _: _member(a[0], a[1], _equal))
|
||
d(S('assq'), lambda a, _: _assoc(a[0], a[1], lambda x, y: x is y or (x == y and isinstance(x, (int, bool, Symbol)))))
|
||
d(S('assv'), lambda a, _: _assoc(a[0], a[1], lambda x, y: x == y))
|
||
d(S('assoc'), lambda a, _: _assoc(a[0], a[1], _equal))
|
||
d(S('flatten'), lambda a, _: _P(_flatten(_L(a[0]))))
|
||
d(S('zip'), lambda a, _: _P([_P(list(row)) for row in zip(*[_L(lst) for lst in a])]))
|
||
d(S('take'), lambda a, _: _P(list(_L(a[0]))[:int(_num(a[1]))]))
|
||
d(S('drop'), lambda a, _: _P(list(_L(a[0]))[int(_num(a[1])):]))
|
||
d(S('take-while'), lambda a, e: _P(list(_takewhile(a[0], _L(a[1]), e))))
|
||
d(S('drop-while'), lambda a, e: _P(list(_dropwhile(a[0], _L(a[1]), e))))
|
||
d(S('list-index'), lambda a, e: next((i for i, x in enumerate(_L(a[1])) if _truthy(_call(a[0], [x], e))), False))
|
||
d(S('delete'), lambda a, e: _P([x for x in _L(a[1]) if not _equal(x, a[0])]))
|
||
d(S('delete-duplicates'), lambda a, _: _P(list({id(x) if isinstance(x, Pair) else x: x for x in _L(a[0])}.values())))
|
||
|
||
def _flatten(lst):
|
||
for x in lst:
|
||
if isinstance(x, Pair): yield from _flatten(list(x))
|
||
elif x is NIL: pass
|
||
else: yield x
|
||
|
||
def _takewhile(f, lst, env):
|
||
for x in lst:
|
||
if not _truthy(_call(f, [x], env)): break
|
||
yield x
|
||
|
||
def _dropwhile(f, lst, env):
|
||
dropping = True
|
||
for x in lst:
|
||
if dropping and _truthy(_call(f, [x], env)): continue
|
||
dropping = False; yield x
|
||
|
||
d(S('flatten'), lambda a, _: _P(list(_flatten(_L(a[0])))))
|
||
d(S('take-while'), lambda a, e: _P(list(_takewhile(a[0], _L(a[1]), e))))
|
||
d(S('drop-while'), lambda a, e: _P(list(_dropwhile(a[0], _L(a[1]), e))))
|
||
|
||
# ── SRFI-1 list library ───────────────────────────────────────────────────
|
||
def _take_right(lst, n):
|
||
items = _L(lst); return _P(items[max(0, len(items)-n):])
|
||
def _drop_right(lst, n):
|
||
items = _L(lst); return _P(items[:max(0, len(items)-n)])
|
||
def _lset_union(eq, lists):
|
||
result = []
|
||
for lst in lists:
|
||
for x in _L(lst):
|
||
if not any(_call(eq, [x, y], None) if callable(eq) else eq(x, y) for y in result):
|
||
result.append(x)
|
||
return _P(result)
|
||
def _lset_intersect(eq, a, b):
|
||
bl = _L(b)
|
||
return _P([x for x in _L(a) if any(_equal(x, y) for y in bl)])
|
||
def _lset_diff(eq, a, b):
|
||
bl = _L(b)
|
||
return _P([x for x in _L(a) if not any(_equal(x, y) for y in bl)])
|
||
def _unfold(pred, f, g, seed, env):
|
||
result = []
|
||
while not _truthy(_call(pred, [seed], env)):
|
||
result.append(_call(f, [seed], env))
|
||
seed = _call(g, [seed], env)
|
||
return _P(result)
|
||
|
||
d(S('take-right'), lambda a, _: _take_right(a[0], int(_num(a[1]))))
|
||
d(S('drop-right'), lambda a, _: _drop_right(a[0], int(_num(a[1]))))
|
||
d(S('last'), lambda a, _: _L(a[0])[-1])
|
||
d(S('first'), lambda a, _: _pair_val(a[0]).car)
|
||
d(S('second'), lambda a, _: list(a[0])[1])
|
||
d(S('third'), lambda a, _: list(a[0])[2])
|
||
d(S('fourth'), lambda a, _: list(a[0])[3])
|
||
d(S('fifth'), lambda a, _: list(a[0])[4])
|
||
d(S('concatenate'), lambda a, _: _append(_L(a[0])))
|
||
d(S('list-tabulate'), lambda a, e: _P([_call(a[1],[i],e) for i in range(int(_num(a[0])))]))
|
||
d(S('reduce-right'), lambda a, e: _fold(a[0], a[1], _L(a[2]), e, left=False))
|
||
d(S('unfold'), lambda a, e: _unfold(a[0], a[1], a[2], a[3], e))
|
||
d(S('lset-union'), lambda a, e: _lset_union(a[0], a[1:]))
|
||
d(S('lset-intersection'), lambda a, e: _lset_intersect(a[0], a[1], a[2]))
|
||
d(S('lset-difference'), lambda a, e: _lset_diff(a[0], a[1], a[2]))
|
||
d(S('proper-list?'), lambda a, _: _is_proper_list(a[0]))
|
||
d(S('dotted-list?'), lambda a, _: (lambda n=a[0]: not _is_proper_list(n) and (isinstance(n, Pair) or not isinstance(n, _Nil)))())
|
||
d(S('null-list?'), lambda a, _: a[0] is NIL)
|
||
d(S('alist-cons'), lambda a, _: Pair(Pair(a[0], a[1]), a[2]))
|
||
d(S('alist-copy'), lambda a, _: _P([Pair(p.car, p.cdr) for p in _L(a[0])]))
|
||
d(S('pair-for-each'), lambda a, e: [(lambda p: _call(a[0],[p],e))(p) for p in _L(a[1])] and VOID)
|
||
d(S('append!'), lambda a, _: _append(a)) # non-destructive fallback
|
||
d(S('delete'), lambda a, e: _P([x for x in _L(a[1]) if not _equal(x, a[0])]))
|
||
d(S('delete!'), lambda a, e: _P([x for x in _L(a[1]) if not _equal(x, a[0])]))
|
||
def _dedup(lst):
|
||
seen = []; r = []
|
||
for x in _L(lst):
|
||
if not any(_equal(x, y) for y in seen): seen.append(x); r.append(x)
|
||
return _P(r)
|
||
d(S('delete-duplicates'), lambda a, _: _dedup(a[0]))
|
||
|
||
# caaar..cddddr — auto-generate
|
||
for combo in ['aa','ad','da','dd',
|
||
'aaa','aad','ada','add','daa','dad','dda','ddd',
|
||
'aaaa','aaad','aada','aadd','adaa','adad','adda','addd',
|
||
'daaa','daad','dada','dadd','ddaa','ddad','ddda','dddd']:
|
||
def _cxr(a, _, c=combo):
|
||
x = a[0]
|
||
for ch in reversed(c):
|
||
x = _pair_val(x).car if ch == 'a' else _pair_val(x).cdr
|
||
return x
|
||
d(S('c' + combo + 'r'), _cxr)
|
||
|
||
# ── Higher-order ──────────────────────────────────────────────────────────
|
||
def _map(f, lists, env):
|
||
rows = [_L(lst) for lst in lists]
|
||
return _P([_call(f, list(col), env) for col in zip(*rows)])
|
||
|
||
def _for_each(f, lists, env):
|
||
rows = [_L(lst) for lst in lists]
|
||
for col in zip(*rows): _call(f, list(col), env)
|
||
|
||
def _fold(f, init, lst, env, left=True):
|
||
acc = init
|
||
items = lst if left else reversed(lst)
|
||
for x in items: acc = _call(f, [x, acc], env)
|
||
return acc
|
||
|
||
d(S('map'), lambda a, e: _map(a[0], a[1:], e))
|
||
d(S('for-each'), lambda a, e: _for_each(a[0], a[1:], e) or VOID)
|
||
d(S('filter'), lambda a, e: _P([x for x in _L(a[1]) if _truthy(_call(a[0], [x], e))]))
|
||
d(S('filter-map'), lambda a, e: _P([v for x in _L(a[1]) for v in [_call(a[0],[x],e)] if _truthy(v)]))
|
||
d(S('fold-left'), lambda a, e: _fold(a[0], a[1], _L(a[2]), e, left=True))
|
||
d(S('fold-right'), lambda a, e: _fold(a[0], a[1], _L(a[2]), e, left=False))
|
||
d(S('foldl'), lambda a, e: _fold(a[0], a[1], _L(a[2]), e, left=True))
|
||
d(S('foldr'), lambda a, e: _fold(a[0], a[1], _L(a[2]), e, left=False))
|
||
d(S('reduce'), lambda a, e: (lambda lst: _fold(a[0], lst[0], lst[1:], e))(_L(a[2])) if _L(a[2]) else a[1])
|
||
d(S('any'), lambda a, e: next((x for x in _L(a[1]) if _truthy(_call(a[0],[x],e))), False))
|
||
d(S('every'), lambda a, e: next((False for x in _L(a[1]) if not _truthy(_call(a[0],[x],e))), True))
|
||
d(S('count'), lambda a, e: sum(1 for x in _L(a[1]) if _truthy(_call(a[0],[x],e))))
|
||
d(S('flat-map'), lambda a, e: _append([_call(a[0],[x],e) for x in _L(a[1])]))
|
||
d(S('append-map'), lambda a, e: _append([_call(a[0],[x],e) for x in _L(a[1])]))
|
||
d(S('sort'), lambda a, e: _P(sorted(_L(a[0]))))
|
||
d(S('sort-by'), lambda a, e: _P(sorted(_L(a[1]), key=lambda x: _call(a[0],[x],e))))
|
||
d(S('group-by'), lambda a, e: _group_by(a[0], _L(a[1]), e))
|
||
d(S('partition'), lambda a, e: (lambda yes,no: (yes, no))(*_partition(a[0], _L(a[1]), e)))
|
||
d(S('find'), lambda a, e: next((x for x in _L(a[1]) if _truthy(_call(a[0],[x],e))), False))
|
||
|
||
def _group_by(f, lst, env):
|
||
groups = {}; order = []
|
||
for x in lst:
|
||
k = _call(f, [x], env)
|
||
if k not in groups: groups[k] = []; order.append(k)
|
||
groups[k].append(x)
|
||
return _P([Pair(k, _P(groups[k])) for k in order])
|
||
|
||
def _partition(f, lst, env):
|
||
yes, no = [], []
|
||
for x in lst:
|
||
(yes if _truthy(_call(f,[x],env)) else no).append(x)
|
||
return _P(yes), _P(no)
|
||
|
||
d(S('group-by'), lambda a, e: _group_by(a[0], _L(a[1]), e))
|
||
d(S('partition'), lambda a, e: (lambda r: _P([r[0], r[1]]))(_partition(a[0], _L(a[1]), e)))
|
||
|
||
# Functional utilities
|
||
def _compose(fns):
|
||
if not fns: return lambda a, e: a[0]
|
||
def composed(args, env):
|
||
result = _call(fns[-1], args, env)
|
||
for f in reversed(fns[:-1]): result = _call(f, [result], env)
|
||
return result
|
||
return composed
|
||
|
||
d(S('compose'), lambda a, e: _compose(a))
|
||
d(S('identity'), lambda a, _: a[0])
|
||
d(S('const'), lambda a, e: (lambda v: (lambda b, _: v))(a[0]))
|
||
d(S('negate'), lambda a, e: (lambda f: lambda b, _: not _truthy(_call(f, b, e)))(a[0]))
|
||
d(S('complement'), lambda a, e: (lambda f: lambda b, _: not _truthy(_call(f, b, e)))(a[0]))
|
||
d(S('flip'), lambda a, e: (lambda f: lambda b, _: _call(f, [b[1],b[0]], e))(a[0]))
|
||
d(S('curry'), lambda a, e: (lambda f, x: lambda b, _: _call(f, [x]+b, e))(a[0], a[1]))
|
||
d(S('constantly'), lambda a, _: (lambda v: (lambda b, _: v))(a[0]))
|
||
d(S('apply'), lambda a, e: _call(a[0], (_L(a[-1]) if len(a)==2 else [leval(x,e) for x in a[1:-1]] + _L(a[-1])), e))
|
||
|
||
# ── Strings ───────────────────────────────────────────────────────────────
|
||
d(S('make-string'), lambda a, _: MutableString((a[1] if len(a) > 1 else ' ') * int(_num(a[0]))))
|
||
d(S('string'), lambda a, _: ''.join(a))
|
||
d(S('string-length'), lambda a, _: len(_str_val(a[0])))
|
||
d(S('string-ref'), lambda a, _: _str_val(a[0])[int(_num(a[1]))])
|
||
d(S('substring'), lambda a, _: str(_str_val(a[0]))[int(_num(a[1])): int(_num(a[2])) if len(a) > 2 else None])
|
||
d(S('string-append'), lambda a, _: ''.join(str(_str_val(x)) for x in a))
|
||
d(S('string-copy'), lambda a, _: MutableString(_str_val(a[0])))
|
||
d(S('string-set!'), lambda a, _: (_str_val(a[0]).__setitem__(int(_num(a[1])), a[2]) or VOID) if isinstance(a[0], MutableString) else _raise(LispErr('string-set!: immutable string')))
|
||
d(S('string-fill!'), lambda a, _: [_str_val(a[0]).__setitem__(i, a[1]) for i in range(len(a[0]))] and VOID if isinstance(a[0], MutableString) else _raise(LispErr('string-fill!: immutable string')))
|
||
d(S('string-copy!'), lambda a, _: [a[0].__setitem__(int(_num(a[1]))+i, c) for i, c in enumerate(str(_str_val(a[2]))[int(_num(a[3])) if len(a)>3 else 0:int(_num(a[4])) if len(a)>4 else None])] and VOID if isinstance(a[0], MutableString) else _raise(LispErr('string-copy!: immutable dest')))
|
||
d(S('string->list'), lambda a, _: _P(list(_str_val(a[0]))))
|
||
d(S('list->string'), lambda a, _: ''.join(_L(a[0])))
|
||
d(S('string->symbol'), lambda a, _: S(_str_val(a[0])))
|
||
d(S('symbol->string'), lambda a, _: str(_sym_val(a[0])))
|
||
d(S('string->number'), lambda a, _: _str_to_num(a))
|
||
d(S('string-upcase'), lambda a, _: _str_val(a[0]).upper())
|
||
d(S('string-downcase'), lambda a, _: _str_val(a[0]).lower())
|
||
d(S('string-contains'),lambda a, _: _str_val(a[1]) in _str_val(a[0]))
|
||
d(S('string-prefix?'), lambda a, _: _str_val(a[1]).startswith(_str_val(a[0])))
|
||
d(S('string-suffix?'), lambda a, _: _str_val(a[1]).endswith(_str_val(a[0])))
|
||
d(S('string-split'), lambda a, _: _P(_str_val(a[0]).split(_str_val(a[1]) if len(a)>1 else None)))
|
||
d(S('string-join'), lambda a, _: (_str_val(a[1]) if len(a)>1 else ' ').join(_L(a[0])))
|
||
d(S('string-trim'), lambda a, _: _str_val(a[0]).strip())
|
||
d(S('string-trim-right'),lambda a, _: _str_val(a[0]).rstrip())
|
||
d(S('string-replace'), lambda a, _: _str_val(a[0]).replace(_str_val(a[1]), _str_val(a[2])))
|
||
d(S('string-index'), lambda a, _: _str_val(a[0]).find(_str_val(a[1])))
|
||
d(S('string=?'), lambda a, _: _str_val(a[0]) == _str_val(a[1]))
|
||
d(S('string<?'), lambda a, _: _str_val(a[0]) < _str_val(a[1]))
|
||
d(S('string>?'), lambda a, _: _str_val(a[0]) > _str_val(a[1]))
|
||
d(S('string<=?'), lambda a, _: _str_val(a[0]) <= _str_val(a[1]))
|
||
d(S('string>=?'), lambda a, _: _str_val(a[0]) >= _str_val(a[1]))
|
||
d(S('string-ci=?'), lambda a, _: _str_val(a[0]).lower() == _str_val(a[1]).lower())
|
||
d(S('format'), lambda a, _: _format(a))
|
||
d(S('string-format'), lambda a, _: _format(a))
|
||
|
||
def _str_to_num(a):
|
||
s = _str_val(a[0]); base = int(_num(a[1])) if len(a) > 1 else 10
|
||
orig = s
|
||
# R7RS/Scheme radix prefixes: #b #o #d #x (also 0x/0b/0o for convenience)
|
||
if len(s) >= 2 and s[0] == '#':
|
||
pfx = s[1].lower()
|
||
if pfx == 'x': s = s[2:]; base = 16
|
||
elif pfx == 'b': s = s[2:]; base = 2
|
||
elif pfx == 'o': s = s[2:]; base = 8
|
||
elif pfx == 'd': s = s[2:]; base = 10
|
||
elif len(a) == 1 and len(s) >= 2 and s[0] == '0':
|
||
pfx = s[1].lower()
|
||
if pfx == 'x': s = s[2:]; base = 16
|
||
elif pfx == 'b': s = s[2:]; base = 2
|
||
elif pfx == 'o': s = s[2:]; base = 8
|
||
try: return int(s, base)
|
||
except ValueError: pass
|
||
if base == 10:
|
||
# Rational n/d
|
||
if re.fullmatch(r'-?\d+/-?\d+', s):
|
||
try:
|
||
f = Fraction(s)
|
||
return f if f.denominator != 1 else f.numerator
|
||
except (ValueError, ZeroDivisionError): pass
|
||
try:
|
||
v = float(orig)
|
||
return v
|
||
except ValueError: pass
|
||
return False
|
||
|
||
d(S('string->number'), lambda a, _: _str_to_num(a))
|
||
|
||
# ── Symbols ───────────────────────────────────────────────────────────────
|
||
d(S('gensym'), lambda a, _: S(f'g{next(_gensym_ctr)}'))
|
||
|
||
# ── Characters ───────────────────────────────────────────────────────────
|
||
d(S('char->integer'), lambda a, _: ord(a[0]))
|
||
d(S('integer->char'), lambda a, _: chr(int(_num(a[0]))))
|
||
d(S('char-alphabetic?'), lambda a, _: a[0].isalpha())
|
||
d(S('char-numeric?'), lambda a, _: a[0].isdigit())
|
||
d(S('char-whitespace?'), lambda a, _: a[0].isspace())
|
||
d(S('char-upper-case?'), lambda a, _: a[0].isupper())
|
||
d(S('char-lower-case?'), lambda a, _: a[0].islower())
|
||
d(S('char-upcase'), lambda a, _: a[0].upper())
|
||
d(S('char-downcase'), lambda a, _: a[0].lower())
|
||
d(S('char=?'), lambda a, _: a[0] == a[1])
|
||
d(S('char<?'), lambda a, _: a[0] < a[1])
|
||
d(S('char>?'), lambda a, _: a[0] > a[1])
|
||
d(S('char<=?'), lambda a, _: a[0] <= a[1])
|
||
d(S('char>=?'), lambda a, _: a[0] >= a[1])
|
||
d(S('char-ci=?'),lambda a, _: a[0].lower() == a[1].lower())
|
||
|
||
# ── Vectors ───────────────────────────────────────────────────────────────
|
||
d(S('make-vector'), lambda a, _: [a[1] if len(a) > 1 else 0] * int(_num(a[0])))
|
||
d(S('vector'), lambda a, _: list(a))
|
||
d(S('vector-length'),lambda a, _: len(a[0]))
|
||
d(S('vector-ref'), lambda a, _: a[0][int(_num(a[1]))])
|
||
d(S('vector-set!'), lambda a, _: a[0].__setitem__(int(_num(a[1])), a[2]) or VOID)
|
||
d(S('vector->list'), lambda a, _: _P(a[0]))
|
||
d(S('list->vector'), lambda a, _: list(_L(a[0])))
|
||
d(S('vector-copy'), lambda a, _: list(a[0][ int(_num(a[1])) if len(a)>1 else 0 : int(_num(a[2])) if len(a)>2 else None ]))
|
||
d(S('vector-copy!'), lambda a, _: [a[0].__setitem__(int(_num(a[1]))+i, v) for i, v in enumerate(a[2][ int(_num(a[3])) if len(a)>3 else 0 : int(_num(a[4])) if len(a)>4 else None ])] and VOID)
|
||
d(S('vector-fill!'), lambda a, _: a[0].__setitem__(slice(None), [a[1]] * len(a[0])) or VOID)
|
||
d(S('vector-map'), lambda a, e: list(_map(a[0], [_P(a[1])], e) and [] or [_call(a[0],[x],e) for x in a[1]]))
|
||
d(S('vector-for-each'), lambda a, e: [_call(a[0],[x],e) for x in a[1]] and VOID)
|
||
d(S('vector-append'),lambda a, _: sum((v for v in a), []))
|
||
d(S('vector->string'),lambda a, _: ''.join(a[0]))
|
||
d(S('string->vector'),lambda a, _: list(_str_val(a[0])))
|
||
|
||
# ── Hash tables ───────────────────────────────────────────────────────────
|
||
d(S('make-hash-table'), lambda a, _: {})
|
||
d(S('make-equal-hash-table'), lambda a, _: {})
|
||
d(S('hash-table?'), lambda a, _: isinstance(a[0], dict))
|
||
d(S('hash-table-set!'), lambda a, _: a[0].__setitem__(a[1], a[2]) or VOID)
|
||
d(S('hash-table/put!'), lambda a, _: a[0].__setitem__(a[1], a[2]) or VOID)
|
||
d(S('hash-table-ref'), lambda a, e: a[0][a[1]] if a[1] in a[0] else (_call(a[2],[],e) if len(a)>2 else _raise(LispErr(f'hash-table-ref: missing key: {show(a[1])}'))))
|
||
d(S('hash-table-ref/default'), lambda a, _: a[0].get(a[1], a[2]))
|
||
d(S('hash-table/get'), lambda a, _: a[0].get(a[1], a[2]))
|
||
d(S('hash-table-delete!'),lambda a,_: a[0].pop(a[1], None) or VOID)
|
||
d(S('hash-table-exists?'),lambda a,_: a[1] in a[0])
|
||
d(S('hash-table/count'), lambda a, _: len(a[0]))
|
||
d(S('hash-table-size'), lambda a, _: len(a[0]))
|
||
d(S('hash-table-keys'), lambda a, _: _P(list(a[0].keys())))
|
||
d(S('hash-table-values'),lambda a, _: _P(list(a[0].values())))
|
||
d(S('hash-table->alist'),lambda a, _: _P([Pair(k, v) for k, v in a[0].items()]))
|
||
d(S('alist->hash-table'),lambda a, _: dict((p.car, p.cdr) for p in _L(a[0])))
|
||
d(S('hash-table-walk'), lambda a, e: [_call(a[1],[k,v],e) for k,v in a[0].items()] and VOID)
|
||
d(S('hash-table-merge!'),lambda a, _: a[0].update(a[1]) or a[0])
|
||
d(S('hash-table-update!'), lambda a, e: a[0].__setitem__(a[1], _call(a[2],[a[0].get(a[1], _call(a[3],[],e) if len(a)>3 else _raise(LispErr('hash-table-update!: missing key')))],e)) or VOID)
|
||
|
||
# ── I/O ───────────────────────────────────────────────────────────────────
|
||
def _port_out(a): return a[1] if len(a) > 1 else sys.stdout
|
||
def _port_in(a): return a[0] if a and isinstance(a[0], StringInputPort) else None
|
||
|
||
d(S('display'), lambda a, _: print(show(a[0], display=True), end='', file=_port_out(a), flush=True) or VOID)
|
||
d(S('write'), lambda a, _: print(show(a[0]), end='', file=_port_out(a), flush=True) or VOID)
|
||
d(S('newline'), lambda a, _: print(file=a[0] if a else sys.stdout) or VOID)
|
||
d(S('print'), lambda a, _: print(show(a[0], display=True), flush=True) or VOID)
|
||
d(S('println'), lambda a, _: print(show(a[0], display=True), flush=True) or VOID)
|
||
d(S('writeln'), lambda a, _: print(show(a[0]), flush=True) or VOID)
|
||
d(S('write-string'), lambda a, _: ((_port_out(a) if len(a) > 1 else sys.stdout).write(_str_val(a[0])) or VOID))
|
||
d(S('read-char'), lambda a, _: _read_char_port(a[0] if a else None))
|
||
d(S('peek-char'), lambda a, _: _peek_char_port(a[0] if a else None))
|
||
d(S('char-ready?'), lambda a, _: (a[0].char_ready() if isinstance(a[0], StringInputPort) else True) if a else True)
|
||
d(S('write-char'),lambda a, _: print(a[0], end='', file=a[1] if len(a)>1 else sys.stdout, flush=True) or VOID)
|
||
d(S('read-line'), lambda a, _: _read_line_port(a[0] if a else None))
|
||
d(S('read'), lambda a, _: _read_datum_port(a[0] if a else None))
|
||
d(S('open-input-file'), lambda a, _: open(_str_val(a[0])))
|
||
d(S('open-output-file'), lambda a, _: open(_str_val(a[0]), 'w'))
|
||
d(S('open-binary-output-file'), lambda a, _: _open_binary_output_file(_str_val(a[0])))
|
||
d(S('port-set-position!'), lambda a, _: _port_set_position(a[0], a[1]))
|
||
d(S('write-file'), lambda a, _: _write_file(_str_val(a[0]), _str_val(a[1])))
|
||
d(S('file->string'), lambda a, _: _read_file_to_string(_str_val(a[0])))
|
||
d(S('tcp-listen'), lambda a, _: _tcp_listen(int(a[0])))
|
||
d(S('tcp-accept'), lambda a, _: _tcp_accept(a[0]))
|
||
d(S('tcp-connect'), lambda a, _: _tcp_connect(_str_val(a[0]), int(a[1])))
|
||
d(S('tcp-recv'), lambda a, _: _tcp_recv(a[0], int(a[1])))
|
||
d(S('tcp-send'), lambda a, _: _tcp_send(a[0], _str_val(a[1])))
|
||
d(S('tcp-close'), lambda a, _: (a[0].close(), VOID)[-1])
|
||
def _spawn_args(a):
|
||
n = a[1]; out = []
|
||
while isinstance(n, Pair):
|
||
v = n.car
|
||
out.append(_str_val(v) if not isinstance(v, str) else v)
|
||
n = n.cdr
|
||
return out
|
||
d(S('spawn-process-stdio'),
|
||
lambda a, _: _spawn_process_stdio(_str_val(a[0]), _spawn_args(a)))
|
||
d(S('fork-self'), lambda a, _: _fork_self())
|
||
d(S('waitpid-nonblock'), lambda a, _: _waitpid_nonblock())
|
||
d(S('exit-immediate'), lambda a, _: _exit_immediate(int(_num(a[0])) if a else 0))
|
||
d(S('sleep'), lambda a, _: _sleep(int(_num(a[0])) if a else 0))
|
||
d(S('flush-port'), lambda a, _: _flush_port(a[0]))
|
||
d(S('write-binary-file'), lambda a, _: _write_binary_file(_str_val(a[0]), _str_val(a[1])))
|
||
d(S('append-binary-file'), lambda a, _: _append_binary_file(_str_val(a[0]), _str_val(a[1])))
|
||
d(S('append-port-to-binary-file'), lambda a, _: _append_port_to_binary_file(_str_val(a[0]), a[1]))
|
||
d(S('read-binary-file'), lambda a, _: _read_binary_file(_str_val(a[0])))
|
||
d(S('walk-circuit-ops'), lambda a, _: _walk_circuit_ops(a[0], a[1]))
|
||
d(S('op-specs->bytes'), lambda a, _: _op_specs_to_bytes(a[0]))
|
||
d(S('emit-circuit-to-ops-bin-stream'),
|
||
lambda a, _: _emit_circuit_to_ops_bin_stream(_str_val(a[0]), a[1], a[2]))
|
||
d(S('count-lumbda-ops'), lambda a, _: _count_lumbda_ops(a[0]))
|
||
# heap-snapshot/heap-restore are asm-only arena primitives. Python has
|
||
# real GC so these are no-ops here — they exist only to let portable
|
||
# .lsp code call them unconditionally.
|
||
d(S('heap-snapshot'), lambda a, _: False)
|
||
d(S('heap-restore'), lambda a, _: VOID)
|
||
d(S('current-time-ms'), lambda a, _: int(__import__('time').time() * 1000))
|
||
d(S('read-from-string'), lambda a, _: _read_from_string(_str_val(a[0])))
|
||
# eval is already a special form (see leval); exposing it as a builtin would
|
||
# be shadowed by that dispatch. RPC servers can still call `(eval sexp)`
|
||
# literally because the special form handles it.
|
||
d(S('open-input-string'), lambda a, _: StringInputPort(_str_val(a[0])))
|
||
d(S('open-output-string'),lambda a, _: StringOutputPort())
|
||
d(S('get-output-string'), lambda a, _: a[0].getvalue() if isinstance(a[0], StringOutputPort) else '')
|
||
d(S('with-input-from-string'), lambda a, e: _with_input_from_string(_str_val(a[0]), a[1], e))
|
||
d(S('close-port'), lambda a, _: a[0].close() or VOID)
|
||
d(S('close-input-port'), lambda a, _: a[0].close() or VOID)
|
||
d(S('close-output-port'), lambda a, _: a[0].close() or VOID)
|
||
d(S('current-input-port'), lambda a, _: sys.stdin)
|
||
d(S('current-output-port'),lambda a, _: sys.stdout)
|
||
d(S('current-error-port'), lambda a, _: sys.stderr)
|
||
d(S('port?'), lambda a, _: isinstance(a[0], (StringInputPort, StringOutputPort)) or hasattr(a[0], 'read') or hasattr(a[0], 'write'))
|
||
d(S('input-port?'), lambda a, _: isinstance(a[0], StringInputPort) or hasattr(a[0], 'read'))
|
||
d(S('output-port?'), lambda a, _: isinstance(a[0], StringOutputPort) or hasattr(a[0], 'write'))
|
||
d(S('string-port?'), lambda a, _: isinstance(a[0], (StringInputPort, StringOutputPort)))
|
||
d(S('eof-object'), lambda a, _: EOF)
|
||
d(S('void'), lambda a, _: VOID)
|
||
d(S('with-output-to-string'), lambda a, e: _output_to_string(a[0], e))
|
||
d(S('call-with-port'), lambda a, e: (_call(a[1], [a[0]], e), a[0].close(), None)[-1] or VOID)
|
||
d(S('call-with-string-output-port'), lambda a, e:
|
||
(lambda p: (_call(a[0], [p], e), p.getvalue())[1])(StringOutputPort()))
|
||
|
||
def _read_char_port(port):
|
||
if isinstance(port, StringInputPort): ch = port.read(1); return ch if ch else EOF
|
||
return sys.stdin.read(1) or EOF
|
||
|
||
def _peek_char_port(port):
|
||
if isinstance(port, StringInputPort): return port.peek_char()
|
||
return EOF # simplified for file ports
|
||
|
||
def _read_line_port(port):
|
||
if isinstance(port, StringInputPort):
|
||
line = port.readline(); return EOF if not line else line.rstrip('\n')
|
||
# any file-like with readline() (incl. subprocess pipes from spawn-process-stdio)
|
||
if port is not None and hasattr(port, 'readline'):
|
||
try:
|
||
line = port.readline()
|
||
return EOF if not line else line.rstrip('\n')
|
||
except EOFError: return EOF
|
||
try:
|
||
line = sys.stdin.readline()
|
||
return EOF if not line else line.rstrip('\n')
|
||
except EOFError: return EOF
|
||
|
||
def _read_datum_port(port):
|
||
if isinstance(port, StringInputPort): return port.read_datum()
|
||
return _read_one()
|
||
|
||
def _read_one():
|
||
try:
|
||
line = input()
|
||
exprs = read_all(line)
|
||
return exprs[0] if exprs else EOF
|
||
except EOFError: return EOF
|
||
|
||
def _with_input_from_string(s, thunk, env):
|
||
port = StringInputPort(s)
|
||
return _call(thunk, [port], env)
|
||
|
||
def _output_to_string(thunk, env):
|
||
import io
|
||
buf = io.StringIO()
|
||
old = sys.stdout; sys.stdout = buf
|
||
try: _call(thunk, [], env)
|
||
finally: sys.stdout = old
|
||
return buf.getvalue()
|
||
|
||
d(S('with-output-to-string'), lambda a, e: _output_to_string(a[0], e))
|
||
|
||
# ── File system ──────────────────────────────────────────────────────────
|
||
d(S('file-exists?'), lambda a, _: _os.path.exists(_str_val(a[0])))
|
||
d(S('delete-file'), lambda a, _: _os.unlink(_str_val(a[0])) or VOID)
|
||
d(S('rename-file'), lambda a, _: _os.rename(_str_val(a[0]), _str_val(a[1])) or VOID)
|
||
d(S('current-directory'), lambda a, _: _os.getcwd())
|
||
d(S('set-current-directory!'),lambda a, _: _os.chdir(_str_val(a[0])) or VOID)
|
||
d(S('directory-files'), lambda a, _: _P(sorted(_os.listdir(_str_val(a[0]) if a else _os.getcwd()))))
|
||
d(S('make-directory'), lambda a, _: _os.makedirs(_str_val(a[0]), exist_ok=True) or VOID)
|
||
d(S('file-size'), lambda a, _: _os.path.getsize(_str_val(a[0])))
|
||
d(S('file-directory?'), lambda a, _: _os.path.isdir(_str_val(a[0])))
|
||
d(S('file-regular?'), lambda a, _: _os.path.isfile(_str_val(a[0])))
|
||
|
||
# ── System ────────────────────────────────────────────────────────────────
|
||
d(S('command-line'), lambda a, _: _P(sys.argv))
|
||
d(S('get-environment-variable'), lambda a, _: _os.environ.get(_str_val(a[0]), False))
|
||
d(S('current-time'), lambda a, _: __import__('time').time())
|
||
d(S('current-jiffy'), lambda a, _: int(__import__('time').monotonic_ns() // 1000000))
|
||
d(S('jiffies-per-second'), lambda a, _: 1000)
|
||
d(S('flush-output-port'), lambda a, _: (a[0] if a else sys.stdout).flush() or VOID)
|
||
|
||
# ── Tracing ───────────────────────────────────────────────────────────────
|
||
def _make_traced(proc, name):
|
||
sname = str(name) if name else getattr(proc, 'name', None) or 'λ'
|
||
_traced_originals[sname] = proc
|
||
def traced(args, env):
|
||
arg_str = ' '.join(show(a)[:30] for a in args[:4])
|
||
print(f' [trace {sname}] ({sname} {arg_str})', file=sys.stderr)
|
||
result = _call(proc, args, env)
|
||
print(f' [trace {sname}] => {show(result)[:60]}', file=sys.stderr)
|
||
return result
|
||
return traced
|
||
|
||
d(S('make-traced'), lambda a, _: _make_traced(a[0], a[1] if len(a) > 1 else None))
|
||
d(S('untrace-proc'), lambda a, _: _traced_originals.get(str(a[0]), a[0]))
|
||
|
||
# ── Control ───────────────────────────────────────────────────────────────
|
||
d(S('exit'), lambda a, _: sys.exit(0 if not a else int(_num(a[0]))))
|
||
d(S('error'), lambda a, _: (lambda obj: _raise(LispErr(str(obj), obj=obj)))(
|
||
ErrorObject(show(a[0], display=True), a[1:])))
|
||
d(S('raise'), lambda a, _: _raise(LispErr(str(a[0]) if isinstance(a[0], ErrorObject) else show(a[0]),
|
||
obj=a[0] if isinstance(a[0], ErrorObject) else None)))
|
||
d(S('raise-continuable'), lambda a, _: _raise(LispErr(show(a[0]))))
|
||
d(S('error-object?'), lambda a, _: isinstance(a[0], ErrorObject))
|
||
d(S('error?'), lambda a, _: isinstance(a[0], ErrorObject))
|
||
d(S('error-object-message'), lambda a, _: a[0].msg if isinstance(a[0], ErrorObject) else str(a[0]))
|
||
d(S('error-object-irritants'), lambda a, _: _P(a[0].irritants) if isinstance(a[0], ErrorObject) else NIL)
|
||
d(S('error-message'), lambda a, _: a[0].msg if isinstance(a[0], ErrorObject) else str(a[0]))
|
||
d(S('condition?'), lambda a, _: isinstance(a[0], (ErrorObject, str)))
|
||
d(S('condition/report-string'),lambda a, _: str(a[0]))
|
||
d(S('with-exception-handler'), lambda a, e: None) # handled as special form
|
||
|
||
# ── Misc ──────────────────────────────────────────────────────────────────
|
||
d(S('not'), lambda a, _: not _truthy(a[0]))
|
||
d(S('values'), lambda a, _: a[0] if len(a) == 1 else tuple(a))
|
||
d(S('call-with-values'), lambda a, e: (lambda r: _call(a[1], list(r) if isinstance(r, tuple) else [r], e))(_call(a[0],[],e)))
|
||
d(S('dynamic-wind'), lambda a, e: (_call(a[0],[],e), r := _call(a[1],[],e), _call(a[2],[],e), r)[-1])
|
||
d(S('make-parameter'),lambda a, e: _make_parameter(a[0], a[1] if len(a)>1 else None, e))
|
||
d(S('procedure?'), lambda a, _: isinstance(a[0], (Proc, CompiledProc)) or (callable(a[0]) and not isinstance(a[0], (bool, type))))
|
||
d(S('procedure-arity'), lambda a, _: len(a[0].params) if isinstance(a[0], Proc) else -1)
|
||
d(S('procedure-name'), lambda a, _: a[0].name or False if isinstance(a[0], Proc) else False)
|
||
|
||
def _make_parameter(init, converter, env):
|
||
box = [_call(converter, [init], env) if converter else init]
|
||
def param(args, env_):
|
||
if not args: return box[0]
|
||
box[0] = _call(converter, [args[0]], env_) if converter else args[0]
|
||
return VOID
|
||
return param
|
||
|
||
d(S('make-parameter'), lambda a, e: _make_parameter(a[0], a[1] if len(a)>1 else None, e))
|
||
|
||
# String representation
|
||
d(S('object->string'), lambda a, _: show(a[0]))
|
||
d(S('write-to-string'),lambda a, _: show(a[0]))
|
||
d(S('display-to-string'), lambda a, _: show(a[0], display=True))
|
||
d(S('pretty-print'), lambda a, e: print(_pprint(a[0]), file=a[1] if len(a)>1 else sys.stdout) or VOID)
|
||
d(S('pp'), lambda a, e: print(_pprint(a[0]), file=a[1] if len(a)>1 else sys.stdout) or VOID)
|
||
|
||
# Python interop
|
||
d(S('py-eval'), lambda a, _: eval(_str_val(a[0])))
|
||
d(S('py-exec'), lambda a, _: exec(_str_val(a[0])) or VOID)
|
||
d(S('py-import'), lambda a, _: __import__(_str_val(a[0])))
|
||
d(S('py-call'), lambda a, _: a[0](*a[1:]))
|
||
d(S('py-attr'), lambda a, _: getattr(a[0], _str_val(a[1])))
|
||
|
||
# ── Bytecode compiler ────────────────────────────────────────────────────
|
||
d(S('compile'), lambda a, e: bc_compile_proc(a[0], e))
|
||
d(S('compiled?'), lambda a, _: isinstance(a[0], CompiledProc))
|
||
d(S('jit'), lambda a, e: _jit_try(a[0], e))
|
||
d(S('jit-source'), lambda a, e: getattr(_jit_compile(a[0] if isinstance(a[0], CompiledProc) else bc_compile_proc(a[0], e)), '_jit_source', False) if isinstance(a[0], (Proc, CompiledProc)) else False)
|
||
d(S('disassemble'),lambda a, _: (print(_disassemble(a[0])) or VOID))
|
||
d(S('save-compiled'), lambda a, _: save_compiled(_str_val(a[0]), a[1]) or VOID)
|
||
d(S('load-compiled'), lambda a, e: load_compiled(_str_val(a[0]), e))
|
||
d(S('portal-save'), lambda a, _: portal_save(g, _str_val(a[0])) or VOID)
|
||
d(S('portal-resume'), lambda a, _: _portal_resume_builtin(_str_val(a[0]), g))
|
||
d(S('portal-checkpoint!'), lambda a, _: _portal_checkpoint.__setitem__(0, _str_val(a[0])) or VOID)
|
||
|
||
# ── Random (xoshiro256**) — portal-serialized across all three impls ────
|
||
d(S('random-seed!'), lambda a, _: _rng_seed(int(_num(a[0]))) or VOID)
|
||
d(S('random-seed-from-os!'), lambda a, _: _rng_seed_from_os() or VOID)
|
||
d(S('random'), lambda a, _: _rng_random_float())
|
||
d(S('random-int'), lambda a, _: _rng_random_int(int(_num(a[0]))))
|
||
d(S('random-state'), lambda a, _: _P(_rng_state_to_halves()))
|
||
d(S('random-state!'), lambda a, _: _rng_state_from_halves([int(_num(x)) for x in _L(a[0])]) or VOID)
|
||
|
||
def _portal_resume_builtin(path, env):
|
||
"""Resume from portal file, merging into current env."""
|
||
_, cont = portal_resume(path, env)
|
||
if cont is not None:
|
||
return _cont_resume(_ContInvoked(cont, VOID))
|
||
return VOID
|
||
def _auto_compile_fn(a, _):
|
||
if not a: return _auto_compile[0]
|
||
_auto_compile[0] = _truthy(a[0]); return VOID
|
||
d(S('auto-compile!'), _auto_compile_fn)
|
||
|
||
# Constants
|
||
d(S('pi'), math.pi)
|
||
d(S('e'), math.e)
|
||
d(S('else'), True)
|
||
d(S('...'), S('...'))
|
||
d(S('*version*'), '1.0.0')
|
||
d(S('*name*'), 'lumbda')
|
||
|
||
return g
|
||
|
||
###############################################################################
|
||
# Prelude (standard macros defined in Lisp)
|
||
###############################################################################
|
||
|
||
PRELUDE = r"""
|
||
(define-macro (when test . body)
|
||
`(if ,test (begin ,@body) (void)))
|
||
|
||
(define-macro (unless test . body)
|
||
`(if ,test (void) (begin ,@body)))
|
||
|
||
(define-macro (and . args)
|
||
(cond ((null? args) #t)
|
||
((null? (cdr args)) (car args))
|
||
(else `(if ,(car args) (and ,@(cdr args)) #f))))
|
||
|
||
(define-macro (or . args)
|
||
(cond ((null? args) #f)
|
||
((null? (cdr args)) (car args))
|
||
(else (let ((v (gensym)))
|
||
`(let ((,v ,(car args)))
|
||
(if ,v ,v (or ,@(cdr args))))))))
|
||
|
||
(define-macro (case key . clauses)
|
||
(let ((k (gensym)))
|
||
`(let ((,k ,key))
|
||
(cond ,@(map (lambda (c)
|
||
(if (eq? (car c) 'else)
|
||
(if (and (= (length c) 3) (eq? (cadr c) '=>))
|
||
`(else (,(caddr c) ,k))
|
||
c)
|
||
(if (and (= (length c) 3) (eq? (cadr c) '=>))
|
||
`((memv ,k ',(car c)) => (lambda (_) (,(caddr c) ,k)))
|
||
`((memv ,k ',(car c)) ,@(cdr c)))))
|
||
clauses)))))
|
||
|
||
(define-macro (while test . body)
|
||
(let ((loop (gensym)))
|
||
`(let ,loop ()
|
||
(when ,test ,@body (,loop)))))
|
||
|
||
(define-macro (for var lst . body)
|
||
`(for-each (lambda (,var) ,@body) ,lst))
|
||
|
||
; define-record-type is now a Python special form (supports (inherit parent))
|
||
|
||
(define (call-with-string-output-port proc)
|
||
(let ((port (open-output-string)))
|
||
(proc port)
|
||
(get-output-string port)))
|
||
|
||
(define (1+ n) (+ n 1))
|
||
(define (1- n) (- n 1))
|
||
(define (-1+ n) (- n 1))
|
||
(define (add1 n) (+ n 1))
|
||
(define (sub1 n) (- n 1))
|
||
|
||
(define (square x) (* x x))
|
||
(define (cube x) (* x x x))
|
||
|
||
(define (compose . fns)
|
||
(if (null? fns)
|
||
identity
|
||
(let ((fn (car fns))
|
||
(rest (apply compose (cdr fns))))
|
||
(lambda args (fn (apply rest args))))))
|
||
|
||
(define (atom? x) (not (pair? x)))
|
||
|
||
(define (flatten lst)
|
||
(cond ((null? lst) '())
|
||
((pair? (car lst)) (append (flatten (car lst)) (flatten (cdr lst))))
|
||
(else (cons (car lst) (flatten (cdr lst))))))
|
||
|
||
(define (range . args)
|
||
(cond ((= (length args) 1) (iota (car args)))
|
||
((= (length args) 2) (iota (- (cadr args) (car args)) (car args)))
|
||
((= (length args) 3) (iota (ceiling (/ (- (cadr args) (car args)) (caddr args)))
|
||
(car args) (caddr args)))
|
||
(else (error "range: wrong number of args"))))
|
||
|
||
(define (list-flatten lst)
|
||
(cond ((null? lst) '())
|
||
((pair? (car lst))
|
||
(append (list-flatten (car lst)) (list-flatten (cdr lst))))
|
||
(else (cons (car lst) (list-flatten (cdr lst))))))
|
||
|
||
(define (char-list->string chars)
|
||
(apply string chars))
|
||
|
||
(define (string-for-each f s)
|
||
(for-each f (string->list s)))
|
||
|
||
(define (string-map f s)
|
||
(list->string (map f (string->list s))))
|
||
|
||
(define (with-values thunk receiver)
|
||
(call-with-values thunk receiver))
|
||
|
||
(define (char->string c) (string c))
|
||
|
||
(define (boolean->string b) (if b "#t" "#f"))
|
||
|
||
(define (exact-integer? x) (and (integer? x) (exact? x)))
|
||
|
||
(define (assoc* key alist)
|
||
(cond ((null? alist) #f)
|
||
((equal? (caar alist) key) (car alist))
|
||
(else (assoc* key (cdr alist)))))
|
||
|
||
(define (alist-set! key val alist)
|
||
(let ((pair (assoc key alist)))
|
||
(if pair
|
||
(begin (set-cdr! pair val) alist)
|
||
(cons (cons key val) alist))))
|
||
|
||
(define-macro (trace name)
|
||
`(set! ,name (make-traced ,name ',name)))
|
||
|
||
(define-macro (untrace name)
|
||
`(set! ,name (untrace-proc ',name)))
|
||
"""
|
||
|
||
###############################################################################
|
||
# REPL
|
||
###############################################################################
|
||
|
||
def repl(env, prompt='λ> ', quiet=False):
|
||
if not quiet:
|
||
print(f'lumbda {env.lookup(S("*version*"))} '
|
||
f'— (exit) to quit, (load "file.lsp") to load')
|
||
buf = ''
|
||
while True:
|
||
try:
|
||
line = input(prompt if not buf else ' ')
|
||
except (EOFError, KeyboardInterrupt):
|
||
if buf:
|
||
buf = ''; print(); continue
|
||
print(); break
|
||
buf += line + '\n'
|
||
# Try parsing; if incomplete, keep reading
|
||
try:
|
||
exprs = read_all(buf)
|
||
except LispErr:
|
||
continue # keep accumulating
|
||
if not exprs:
|
||
buf = ''; continue
|
||
# Check for unbalanced parens by counting
|
||
depth = 0
|
||
for ch in buf:
|
||
if ch == '(': depth += 1
|
||
elif ch == ')': depth -= 1
|
||
if depth > 0:
|
||
continue # incomplete expression
|
||
for expr in exprs:
|
||
try:
|
||
result = leval(expr, env)
|
||
if result is not VOID:
|
||
print(show(result))
|
||
except LispErr as e:
|
||
loc = f' (line {e.source_line})' if e.source_line else ''
|
||
print(f'error{loc}: {e}', file=sys.stderr)
|
||
if e.call_stack:
|
||
print(f' in: {" → ".join(e.call_stack[-5:])}', file=sys.stderr)
|
||
except Exception as e:
|
||
print(f'python error: {e}', file=sys.stderr)
|
||
buf = ''
|
||
|
||
###############################################################################
|
||
# Main
|
||
###############################################################################
|
||
|
||
def main():
|
||
g = make_global_env()
|
||
# Load prelude
|
||
for expr in read_all(PRELUDE):
|
||
leval(expr, g)
|
||
|
||
args = sys.argv[1:]
|
||
|
||
# --help / -h
|
||
if '--help' in args or '-h' in args:
|
||
print('''lumbda — a Scheme in one Python file
|
||
|
||
Usage: lumbda [options] [script.lsp] [args...]
|
||
lumbda -e '(+ 1 2)'
|
||
lumbda (interactive REPL)
|
||
|
||
Options:
|
||
-e EXPR evaluate expression and print result
|
||
-f, --fast auto-compile all defines (bytecode VM, 7-19x faster)
|
||
-h, --help show this help
|
||
-v, --version show version
|
||
|
||
Features: R7RS core, bytecode compiler, full continuations, macros,
|
||
syntax-rules, modules, rationals, string ports, SRFI-1/2/8/64.''')
|
||
return
|
||
|
||
# --version / -v
|
||
if '--version' in args or '-v' in args:
|
||
print(f'lumbda 1.0.0'); return
|
||
|
||
# --fast / -f: enable auto-compile
|
||
if '--fast' in args or '-f' in args:
|
||
_auto_compile[0] = True
|
||
args = [a for a in args if a not in ('--fast', '-f')]
|
||
|
||
# --compile: precompile a .lsp file to .lspc
|
||
if '--compile' in args:
|
||
args = [a for a in args if a != '--compile']
|
||
if not args:
|
||
print('usage: lumbda --compile file.lsp', file=sys.stderr); sys.exit(1)
|
||
path = args[0]; out = path.rsplit('.', 1)[0] + '.lspc'
|
||
_auto_compile[0] = True
|
||
_load(path, g)
|
||
compiled = {k: v for k, v in g.b.items() if isinstance(v, CompiledProc)}
|
||
data = {'format': 'lspc-v1', 'procs': {
|
||
str(k): {'name': v.name, 'params': [str(p) for p in v.params],
|
||
'rest': str(v.rest) if v.rest else None,
|
||
'code': _serialize_code(v.code)}
|
||
for k, v in compiled.items()}}
|
||
with open(out, 'w') as f: _json.dump(data, f, separators=(',', ':'))
|
||
print(f'compiled {len(compiled)} procedures to {out}')
|
||
return
|
||
|
||
# --portal-resume: resume from a .portal file
|
||
if '--portal-resume' in args:
|
||
args = [a for a in args if a != '--portal-resume']
|
||
if not args:
|
||
print('usage: lumbda --portal-resume state.portal', file=sys.stderr); sys.exit(1)
|
||
path = args[0]
|
||
env, cont = portal_resume(path, g)
|
||
if cont is not None:
|
||
print(f'resuming from {path}...', file=sys.stderr)
|
||
try:
|
||
result = _cont_resume(_ContInvoked(cont, VOID))
|
||
if result is not VOID: print(show(result))
|
||
except LispErr as e:
|
||
print(f'error: {e}', file=sys.stderr); sys.exit(1)
|
||
else:
|
||
print(f'loaded state from {path} (no continuation to resume)', file=sys.stderr)
|
||
repl(env)
|
||
return
|
||
|
||
# -e 'expr' mode
|
||
if args and args[0] == '-e':
|
||
if len(args) < 2:
|
||
print('usage: lumbda -e <expression>', file=sys.stderr)
|
||
sys.exit(1)
|
||
for expr in read_all(args[1]):
|
||
result = leval(expr, g)
|
||
if result is not VOID:
|
||
print(show(result))
|
||
return
|
||
|
||
# Script mode
|
||
if args:
|
||
path = args[0]
|
||
g.define(S('*argv*'), _P(args[1:]))
|
||
try:
|
||
_load(path, g)
|
||
except LispErr as e:
|
||
print(f'error: {e}', file=sys.stderr); sys.exit(1)
|
||
except FileNotFoundError as e:
|
||
missing = e.filename if e.filename else path
|
||
print(f'file not found: {missing}', file=sys.stderr); sys.exit(1)
|
||
return
|
||
|
||
# REPL mode
|
||
repl(g)
|
||
|
||
if __name__ == '__main__':
|
||
main()
|