russell@unturf.com
1f2ef730a2
leval() in lumbda.py grows a counter-gated check (every 1024th iteration) that calls a module-level _lumbda_pause_hook. Native Python users leave the hook None and the check short-circuits to a single bitwise AND. The pyodide loader installs a hook that reads _lumbdaPyPauseRequested (a JS callback over Atomics.load on the SAB) so the REPL's auto-pause-on-tab-switch flow drops into the same path on python that it already uses on C. Also adds setPauseFlag to the python tier's returned object so runner.setPauseFlag propagates the SAB through worker config. repl.js's autoPauseTab no longer falls back to hard-cancel when the active tier is python — the SAB-poll path covers both. Asm remains on hard-cancel since the WAT tier has no in-eval poll site yet. Test suite (tests.py, 571 tests) passes — verified the no-op hook path doesn't change native eval semantics.
4402 lines
190 KiB
Python
4402 lines
190 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
|
||
|
||
|
||
# Cooperative pause hook — set to a zero-arg callable returning a
|
||
# truthy value when the eval loop should stop. The pyodide loader
|
||
# installs one that reads a SharedArrayBuffer atomic (see
|
||
# wasm/python/lumbda-py.js). Native Python users leave it None and
|
||
# the check below short-circuits to a counter increment.
|
||
_lumbda_pause_hook = None
|
||
_lumbda_pause_counter = 0
|
||
|
||
def leval(expr, env):
|
||
"""Evaluate expr in env. Tail-call safe via while loop."""
|
||
global _lumbda_pause_counter
|
||
while True:
|
||
_lumbda_pause_counter = (_lumbda_pause_counter + 1) & 0x7FFFFFFF
|
||
if not (_lumbda_pause_counter & 0x3FF) and _lumbda_pause_hook is not None:
|
||
if _lumbda_pause_hook():
|
||
raise LispErr("paused")
|
||
# 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', '_scope_depth', '_self_base')
|
||
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
|
||
# 2026-06-14 self-tail-call frame-unwind: tracks env-frame depth at
|
||
# compile time so OP_SELF_TAIL_CALL can pop accumulated let/let*/
|
||
# letrec/do frames before reusing our lambda body env. Without this
|
||
# a (let* (...) (loop ...)) inside (let loop ...) bloated env per
|
||
# iter — 156k-element walk hung > 5 min instead of completing in
|
||
# 1.4s. _self_base records depth at lambda body entry; _scope_depth
|
||
# is current depth; pops_needed = depth - base at tail call site.
|
||
self._scope_depth = 0
|
||
self._self_base = 0
|
||
def emit(self, op, arg=None):
|
||
# 2026-06-14 self-tail-call frame-unwind: track env-frame depth so
|
||
# OP_SELF_TAIL_CALL knows how many let/let*/letrec/do frames sit
|
||
# between us & our lambda body env.
|
||
if op == OP_PUSH_ENV: self._scope_depth += 1
|
||
elif op == OP_POP_ENV: self._scope_depth -= 1
|
||
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)
|
||
# 2026-06-14 frame-unwind: pop accumulated let/let*/letrec/do frames
|
||
# before we reuse our lambda body env. Without this each iter's
|
||
# let* frame stays on the env chain — env grows linearly with iters
|
||
# & every var lookup walks an O(n) chain → effective O(n^2).
|
||
pops_needed = code._scope_depth - code._self_base
|
||
code.emit(OP_SELF_TAIL_CALL, (len(call_args), tuple(params), pops_needed)); 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)
|
||
# 2026-06-14: record baseline depth after any internal-defines frame.
|
||
# Our self-tail-call unwind pops back to here, not all the way to 0.
|
||
inner._self_base = inner._scope_depth
|
||
_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:
|
||
# 2026-06-14: arg now (n_args, params, pops_needed). pops_needed
|
||
# unwinds accumulated let/let*/letrec/do frames before we reuse
|
||
# our lambda body env — otherwise self-tail-call from inside a
|
||
# let* bloats env per iter & every var lookup walks O(n) chain.
|
||
n, params, pops = arg
|
||
if n: args_ = stack[-n:]; del stack[-n:]
|
||
else: args_ = []
|
||
for _ in range(pops): env = env.p
|
||
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, pops_needed)
|
||
if len(val) == 3 and isinstance(val[0], int) and isinstance(val[1], tuple) and isinstance(val[2], int):
|
||
return {'t': 'stc', 'n': val[0], 'p': [str(p) for p in val[1]], 'pops': val[2]}
|
||
# Backwards-compat: pre-2026-06-14 portals have 2-tuple form.
|
||
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]], 'pops': 0}
|
||
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':
|
||
# 2026-06-14: stc now carries pops field; older portals (no pops) → 0.
|
||
return (data['n'], tuple(S(p) for p in data['p']), data.get('pops', 0))
|
||
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:
|
||
# arg is (n_args, params, pops_needed) since 2026-06-14
|
||
tc_n = arg[0]; tc_params = arg[1]
|
||
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])))
|
||
# R7RS: remainder has the sign of the dividend; uses truncated division.
|
||
# The previous impl did `signed_a % signed_b * sign(a)` which double-counted
|
||
# the sign of a (Python's % floors, so `-17 % 5 == 3`) and gave -3 for
|
||
# (-17, 5) instead of the correct -2. Use abs() on both sides, then re-sign.
|
||
d(S('remainder'), lambda a, _: (abs(int(_num(a[0]))) % abs(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()
|