russell@unturf.com
68c3d3a928
The previous Env.lookup had a shortcut that checked self.g (global) right after self.b (local). This skipped any intermediate parent frame that shadowed a global name. The concrete bug was a let-loop parameter named `count` (also a SRFI-1 builtin): when an inner (let ((next ...))) pushed a new frame between the loop body and the loop binding, `count` was not in self.b, the shortcut found the global builtin, and returned it — instead of walking up one more parent to the loop's parameter frame. Fix: remove the shortcut, walk self → self.p → ... → global in order. O(chain depth) instead of O(1) for the common case, but correct. Chain depths are small in practice. The inline cache (bytecode VM's OP_LOOKUP) had the mirror issue — it verified only `arg not in env.b`, missing parent shadows. Updated to walk the chain from env up to the cached env (always global) and check each intermediate frame before returning the cached value. The cache still reads the value fresh from the cached env's bindings dict so `set!` on a global is observed immediately (previously a cached value would go stale on set! even though the test suite's test_compile_mutual_recursion depended on this behavior). Cache is now populated only when the lookup resolved identity- equal to the global's current binding — i.e. no intermediate shadow — using `val is g.b[arg]` as the guard. Regression: all 975 tests still green (571 py + 132 asm + 189 shared + 83 c), including test_compile_mutual_recursion that exercises set!-after-compile. Discovered while debugging portal-http-client.lsp, where the portal body's (define counter ...) form landed correctly but a nearby let-loop accumulator named `count` resolved to the Python builtin `count` (SRFI-1 count procedure). The server itself, and asm and C clients, were unaffected — asm's env lookup walks the chain, and C's env lookup has no equivalent shortcut.
3767 lines
165 KiB
Python
3767 lines
165 KiB
Python
#!/usr/bin/env python3
|
|
"""
|
|
uncommonlisp — a Lisp in one Python file.
|
|
Usage: python3 uncommonlisp.py [script.lsp] # run a file
|
|
python3 uncommonlisp.py # interactive REPL
|
|
python3 uncommonlisp.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'))
|
|
for conv in (int, float):
|
|
try: return conv(t)
|
|
except (ValueError, OverflowError): pass
|
|
if t == '+inf.0': return math.inf
|
|
if t == '-inf.0': return -math.inf
|
|
if t in ('+nan.0', '-nan.0'): return float('nan')
|
|
# Rational literal n/d (e.g. 1/3, -2/5)
|
|
if re.fullmatch(r'-?\d+/-?\d+', t):
|
|
try:
|
|
f = Fraction(t)
|
|
return f if f.denominator != 1 else f.numerator
|
|
except (ValueError, ZeroDivisionError): pass
|
|
return S(t)
|
|
|
|
def read_all(src, track_lines=False):
|
|
toks = _tokenize_lines(src) if track_lines else _tokenize(src)
|
|
exprs = []; i = 0
|
|
while i < len(toks): e, i = _read(toks, i); exprs.append(e)
|
|
return exprs
|
|
|
|
###############################################################################
|
|
# Helpers
|
|
###############################################################################
|
|
|
|
def _L(x):
|
|
"""Lisp list → Python list (validates proper list)."""
|
|
if x is NIL: return []
|
|
if isinstance(x, Pair): return list(x)
|
|
raise LispErr(f'not a list: {show(x)}')
|
|
|
|
def _P(lst):
|
|
"""Python list → Lisp list."""
|
|
r = NIL
|
|
for x in reversed(lst): r = Pair(x, r)
|
|
return r
|
|
|
|
def _truthy(x): return x is not False
|
|
|
|
def _formals(f):
|
|
"""Parse lambda formals → (params: [Symbol], rest: Symbol|None)."""
|
|
if isinstance(f, Symbol): return [], f
|
|
if f is NIL: return [], None
|
|
ps = []; n = f
|
|
while isinstance(n, Pair):
|
|
if not isinstance(n.car, Symbol):
|
|
raise LispErr(f'param must be symbol: {show(n.car)}')
|
|
ps.append(n.car); n = n.cdr
|
|
if n is NIL: return ps, None
|
|
if not isinstance(n, Symbol): raise LispErr(f'rest param must be symbol: {show(n)}')
|
|
return ps, n
|
|
|
|
def _raise(e): raise e
|
|
|
|
def _body_env(forms, env):
|
|
"""Implement R7RS letrec* semantics for body internal defines.
|
|
Scans leading (define ...) forms, pre-declares all names as VOID in env,
|
|
returns the full form list unchanged (defines are re-evaluated sequentially).
|
|
This allows mutual recursion: both names exist before either body runs.
|
|
Short-circuits immediately when first form is not a define (common case)."""
|
|
# Fast path: no internal defines
|
|
if not forms: return forms
|
|
if not (isinstance(forms[0], Pair) and (forms[0].car is S('define') or forms[0].car is S('begin'))):
|
|
return forms
|
|
i = 0
|
|
while i < len(forms):
|
|
f = forms[i]
|
|
if isinstance(f, Pair) and f.car is S('define'):
|
|
a = _L(f.cdr)
|
|
name = a[0].car if isinstance(a[0], Pair) else a[0]
|
|
if isinstance(name, Symbol): env.define(name, VOID)
|
|
i += 1
|
|
elif isinstance(f, Pair) and f.car is S('begin'):
|
|
# Splice top-level begin (R7RS splicing begin in body)
|
|
spliced = _L(f.cdr)
|
|
forms = list(forms[:i]) + spliced + list(forms[i+1:])
|
|
else:
|
|
break
|
|
return forms
|
|
|
|
###############################################################################
|
|
# Environment
|
|
###############################################################################
|
|
|
|
class Env:
|
|
__slots__ = ('b', 'p', 'g')
|
|
def __init__(self, parent=None):
|
|
self.b = {}; self.p = parent
|
|
self.g = parent.g if parent else None # global env shortcut
|
|
|
|
def lookup(self, k):
|
|
# Walk local → parents → global. Previously there was a
|
|
# shortcut that checked self.g (global) right after self.b
|
|
# (local), which skipped any intermediate parent frame that
|
|
# shadowed a global name. That broke e.g. a let-loop named
|
|
# `count` (a SRFI-1 builtin) when an inner `(let ((next ...)))`
|
|
# pushed a new frame between the loop body and the loop
|
|
# binding: self.b lacked `count`, global had the builtin, and
|
|
# the shortcut returned the builtin instead of walking up to
|
|
# the parent frame that held the loop parameter.
|
|
e = self
|
|
while e is not None:
|
|
b = e.b
|
|
if k in b: return b[k]
|
|
e = e.p
|
|
raise LispErr(f'undefined: {k}')
|
|
|
|
def define(self, k, v): self.b[k] = v
|
|
|
|
def set(self, k, v):
|
|
e = self
|
|
while e:
|
|
if k in e.b: e.b[k] = v; return
|
|
e = e.p
|
|
raise LispErr(f"set! undefined: {k}")
|
|
|
|
def child(self, params, rest, args):
|
|
n = len(params)
|
|
if len(args) < n:
|
|
raise LispErr(f'arity: need {n}, got {len(args)}')
|
|
if rest is None and len(args) > n:
|
|
raise LispErr(f'arity: need {n}, got {len(args)}')
|
|
c = Env(self)
|
|
for p, a in zip(params, args): c.b[p] = a
|
|
if rest is not None: c.b[rest] = _P(args[n:])
|
|
return c
|
|
|
|
|
|
def _deep_copy_env(env):
|
|
"""Deep-copy env chain up to (but not including) the global env.
|
|
Global env (builtins) is shared. Returns a fresh chain for multi-shot continuations."""
|
|
if env is None: return None
|
|
g = env.g
|
|
if env is g: return env # don't copy global env
|
|
new = Env.__new__(Env)
|
|
new.b = dict(env.b)
|
|
new.g = g
|
|
new.p = _deep_copy_env(env.p)
|
|
return new
|
|
|
|
###############################################################################
|
|
# Quasiquote expander
|
|
###############################################################################
|
|
|
|
def _qq(tmpl, env, depth=0):
|
|
if not isinstance(tmpl, Pair): return tmpl
|
|
if tmpl.car is S('quasiquote'):
|
|
return Pair(S('quasiquote'), Pair(_qq(tmpl.cdr.car, env, depth + 1), NIL))
|
|
if tmpl.car is S('unquote'):
|
|
if depth == 0: return leval(tmpl.cdr.car, env)
|
|
return Pair(S('unquote'), Pair(_qq(tmpl.cdr.car, env, depth - 1), NIL))
|
|
parts = []; n = tmpl
|
|
while isinstance(n, Pair):
|
|
item = n.car
|
|
if isinstance(item, Pair) and item.car is S('unquote-splicing'):
|
|
if depth == 0:
|
|
parts.extend(_L(leval(item.cdr.car, env)))
|
|
else:
|
|
parts.append(Pair(S('unquote-splicing'),
|
|
Pair(_qq(item.cdr.car, env, depth - 1), NIL)))
|
|
else:
|
|
parts.append(_qq(item, env, depth))
|
|
n = n.cdr
|
|
tail = _qq(n, env, depth) if n is not NIL else NIL
|
|
r = tail
|
|
for p in reversed(parts): r = Pair(p, r)
|
|
return r
|
|
|
|
###############################################################################
|
|
# Evaluator (TCO via explicit loop)
|
|
###############################################################################
|
|
|
|
def _define_record_type(a, env):
|
|
"""Implement (define-record-type name [(inherit parent)] ctor pred slot...)
|
|
Representation: (tag field...) as a Lisp list.
|
|
(inherit parent) establishes the subtype relationship so parent? is true
|
|
of child instances. The child ctor lists ALL fields it stores (not auto-inherited).
|
|
Parent accessors work on child instances when child preserves parent's field layout."""
|
|
name = a[0]
|
|
rest = a[1:]
|
|
|
|
# Check for (inherit parent) clause
|
|
parent_name = None
|
|
if rest and isinstance(rest[0], Pair) and rest[0].car is S('inherit'):
|
|
parent_name = str(_L(rest[0])[1])
|
|
rest = rest[1:]
|
|
|
|
# ctor-spec: (constructor field-name...)
|
|
ctor_spec = _L(rest[0])
|
|
ctor_name = ctor_spec[0]
|
|
all_fields = [str(s) for s in ctor_spec[1:]]
|
|
field_map = {f: i for i, f in enumerate(all_fields)} # MOAD-0001: O(1) field lookup
|
|
pred_name = rest[1]
|
|
slot_specs = [_L(s) for s in rest[2:]]
|
|
|
|
# Register in type registry (for subtype checks)
|
|
_record_types[str(name)] = {'fields': all_fields, 'parent': parent_name}
|
|
|
|
# Constructor: produces (name field1 field2 ...)
|
|
tag = Pair(S('quote'), Pair(name, NIL))
|
|
all_syms = [S(f) for f in all_fields]
|
|
ctor_body = Pair(S('list'), Pair(tag, _P(all_syms)))
|
|
ctor_proc = Proc(all_syms, None, [ctor_body], env, name=str(ctor_name))
|
|
env.define(ctor_name, ctor_proc)
|
|
|
|
# Predicate: true if instance's type tag is `name` or a subtype of `name`
|
|
def _is_subtype(child_tag, ancestor):
|
|
"""Is child_tag equal to or a descendant of ancestor?"""
|
|
if child_tag == ancestor: return True
|
|
rt = _record_types.get(child_tag)
|
|
while rt and rt['parent']:
|
|
if rt['parent'] == ancestor: return True
|
|
rt = _record_types.get(rt['parent'])
|
|
return False
|
|
|
|
def _make_pred(type_name):
|
|
sname = str(type_name)
|
|
def pred(args, _env):
|
|
x = args[0]
|
|
if not isinstance(x, Pair): return False
|
|
t = x.car
|
|
return isinstance(t, Symbol) and _is_subtype(str(t), sname)
|
|
return pred
|
|
env.define(pred_name, _make_pred(name))
|
|
|
|
# Accessors / mutators: each slot spec is (field-name getter) or (field-name getter setter)
|
|
# field-name in the spec is the slot identity tag (for documentation); getter/setter are names
|
|
for spec in slot_specs:
|
|
field_tag = spec[0]
|
|
getter_name = spec[1]
|
|
setter_name = spec[2] if len(spec) > 2 else None
|
|
field_str = str(field_tag)
|
|
if field_str not in field_map: # MOAD-0001: O(1) lookup via dict
|
|
raise LispErr(f'define-record-type {name}: field {field_str!r} not in {all_fields}')
|
|
idx = field_map[field_str] + 1 # +1 to skip type tag
|
|
|
|
def _make_getter(i):
|
|
def getter_fn(args, _):
|
|
lst = args[0]
|
|
for _ in range(i): lst = _pair_val(lst).cdr
|
|
return _pair_val(lst).car
|
|
return getter_fn
|
|
|
|
def _make_setter(i):
|
|
def setter_fn(args, _):
|
|
lst = args[0]
|
|
for _ in range(i - 1): lst = _pair_val(lst).cdr
|
|
lst.cdr.car = args[1]
|
|
return VOID
|
|
return setter_fn
|
|
|
|
env.define(getter_name, _make_getter(idx))
|
|
if setter_name:
|
|
env.define(setter_name, _make_setter(idx))
|
|
|
|
return VOID
|
|
|
|
|
|
def leval(expr, env):
|
|
"""Evaluate expr in env. Tail-call safe via while loop."""
|
|
while True:
|
|
# Self-evaluating atoms
|
|
if (expr is NIL or expr is VOID or expr is True or expr is False
|
|
or isinstance(expr, (int, float, _EOF, list))
|
|
or (isinstance(expr, str) and not isinstance(expr, Symbol))):
|
|
return expr
|
|
|
|
# Symbol lookup
|
|
if isinstance(expr, Symbol):
|
|
return env.lookup(expr)
|
|
|
|
if not isinstance(expr, Pair):
|
|
return expr
|
|
|
|
head = expr.car
|
|
tail = expr.cdr # unevaluated args as Lisp list
|
|
|
|
# ── Special forms ────────────────────────────────────────────────────
|
|
|
|
if head is S('quote'):
|
|
return tail.car
|
|
|
|
if head is S('if'):
|
|
a = _L(tail)
|
|
if not 2 <= len(a) <= 3: raise LispErr('if: need 2-3 subforms')
|
|
expr = a[1] if _truthy(leval(a[0], env)) else (a[2] if len(a) == 3 else VOID)
|
|
continue
|
|
|
|
if head is S('cond'):
|
|
result = VOID
|
|
for cl in _L(tail):
|
|
cl = _L(cl)
|
|
if not cl: raise LispErr('cond: empty clause')
|
|
if cl[0] is S('else') or _truthy(leval(cl[0], env)):
|
|
if len(cl) == 1:
|
|
result = leval(cl[0], env) if cl[0] is not S('else') else VOID
|
|
break
|
|
if len(cl) == 3 and cl[1] is S('=>'):
|
|
v = leval(cl[0], env); f = leval(cl[2], env)
|
|
if isinstance(f, Proc):
|
|
env = f.env.child(f.params, f.rest, [v])
|
|
expr = Pair(S('begin'), _P(f.body)); break
|
|
return f([v], env)
|
|
for e in cl[1:-1]: leval(e, env)
|
|
expr = cl[-1]; break
|
|
else:
|
|
return result
|
|
continue
|
|
|
|
if head is S('and'):
|
|
a = _L(tail)
|
|
if not a: return True
|
|
for e in a[:-1]:
|
|
v = leval(e, env)
|
|
if not _truthy(v): return False
|
|
expr = a[-1]; continue
|
|
|
|
if head is S('or'):
|
|
a = _L(tail)
|
|
if not a: return False
|
|
for e in a[:-1]:
|
|
v = leval(e, env)
|
|
if _truthy(v): return v
|
|
expr = a[-1]; continue
|
|
|
|
if head is S('when'):
|
|
a = _L(tail)
|
|
if _truthy(leval(a[0], env)):
|
|
for e in a[1:-1]: leval(e, env)
|
|
expr = a[-1]; continue
|
|
return VOID
|
|
|
|
if head is S('unless'):
|
|
a = _L(tail)
|
|
if not _truthy(leval(a[0], env)):
|
|
for e in a[1:-1]: leval(e, env)
|
|
expr = a[-1]; continue
|
|
return VOID
|
|
|
|
if head is S('begin'):
|
|
a = _L(tail)
|
|
if not a: return VOID
|
|
for e in a[:-1]: leval(e, env)
|
|
expr = a[-1]; continue
|
|
|
|
if head is S('define'):
|
|
a = _L(tail)
|
|
if not a: raise LispErr('define: empty')
|
|
if isinstance(a[0], Pair): # (define (f x) body...)
|
|
fname = a[0].car; ps, rest = _formals(a[0].cdr)
|
|
p = Proc(ps, rest, a[1:], env, name=str(fname))
|
|
if _auto_compile[0]:
|
|
try: p = bc_compile_proc(p, env)
|
|
except Exception: pass
|
|
env.define(fname, p)
|
|
else:
|
|
name = a[0]
|
|
if not isinstance(name, Symbol): raise LispErr(f'define: name must be symbol, got {show(name)}')
|
|
val = leval(a[1], env) if len(a) > 1 else VOID
|
|
if isinstance(val, Proc) and not val.name: val.name = str(name)
|
|
if _auto_compile[0] and isinstance(val, Proc):
|
|
try: val = bc_compile_proc(val, env)
|
|
except Exception: pass
|
|
env.define(name, val)
|
|
return VOID
|
|
|
|
if head is S('define-values'):
|
|
a = _L(tail); names = _L(a[0])
|
|
vals = leval(a[1], env)
|
|
vs = list(vals) if isinstance(vals, tuple) else [vals]
|
|
for n, v in zip(names, vs): env.define(n, v)
|
|
return VOID
|
|
|
|
if head is S('set!'):
|
|
a = _L(tail); env.set(a[0], leval(a[1], env)); return VOID
|
|
|
|
if head is S('lambda') or head is S('λ'):
|
|
a = _L(tail)
|
|
if not a: raise LispErr('lambda: empty')
|
|
ps, rest = _formals(a[0])
|
|
p = Proc(ps, rest, a[1:], env)
|
|
if _auto_compile[0]:
|
|
try: p = bc_compile_proc(p, env)
|
|
except Exception: pass
|
|
return p
|
|
|
|
if head is S('let'):
|
|
a = _L(tail)
|
|
if not a: raise LispErr('let: empty')
|
|
if isinstance(a[0], Symbol): # named let
|
|
name = a[0]; binds = _L(a[1]); body = a[2:]
|
|
bps = [_L(b)[0] for b in binds]
|
|
bvs = [leval(_L(b)[1], env) for b in binds]
|
|
c = Env(env)
|
|
p = Proc(bps, None, body, c, name=str(name))
|
|
c.define(name, p)
|
|
env = c.child(bps, None, bvs)
|
|
if _has_internal_defines(body): body = _body_env(body, env)
|
|
expr = Pair(S('begin'), _P(body)); continue
|
|
binds = _L(a[0]); body = a[1:]
|
|
c = Env(env)
|
|
for b in binds:
|
|
bp = _L(b); c.define(bp[0], leval(bp[1], env))
|
|
env = c
|
|
if _has_internal_defines(body): body = _body_env(body, env)
|
|
expr = Pair(S('begin'), _P(body)); continue
|
|
|
|
if head is S('let*'):
|
|
a = _L(tail)
|
|
c = Env(env)
|
|
for b in _L(a[0]):
|
|
bp = _L(b); c.define(bp[0], leval(bp[1], c))
|
|
body = a[1:]
|
|
if _has_internal_defines(body): body = _body_env(body, c)
|
|
env = c; expr = Pair(S('begin'), _P(body)); continue
|
|
|
|
if head is S('letrec') or head is S('letrec*'):
|
|
a = _L(tail); binds = _L(a[0])
|
|
c = Env(env)
|
|
for b in binds: c.define(_L(b)[0], VOID)
|
|
for b in binds:
|
|
bp = _L(b); c.set(bp[0], leval(bp[1], c))
|
|
body = a[1:]
|
|
if _has_internal_defines(body): body = _body_env(body, c)
|
|
env = c; expr = Pair(S('begin'), _P(body)); continue
|
|
|
|
if head is S('let-values'):
|
|
a = _L(tail); binds = _L(a[0]); body = a[1:]
|
|
c = Env(env)
|
|
for bind in binds:
|
|
bp = _L(bind); formals = bp[0]; val = leval(bp[1], env)
|
|
vs = list(val) if isinstance(val, tuple) else [val]
|
|
fmls = _L(formals) if isinstance(formals, Pair) else ([formals] if isinstance(formals, Symbol) else [])
|
|
for name, v in zip(fmls, vs): c.define(name, v)
|
|
body2 = _body_env(body, c) if _has_internal_defines(body) else body
|
|
env = c; expr = Pair(S('begin'), _P(body2)); continue
|
|
|
|
if head is S('let*-values'):
|
|
a = _L(tail); binds = _L(a[0]); body = a[1:]
|
|
c = Env(env)
|
|
for bind in binds:
|
|
bp = _L(bind); formals = bp[0]; val = leval(bp[1], c)
|
|
vs = list(val) if isinstance(val, tuple) else [val]
|
|
fmls = _L(formals) if isinstance(formals, Pair) else ([formals] if isinstance(formals, Symbol) else [])
|
|
for name, v in zip(fmls, vs): c.define(name, v)
|
|
body2 = _body_env(body, c) if _has_internal_defines(body) else body
|
|
env = c; expr = Pair(S('begin'), _P(body2)); continue
|
|
|
|
if head is S('do'):
|
|
a = _L(tail)
|
|
vcs = _L(a[0]); term = _L(a[1]); body = a[2:]
|
|
c = Env(env)
|
|
specs = [_L(vc) for vc in vcs]
|
|
for sp in specs: c.define(sp[0], leval(sp[1], env))
|
|
steps = [sp[2] if len(sp) > 2 else sp[0] for sp in specs]
|
|
while True:
|
|
if _truthy(leval(term[0], c)):
|
|
if len(term) == 1: return VOID
|
|
for e in term[1:-1]: leval(e, c)
|
|
expr = term[-1]; env = c; break
|
|
for b in body: leval(b, c)
|
|
nvs = [leval(s, c) for s in steps]
|
|
for sp, nv in zip(specs, nvs): c.set(sp[0], nv)
|
|
continue
|
|
|
|
if head is S('quasiquote'):
|
|
return _qq(tail.car, env)
|
|
|
|
if head is S('define-macro') or head is S('defmacro'):
|
|
a = _L(tail)
|
|
if isinstance(a[0], Pair): # (define-macro (name params...) body...)
|
|
name = a[0].car; ps, rest = _formals(a[0].cdr)
|
|
body = a[1:]
|
|
else: # (define-macro name (params...) body...)
|
|
name = a[0]; ps, rest = _formals(a[1])
|
|
body = a[2:]
|
|
xfm = Proc(ps, rest, body, env, name=str(name))
|
|
env.define(name, Macro(xfm)); return VOID
|
|
|
|
if head is S('define-syntax'):
|
|
a = _L(tail)
|
|
val = leval(a[1], env)
|
|
if isinstance(val, _SyntaxTransformer):
|
|
env.define(a[0], Macro(val))
|
|
else:
|
|
env.define(a[0], val)
|
|
return VOID
|
|
|
|
if head is S('let-syntax'):
|
|
a = _L(tail); body = a[1:]
|
|
c = Env(env)
|
|
for b in _L(a[0]):
|
|
bp = _L(b); c.define(bp[0], Macro(leval(bp[1], env)))
|
|
env = c; expr = Pair(S('begin'), _P(body)); continue
|
|
|
|
if head is S('letrec-syntax'):
|
|
a = _L(tail); body = a[1:]
|
|
c = Env(env)
|
|
for b in _L(a[0]):
|
|
bp = _L(b); c.define(bp[0], Macro(leval(bp[1], c)))
|
|
env = c; expr = Pair(S('begin'), _P(body)); continue
|
|
|
|
if head is S('syntax-rules'):
|
|
a = _L(tail)
|
|
return _SyntaxTransformer(a[0], _P(a[1:]), env)
|
|
|
|
if head is S('values'):
|
|
vals = [leval(e, env) for e in _L(tail)]
|
|
return vals[0] if len(vals) == 1 else tuple(vals)
|
|
|
|
if head is S('call-with-values'):
|
|
a = _L(tail)
|
|
prod = leval(a[0], env); cons_ = leval(a[1], env)
|
|
r = _call(prod, [], env)
|
|
args = list(r) if isinstance(r, tuple) else [r]
|
|
return _call(cons_, args, env)
|
|
|
|
if head is S('call/cc') or head is S('call-with-current-continuation'):
|
|
a = _L(tail); proc = leval(a[0], env)
|
|
class Escape(Exception):
|
|
def __init__(self, v): self.v = v
|
|
def kont(args, _env): raise Escape(args[0] if args else VOID)
|
|
try: return _call(proc, [kont], env)
|
|
except Escape as e: return e.v
|
|
|
|
if head is S('apply'):
|
|
a = _L(tail)
|
|
proc = leval(a[0], env)
|
|
pre = [leval(x, env) for x in a[1:-1]]
|
|
last = leval(a[-1], env)
|
|
args = pre + _L(last)
|
|
if isinstance(proc, Proc):
|
|
env = proc.env.child(proc.params, proc.rest, args)
|
|
body = _body_env(proc.body, env) if proc.has_defs else proc.body
|
|
if len(body) == 1: expr = body[0]
|
|
else: expr = Pair(S('begin'), _P(body))
|
|
continue
|
|
if callable(proc): return proc(args, env)
|
|
raise LispErr(f'apply: not callable: {show(proc)}')
|
|
|
|
if head is S('eval'):
|
|
# Evaluate the argument in the current env (so the caller can
|
|
# pass a local expression), but evaluate the RESULT in the
|
|
# global env. This matches asm's bi_eval and lets portal
|
|
# resume — (eval (read-from-string ...)) — install bindings
|
|
# that outlive the evaluating function.
|
|
a = _L(tail); expr = leval(a[0], env); env = env.g; continue
|
|
|
|
if head is S('error'):
|
|
a = _L(tail)
|
|
msg = show(leval(a[0], env), display=True)
|
|
irr = [leval(x, env) for x in a[1:]]
|
|
obj = ErrorObject(msg, irr)
|
|
raise LispErr(str(obj), obj=obj)
|
|
|
|
if head is S('define-record-type'):
|
|
return _define_record_type(_L(tail), env)
|
|
|
|
if head is S('module'):
|
|
# (module name (export sym ...) body...)
|
|
a = _L(tail)
|
|
mod_name = str(a[0])
|
|
export_list = _L(a[1]) if isinstance(a[1], Pair) and a[1].car is S('export') else []
|
|
explicit_exports = [str(s) for s in export_list[1:]] if export_list else []
|
|
body = a[2:]
|
|
mod_env = Env(env)
|
|
for e in body[:-1]: leval(e, mod_env)
|
|
if body: leval(body[-1], mod_env)
|
|
exports = explicit_exports if explicit_exports else list(mod_env.b.keys())
|
|
_modules[mod_name] = mod_env
|
|
_mod_exports[mod_name] = exports
|
|
return VOID
|
|
|
|
if head is S('import'):
|
|
# (import module-name) or (import (module-name sym ...))
|
|
for spec in _L(tail):
|
|
if isinstance(spec, Symbol):
|
|
name = str(spec)
|
|
if name not in _modules: raise LispErr(f'import: unknown module: {name}')
|
|
mod = _modules[name]
|
|
for k in _mod_exports.get(name, list(mod.b.keys())):
|
|
if k in mod.b: env.define(S(k), mod.b[k])
|
|
elif isinstance(spec, Pair):
|
|
items = _L(spec)
|
|
name = str(items[0])
|
|
if name not in _modules: raise LispErr(f'import: unknown module: {name}')
|
|
mod = _modules[name]
|
|
syms = [str(s) for s in items[1:]] if len(items) > 1 else _mod_exports.get(name, list(mod.b.keys()))
|
|
for k in syms:
|
|
if k in mod.b: env.define(S(k), mod.b[k])
|
|
else: raise LispErr(f'import: {name} has no export: {k}')
|
|
return VOID
|
|
|
|
if head is S('load'):
|
|
a = _L(tail); _load(leval(a[0], env), env); return VOID
|
|
|
|
if head is S('include'):
|
|
for path_expr in _L(tail):
|
|
_load(show(leval(path_expr, env), display=True), env)
|
|
return VOID
|
|
|
|
if head is S('parameterize'):
|
|
a = _L(tail); binds = _L(a[0]); body = a[1:]
|
|
params_new = [(leval(_L(bp)[0], env), leval(_L(bp)[1], env)) for bp in binds]
|
|
saved = [(p, _call(p, [], env)) for p, _ in params_new]
|
|
for p, nv in params_new: _call(p, [nv], env)
|
|
try:
|
|
for e in body[:-1]: leval(e, env)
|
|
return leval(body[-1], env)
|
|
finally:
|
|
for p, ov in saved: _call(p, [ov], env)
|
|
|
|
if head is S('dynamic-wind'):
|
|
a = _L(tail)
|
|
before = leval(a[0], env); thunk = leval(a[1], env); after = leval(a[2], env)
|
|
_call(before, [], env)
|
|
try: r = _call(thunk, [], env)
|
|
finally: _call(after, [], env)
|
|
return r
|
|
|
|
if head is S('with-exception-handler'):
|
|
a = _L(tail)
|
|
handler = leval(a[0], env); thunk = leval(a[1], env)
|
|
try: return _call(thunk, [], env)
|
|
except LispErr as e: return _call(handler, [e.obj if e.obj else str(e)], env)
|
|
except Exception as e: return _call(handler, [str(e)], env)
|
|
|
|
if head is S('guard'):
|
|
a = _L(tail); var_clauses = _L(a[0]); body = a[1:]
|
|
var = var_clauses[0]; clauses = var_clauses[1:]
|
|
try:
|
|
for e in body[:-1]: leval(e, env)
|
|
return leval(body[-1], env)
|
|
except LispErr as exc:
|
|
c = Env(env); c.define(var, exc.obj if exc.obj else str(exc))
|
|
for cl in clauses:
|
|
cl = _L(cl)
|
|
if cl[0] is S('else') or _truthy(leval(cl[0], c)):
|
|
for e in cl[1:-1]: leval(e, c)
|
|
return leval(cl[-1], c)
|
|
raise
|
|
|
|
# ── Macro expansion ──────────────────────────────────────────────────
|
|
hval = leval(head, env)
|
|
if isinstance(hval, Macro):
|
|
expr = _call(hval.xfm, _L(tail), env); continue
|
|
|
|
# ── Procedure application ────────────────────────────────────────────
|
|
proc = hval
|
|
args = [leval(a, env) for a in _L(tail)]
|
|
|
|
if isinstance(proc, CompiledProc):
|
|
try:
|
|
return vm_exec(proc.code,
|
|
proc.env.child(proc.params, proc.rest, args))
|
|
except _ContInvoked as ci:
|
|
if _vm_depth[0] > 0: raise
|
|
return _cont_resume(ci)
|
|
|
|
if isinstance(proc, Proc):
|
|
env = proc.env.child(proc.params, proc.rest, args)
|
|
body = _body_env(proc.body, env) if proc.has_defs else proc.body
|
|
if len(body) == 1: expr = body[0]
|
|
else: expr = Pair(S('begin'), _P(body))
|
|
continue
|
|
|
|
if callable(proc):
|
|
try: return proc(args, env)
|
|
except _ContInvoked as ci:
|
|
if _vm_depth[0] > 0: raise
|
|
return _cont_resume(ci)
|
|
|
|
raise LispErr(f'not callable: {show(proc)}')
|
|
|
|
|
|
def _cont_resume(ci):
|
|
"""Resume an escaped continuation (multi-shot safe: deep-copies env)."""
|
|
c = ci.cont
|
|
frames = [(i, p, _deep_copy_env(e), list(s)) for i, p, e, s in c.frames]
|
|
stack = list(c.stack); stack.append(ci.val)
|
|
env = _deep_copy_env(c.env)
|
|
try:
|
|
return _vm_loop(c.instrs, c.ip, stack, env, frames, c.vm_id)
|
|
except _ContInvoked as ci2:
|
|
return _cont_resume(ci2)
|
|
|
|
def _call(proc, args, env):
|
|
"""Non-tail recursive call (for use inside builtins)."""
|
|
if isinstance(proc, CompiledProc):
|
|
try:
|
|
return vm_exec(proc.code,
|
|
proc.env.child(proc.params, proc.rest, args))
|
|
except _ContInvoked as ci:
|
|
if _vm_depth[0] > 0: raise
|
|
return _cont_resume(ci)
|
|
if isinstance(proc, Proc):
|
|
c = proc.env.child(proc.params, proc.rest, args)
|
|
body = _body_env(proc.body, c) if proc.has_defs else proc.body
|
|
frame = proc.name or 'λ'
|
|
_call_stack.append(frame)
|
|
try:
|
|
for e in body[:-1]: leval(e, c)
|
|
return leval(body[-1], c)
|
|
finally:
|
|
if _call_stack: _call_stack.pop()
|
|
if callable(proc): return proc(args, env)
|
|
raise LispErr(f'not callable: {show(proc)}')
|
|
|
|
|
|
def _load(path, env):
|
|
try:
|
|
with open(path) as f:
|
|
src = f.read()
|
|
except UnicodeDecodeError:
|
|
raise LispErr(f'{path}: not a text file (binary data encountered)')
|
|
for expr in read_all(src, track_lines=True): leval(expr, env)
|
|
|
|
###############################################################################
|
|
# Bytecode Compiler & VM
|
|
###############################################################################
|
|
|
|
# Opcodes
|
|
OP_CONST = 0; OP_LOOKUP = 1; OP_SET = 2; OP_DEFINE = 3
|
|
OP_POP = 4; OP_DUP = 5; OP_VOID = 6
|
|
OP_JUMP = 10; OP_JUMP_IF_FALSE = 11
|
|
OP_JUMP_IF_FALSE_KEEP = 12 # and: if falsy keep & jump, else pop
|
|
OP_JUMP_IF_TRUE_KEEP = 13 # or: if truthy keep & jump, else pop
|
|
OP_CALL = 20; OP_TAIL_CALL = 21; OP_RETURN = 22
|
|
OP_MAKE_CLOSURE = 30
|
|
OP_PUSH_ENV = 40; OP_POP_ENV = 41; OP_BIND = 42
|
|
OP_EVAL = 50 # fallback to tree-walker
|
|
OP_CALL_CC = 51 # call/cc
|
|
# Specialized opcodes (avoid LOOKUP+CALL for hot builtins)
|
|
OP_ADD = 60; OP_SUB = 61; OP_MUL = 62; OP_NEG = 63
|
|
OP_NUM_EQ = 64; OP_LT = 65; OP_GT = 66; OP_LE = 67; OP_GE = 68
|
|
OP_ADD1 = 69; OP_SUB1 = 70
|
|
OP_CAR = 71; OP_CDR = 72; OP_CONS = 73
|
|
OP_NULL_P = 74; OP_PAIR_P = 75; OP_NOT = 76; OP_ZERO_P = 77
|
|
OP_VEC_REF = 78; OP_VEC_SET = 79
|
|
# Superinstructions (fused opcode pairs for hot paths)
|
|
OP_LOOK_LOOK = 80 # push two lookups: arg = (sym1, sym2)
|
|
OP_LOOK_ADD1 = 81 # lookup + increment: arg = sym
|
|
OP_LOOK_SUB1 = 82 # lookup + decrement: arg = sym
|
|
OP_CONST_EQ_JF = 83 # push const, compare TOS, branch: arg = (const, jump_addr)
|
|
OP_LOOK_CONST_CALL2 = 84 # lookup func, push const, call(2): arg = (sym, const)
|
|
OP_SELF_TAIL_CALL = 85 # self-recursive tail call (reuse env): arg = (n_args, params_tuple)
|
|
|
|
# Specialization table: {symbol: {arity: opcode}}
|
|
_BC_SPECIALIZE = {
|
|
S('+'): {2: OP_ADD}, S('-'): {2: OP_SUB, 1: OP_NEG}, S('*'): {2: OP_MUL},
|
|
S('='): {2: OP_NUM_EQ}, S('<'): {2: OP_LT}, S('>'): {2: OP_GT},
|
|
S('<='): {2: OP_LE}, S('>='): {2: OP_GE},
|
|
S('car'): {1: OP_CAR}, S('cdr'): {1: OP_CDR}, S('cons'): {2: OP_CONS},
|
|
S('null?'): {1: OP_NULL_P}, S('pair?'): {1: OP_PAIR_P},
|
|
S('not'): {1: OP_NOT}, S('zero?'): {1: OP_ZERO_P},
|
|
S('vector-ref'): {2: OP_VEC_REF}, S('vector-set!'): {3: OP_VEC_SET},
|
|
}
|
|
|
|
# Constant folding tables
|
|
def _bc_is_global(sym, env):
|
|
"""Check if sym is not locally shadowed (resolves to global env)."""
|
|
e = env
|
|
g = e.g
|
|
while e is not None and e is not g:
|
|
if sym in e.b: return False
|
|
e = e.p
|
|
return True
|
|
|
|
def _bc_is_const(expr):
|
|
"""Is expr a compile-time constant?"""
|
|
if isinstance(expr, (int, float, Fraction)): return True
|
|
if isinstance(expr, bool): return True
|
|
if isinstance(expr, str) and not isinstance(expr, Symbol): return True
|
|
if expr is NIL or expr is VOID or expr is True or expr is False: return True
|
|
return False
|
|
|
|
import operator as _op, functools as _ft
|
|
_BC_FOLDABLE = {
|
|
S('+'): lambda a: _ft.reduce(_op.add, a, 0),
|
|
S('-'): lambda a: -a[0] if len(a) == 1 else _ft.reduce(_op.sub, a[1:], a[0]),
|
|
S('*'): lambda a: _ft.reduce(_op.mul, a, 1),
|
|
S('='): lambda a: a[0] == a[1],
|
|
S('<'): lambda a: a[0] < a[1],
|
|
S('>'): lambda a: a[0] > a[1],
|
|
S('<='): lambda a: a[0] <= a[1],
|
|
S('>='): lambda a: a[0] >= a[1],
|
|
S('not'): lambda a: not _truthy(a[0]),
|
|
S('zero?'): lambda a: a[0] == 0,
|
|
S('positive?'): lambda a: a[0] > 0,
|
|
S('negative?'): lambda a: a[0] < 0,
|
|
S('abs'): lambda a: abs(a[0]),
|
|
S('min'): lambda a: min(a),
|
|
S('max'): lambda a: max(a),
|
|
S('string-length'): lambda a: len(a[0]) if isinstance(a[0], str) else None,
|
|
S('string-append'): lambda a: ''.join(a),
|
|
}
|
|
|
|
class CodeObj:
|
|
"""Compiled bytecode chunk."""
|
|
__slots__ = ('instrs', 'name', 'source_map', 'ic', '_cur_line', '_self_name', '_self_params')
|
|
def __init__(self, name=None):
|
|
self.instrs = []; self.name = name
|
|
self.source_map = [] # parallel to instrs: line number or None
|
|
self.ic = None # inline cache (populated at runtime)
|
|
self._cur_line = None # current source line during compilation
|
|
def emit(self, op, arg=None):
|
|
idx = len(self.instrs); self.instrs.append((op, arg))
|
|
self.source_map.append(self._cur_line)
|
|
return idx
|
|
def patch(self, addr, arg):
|
|
self.instrs[addr] = (self.instrs[addr][0], arg)
|
|
|
|
class CompiledProc:
|
|
"""A bytecode-compiled procedure."""
|
|
__slots__ = ('code', 'params', 'rest', 'env', 'name')
|
|
def __init__(self, code, params, rest, env, name=None):
|
|
self.code = code; self.params = params; self.rest = rest
|
|
self.env = env; self.name = name
|
|
def __repr__(self): return f'#<compiled {self.name or "λ"}>'
|
|
|
|
# Forms that fall back to leval
|
|
_BC_FALLBACK = frozenset(map(S, [
|
|
'quasiquote', 'define-macro', 'defmacro', 'define-syntax',
|
|
'let-syntax', 'letrec-syntax', 'syntax-rules',
|
|
'define-values', 'let-values', 'let*-values',
|
|
'define-record-type', 'module', 'import', 'include', 'load',
|
|
'parameterize', 'dynamic-wind', 'with-exception-handler',
|
|
'guard', 'call-with-values', 'values', 'eval', 'error',
|
|
'case',
|
|
]))
|
|
|
|
|
|
def _bc(expr, code, env, tail=False):
|
|
"""Compile expr into bytecode instructions in code."""
|
|
# Track source line from Pair nodes
|
|
if isinstance(expr, Pair) and expr._line is not None:
|
|
code._cur_line = expr._line
|
|
# Self-evaluating
|
|
if expr is VOID: code.emit(OP_VOID); return
|
|
if expr is NIL or expr is True or expr is False:
|
|
code.emit(OP_CONST, expr); return
|
|
if isinstance(expr, (int, float, Fraction)):
|
|
code.emit(OP_CONST, expr); return
|
|
if isinstance(expr, str) and not isinstance(expr, Symbol):
|
|
code.emit(OP_CONST, expr); return
|
|
if isinstance(expr, list):
|
|
code.emit(OP_CONST, expr); return
|
|
if isinstance(expr, Symbol):
|
|
code.emit(OP_LOOKUP, expr); return
|
|
if not isinstance(expr, Pair):
|
|
code.emit(OP_CONST, expr); return
|
|
|
|
head = expr.car; args = expr.cdr
|
|
|
|
# --- Fallback forms ---
|
|
if isinstance(head, Symbol) and head in _BC_FALLBACK:
|
|
code.emit(OP_EVAL, expr); return
|
|
|
|
# --- quote ---
|
|
if head is S('quote'):
|
|
code.emit(OP_CONST, args.car); return
|
|
|
|
# --- if ---
|
|
if head is S('if'):
|
|
a = _L(args)
|
|
_bc(a[0], code, env)
|
|
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
|
_bc(a[1], code, env, tail=tail)
|
|
je = code.emit(OP_JUMP, None)
|
|
code.patch(jf, len(code.instrs))
|
|
if len(a) > 2:
|
|
_bc(a[2], code, env, tail=tail)
|
|
else:
|
|
code.emit(OP_VOID)
|
|
code.patch(je, len(code.instrs))
|
|
return
|
|
|
|
# --- begin ---
|
|
if head is S('begin'):
|
|
a = _L(args)
|
|
if not a: code.emit(OP_VOID); return
|
|
for e in a[:-1]: _bc(e, code, env); code.emit(OP_POP)
|
|
_bc(a[-1], code, env, tail=tail); return
|
|
|
|
# --- and ---
|
|
if head is S('and'):
|
|
a = _L(args)
|
|
if not a: code.emit(OP_CONST, True); return
|
|
if len(a) == 1: _bc(a[0], code, env, tail=tail); return
|
|
ends = []
|
|
for e in a[:-1]:
|
|
_bc(e, code, env)
|
|
ends.append(code.emit(OP_JUMP_IF_FALSE_KEEP, None))
|
|
_bc(a[-1], code, env, tail=tail)
|
|
end = len(code.instrs)
|
|
for j in ends: code.patch(j, end)
|
|
return
|
|
|
|
# --- or ---
|
|
if head is S('or'):
|
|
a = _L(args)
|
|
if not a: code.emit(OP_CONST, False); return
|
|
if len(a) == 1: _bc(a[0], code, env, tail=tail); return
|
|
ends = []
|
|
for e in a[:-1]:
|
|
_bc(e, code, env)
|
|
ends.append(code.emit(OP_JUMP_IF_TRUE_KEEP, None))
|
|
_bc(a[-1], code, env, tail=tail)
|
|
end = len(code.instrs)
|
|
for j in ends: code.patch(j, end)
|
|
return
|
|
|
|
# --- when ---
|
|
if head is S('when'):
|
|
a = _L(args)
|
|
_bc(a[0], code, env)
|
|
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
|
for e in a[1:-1]: _bc(e, code, env); code.emit(OP_POP)
|
|
_bc(a[-1], code, env, tail=tail)
|
|
je = code.emit(OP_JUMP, None)
|
|
code.patch(jf, len(code.instrs))
|
|
code.emit(OP_VOID)
|
|
code.patch(je, len(code.instrs))
|
|
return
|
|
|
|
# --- unless ---
|
|
if head is S('unless'):
|
|
a = _L(args)
|
|
_bc(a[0], code, env)
|
|
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
|
code.emit(OP_VOID)
|
|
je = code.emit(OP_JUMP, None)
|
|
code.patch(jf, len(code.instrs))
|
|
for e in a[1:-1]: _bc(e, code, env); code.emit(OP_POP)
|
|
_bc(a[-1], code, env, tail=tail)
|
|
code.patch(je, len(code.instrs))
|
|
return
|
|
|
|
# --- cond ---
|
|
if head is S('cond'):
|
|
clauses = _L(args); ends = []
|
|
for cl_raw in clauses:
|
|
cl = _L(cl_raw)
|
|
if cl[0] is S('else'):
|
|
for e in (cl[1:] or [VOID])[:-1]: _bc(e, code, env); code.emit(OP_POP)
|
|
_bc((cl[1:] or [VOID])[-1], code, env, tail=tail); break
|
|
if (len(cl) >= 3 and cl[1] is S('=>')) or len(cl) == 1:
|
|
code.emit(OP_EVAL, expr); return # fallback for => and bare test
|
|
_bc(cl[0], code, env)
|
|
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
|
for e in cl[1:-1]: _bc(e, code, env); code.emit(OP_POP)
|
|
_bc(cl[-1], code, env, tail=tail)
|
|
ends.append(code.emit(OP_JUMP, None))
|
|
code.patch(jf, len(code.instrs))
|
|
else:
|
|
code.emit(OP_VOID)
|
|
end = len(code.instrs)
|
|
for j in ends: code.patch(j, end)
|
|
return
|
|
|
|
# --- define ---
|
|
if head is S('define'):
|
|
a = _L(args)
|
|
if isinstance(a[0], Pair):
|
|
fname = a[0].car; ps, rest = _formals(a[0].cdr)
|
|
inner = _bc_lambda(a[1:], ps, rest, env, name=str(fname))
|
|
code.emit(OP_MAKE_CLOSURE, (inner, ps, rest))
|
|
code.emit(OP_DEFINE, fname)
|
|
else:
|
|
_bc(a[1], code, env) if len(a) > 1 else code.emit(OP_VOID)
|
|
code.emit(OP_DEFINE, a[0])
|
|
code.emit(OP_VOID); return
|
|
|
|
# --- set! ---
|
|
if head is S('set!'):
|
|
a = _L(args)
|
|
_bc(a[1], code, env)
|
|
code.emit(OP_SET, a[0])
|
|
code.emit(OP_VOID); return
|
|
|
|
# --- lambda ---
|
|
if head is S('lambda') or head is S('λ'):
|
|
a = _L(args); ps, rest = _formals(a[0])
|
|
inner = _bc_lambda(a[1:], ps, rest, env)
|
|
code.emit(OP_MAKE_CLOSURE, (inner, ps, rest)); return
|
|
|
|
# --- let ---
|
|
if head is S('let'):
|
|
a = _L(args)
|
|
if isinstance(a[0], Symbol):
|
|
# Named let: (let loop ((v init)...) body...)
|
|
name = a[0]; binds = _L(a[1]); body = a[2:]
|
|
bps = [_L(b)[0] for b in binds]
|
|
inner = _bc_lambda(body, bps, None, env, name=str(name),
|
|
self_name=str(name), self_params=bps)
|
|
code.emit(OP_PUSH_ENV)
|
|
code.emit(OP_MAKE_CLOSURE, (inner, bps, None))
|
|
code.emit(OP_DUP)
|
|
code.emit(OP_BIND, name)
|
|
for b in binds: _bc(_L(b)[1], code, env)
|
|
code.emit(OP_TAIL_CALL if tail else OP_CALL, len(binds))
|
|
if not tail: code.emit(OP_POP_ENV)
|
|
return
|
|
# Regular let
|
|
binds = _L(a[0]); body = a[1:]
|
|
for b in binds: _bc(_L(b)[1], code, env)
|
|
code.emit(OP_PUSH_ENV)
|
|
for b in reversed(binds): code.emit(OP_BIND, _L(b)[0])
|
|
body_env = Env(env)
|
|
for b in binds: body_env.define(_L(b)[0], VOID)
|
|
_bc_body(body, code, body_env, tail=tail)
|
|
if not tail: code.emit(OP_POP_ENV)
|
|
return
|
|
|
|
# --- let* ---
|
|
if head is S('let*'):
|
|
a = _L(args); binds = _L(a[0]); body = a[1:]
|
|
code.emit(OP_PUSH_ENV)
|
|
body_env = Env(env)
|
|
for b in binds:
|
|
bp = _L(b); _bc(bp[1], code, body_env); code.emit(OP_BIND, bp[0])
|
|
body_env.define(bp[0], VOID)
|
|
_bc_body(body, code, body_env, tail=tail)
|
|
if not tail: code.emit(OP_POP_ENV)
|
|
return
|
|
|
|
# --- letrec / letrec* ---
|
|
if head is S('letrec') or head is S('letrec*'):
|
|
a = _L(args); binds = _L(a[0]); body = a[1:]
|
|
code.emit(OP_PUSH_ENV)
|
|
body_env = Env(env)
|
|
for b in binds: code.emit(OP_VOID); code.emit(OP_BIND, _L(b)[0]); body_env.define(_L(b)[0], VOID)
|
|
for b in binds:
|
|
bp = _L(b); _bc(bp[1], code, body_env)
|
|
code.emit(OP_SET, bp[0])
|
|
_bc_body(body, code, body_env, tail=tail)
|
|
if not tail: code.emit(OP_POP_ENV)
|
|
return
|
|
|
|
# --- do ---
|
|
if head is S('do'):
|
|
a = _L(args); vcs = _L(a[0]); term = _L(a[1]); body_exprs = a[2:]
|
|
specs = [_L(vc) for vc in vcs]
|
|
for sp in specs: _bc(sp[1], code, env)
|
|
code.emit(OP_PUSH_ENV)
|
|
for sp in reversed(specs): code.emit(OP_BIND, sp[0])
|
|
loop_start = len(code.instrs)
|
|
_bc(term[0], code, env)
|
|
jf = code.emit(OP_JUMP_IF_FALSE, None)
|
|
if len(term) > 1:
|
|
for e in term[1:-1]: _bc(e, code, env); code.emit(OP_POP)
|
|
_bc(term[-1], code, env, tail=tail)
|
|
else:
|
|
code.emit(OP_VOID)
|
|
je = code.emit(OP_JUMP, None)
|
|
code.patch(jf, len(code.instrs))
|
|
for b in body_exprs: _bc(b, code, env); code.emit(OP_POP)
|
|
for sp in specs:
|
|
step = sp[2] if len(sp) > 2 else sp[0]
|
|
_bc(step, code, env)
|
|
for sp in reversed(specs): code.emit(OP_SET, sp[0])
|
|
code.emit(OP_JUMP, loop_start)
|
|
code.patch(je, len(code.instrs))
|
|
if not tail: code.emit(OP_POP_ENV)
|
|
return
|
|
|
|
# --- call/cc ---
|
|
if head is S('call/cc') or head is S('call-with-current-continuation'):
|
|
a = _L(args)
|
|
_bc(a[0], code, env)
|
|
code.emit(OP_CALL_CC); return
|
|
|
|
# --- apply ---
|
|
if head is S('apply'):
|
|
a = _L(args)
|
|
# Compile all args, emit OP_EVAL as fallback for TCO correctness
|
|
code.emit(OP_EVAL, expr); return
|
|
|
|
# --- Macro expansion at compile time ---
|
|
if isinstance(head, Symbol):
|
|
try:
|
|
hval = env.lookup(head)
|
|
if isinstance(hval, Macro):
|
|
expanded = _call(hval.xfm, _L(args), env)
|
|
_bc(expanded, code, env, tail=tail); return
|
|
except LispErr:
|
|
pass
|
|
|
|
# --- Constant folding (only for unshadowed globals) ---
|
|
call_args = _L(args)
|
|
if isinstance(head, Symbol) and head in _BC_FOLDABLE and all(_bc_is_const(a) for a in call_args):
|
|
if _bc_is_global(head, env):
|
|
try:
|
|
result = _BC_FOLDABLE[head]([a for a in call_args])
|
|
code.emit(OP_CONST, result); return
|
|
except Exception:
|
|
pass
|
|
|
|
# --- Specialized opcodes for hot builtins (only unshadowed) ---
|
|
if isinstance(head, Symbol) and _bc_is_global(head, env):
|
|
n = len(call_args)
|
|
spec = _BC_SPECIALIZE.get(head)
|
|
if spec and n in spec:
|
|
# Fused: (+ sym 1) → LOOK_ADD1, (- sym 1) → LOOK_SUB1
|
|
if head is S('+') and n == 2:
|
|
if _bc_is_const(call_args[1]) and call_args[1] == 1:
|
|
if isinstance(call_args[0], Symbol):
|
|
code.emit(OP_LOOK_ADD1, call_args[0]); return
|
|
_bc(call_args[0], code, env); code.emit(OP_ADD1); return
|
|
if _bc_is_const(call_args[0]) and call_args[0] == 1:
|
|
if isinstance(call_args[1], Symbol):
|
|
code.emit(OP_LOOK_ADD1, call_args[1]); return
|
|
_bc(call_args[1], code, env); code.emit(OP_ADD1); return
|
|
if head is S('-') and n == 2:
|
|
if _bc_is_const(call_args[1]) and call_args[1] == 1:
|
|
if isinstance(call_args[0], Symbol):
|
|
code.emit(OP_LOOK_SUB1, call_args[0]); return
|
|
_bc(call_args[0], code, env); code.emit(OP_SUB1); return
|
|
for arg in call_args: _bc(arg, code, env)
|
|
code.emit(spec[n]); return
|
|
|
|
# --- Self tail call optimization ---
|
|
if tail and isinstance(head, Symbol) and hasattr(code, '_self_name') and str(head) == code._self_name:
|
|
params = code._self_params
|
|
for arg in call_args: _bc(arg, code, env)
|
|
code.emit(OP_SELF_TAIL_CALL, (len(call_args), tuple(params))); return
|
|
|
|
# --- Function call ---
|
|
_bc(head, code, env)
|
|
for arg in call_args: _bc(arg, code, env)
|
|
code.emit(OP_TAIL_CALL if tail else OP_CALL, len(call_args))
|
|
|
|
|
|
def _bc_body(body, code, env, tail=False):
|
|
"""Compile body expressions (like begin)."""
|
|
if not body: code.emit(OP_VOID); return
|
|
for e in body[:-1]: _bc(e, code, env); code.emit(OP_POP)
|
|
_bc(body[-1], code, env, tail=tail)
|
|
|
|
|
|
def _bc_lambda(body, params, rest, env, name=None, self_name=None, self_params=None):
|
|
"""Compile a lambda body into a CodeObj."""
|
|
inner = CodeObj(name=name)
|
|
if self_name:
|
|
inner._self_name = self_name
|
|
inner._self_params = self_params
|
|
# Handle internal defines (letrec* semantics)
|
|
def_names = []
|
|
body_list = list(body)
|
|
i = 0
|
|
while i < len(body_list):
|
|
f = body_list[i]
|
|
if isinstance(f, Pair) and f.car is S('define'):
|
|
a = _L(f.cdr)
|
|
nm = a[0].car if isinstance(a[0], Pair) else a[0]
|
|
if isinstance(nm, Symbol): def_names.append(nm)
|
|
i += 1
|
|
elif isinstance(f, Pair) and f.car is S('begin'):
|
|
spliced = _L(f.cdr)
|
|
body_list = body_list[:i] + spliced + body_list[i+1:]
|
|
else:
|
|
break
|
|
if def_names:
|
|
inner.emit(OP_PUSH_ENV)
|
|
for nm in def_names: inner.emit(OP_VOID); inner.emit(OP_BIND, nm)
|
|
_bc_body(body_list, inner, env, tail=True)
|
|
inner.emit(OP_RETURN)
|
|
_peephole(inner)
|
|
return inner
|
|
|
|
|
|
_JUMP_OPS = frozenset([OP_JUMP, OP_JUMP_IF_FALSE, OP_JUMP_IF_FALSE_KEEP,
|
|
OP_JUMP_IF_TRUE_KEEP])
|
|
|
|
def _peephole(code):
|
|
"""Peephole optimization: eliminate dead code and redundant ops."""
|
|
instrs = code.instrs
|
|
n = len(instrs)
|
|
if n < 2: return
|
|
# Mark instructions to remove
|
|
remove = set()
|
|
for i in range(n - 1):
|
|
op, arg = instrs[i]
|
|
nop, _ = instrs[i + 1]
|
|
# VOID POP → remove both
|
|
if op == OP_VOID and nop == OP_POP:
|
|
remove.add(i); remove.add(i + 1)
|
|
# Dead code after RETURN (unless it's a jump target)
|
|
if op == OP_RETURN and nop not in (OP_RETURN,) and i + 1 not in _jump_targets(instrs):
|
|
# Only remove if next instruction is not a jump target
|
|
if nop not in (OP_PUSH_ENV, OP_POP_ENV): # be conservative
|
|
pass # skip for safety — jump target analysis is complex
|
|
# JUMP to next instruction → remove
|
|
for i in range(n):
|
|
op, arg = instrs[i]
|
|
if op == OP_JUMP and arg == i + 1:
|
|
remove.add(i)
|
|
if not remove: return
|
|
# Build index mapping: old → new
|
|
mapping = {}; new_idx = 0
|
|
for i in range(n):
|
|
mapping[i] = new_idx
|
|
if i not in remove: new_idx += 1
|
|
mapping[n] = new_idx # for jumps pointing past the end
|
|
# Rebuild with adjusted jumps and source map
|
|
new_instrs = []; new_smap = []
|
|
smap = code.source_map
|
|
for i in range(n):
|
|
if i in remove: continue
|
|
op, arg = instrs[i]
|
|
if op in _JUMP_OPS and isinstance(arg, int):
|
|
new_instrs.append((op, mapping.get(arg, arg)))
|
|
else:
|
|
new_instrs.append((op, arg))
|
|
new_smap.append(smap[i] if i < len(smap) else None)
|
|
code.instrs = new_instrs
|
|
code.source_map = new_smap
|
|
|
|
|
|
def _jump_targets(instrs):
|
|
"""Return set of instruction indices that are jump targets."""
|
|
targets = set()
|
|
for op, arg in instrs:
|
|
if op in _JUMP_OPS and isinstance(arg, int):
|
|
targets.add(arg)
|
|
return targets
|
|
|
|
|
|
class _ContInvoked(Exception):
|
|
"""Raised when a full continuation is invoked."""
|
|
__slots__ = ('cont', 'val')
|
|
def __init__(self, cont, val): self.cont = cont; self.val = val
|
|
|
|
class FullCont:
|
|
"""Full multi-shot continuation. Snapshots env at capture time."""
|
|
__slots__ = ('frames', 'stack', 'ip', 'instrs', 'env', 'vm_id')
|
|
def __init__(self, frames, stack, ip, instrs, env, vm_id):
|
|
self.frames = [(i, p, _deep_copy_env(e), list(s)) for i, p, e, s in frames]
|
|
self.stack = list(stack); self.ip = ip
|
|
self.instrs = instrs; self.env = _deep_copy_env(env); self.vm_id = vm_id
|
|
def __call__(self, args, _env):
|
|
raise _ContInvoked(self, args[0] if args else VOID)
|
|
def __repr__(self): return '#<continuation>'
|
|
|
|
_vm_depth = [0]
|
|
|
|
def vm_exec(code, env):
|
|
"""Execute compiled bytecode with explicit frame stack and continuation support."""
|
|
vm_id = object() # unique per invocation
|
|
_vm_depth[0] += 1
|
|
try:
|
|
instrs = code.instrs; ip = 0; stack = []; frames = []
|
|
smap = code.source_map
|
|
while True:
|
|
try:
|
|
return _vm_loop(instrs, ip, stack, env, frames, vm_id)
|
|
except _ContInvoked as ci:
|
|
if ci.cont.vm_id is not vm_id:
|
|
raise
|
|
c = ci.cont
|
|
frames = [(i, p, _deep_copy_env(e), list(s)) for i, p, e, s in c.frames]
|
|
stack = list(c.stack); stack.append(ci.val)
|
|
ip = c.ip; instrs = c.instrs; n_instrs = len(instrs)
|
|
env = _deep_copy_env(c.env)
|
|
smap = None
|
|
except LispErr as e:
|
|
if e.source_line is None and smap and ip > 0 and ip - 1 < len(smap):
|
|
e.source_line = smap[ip - 1]
|
|
raise
|
|
finally:
|
|
_vm_depth[0] -= 1
|
|
|
|
def _vm_loop(instrs, ip, stack, env, frames, vm_id):
|
|
"""Inner VM loop with explicit frame stack and inline caching."""
|
|
_ap = stack.append; _po = stack.pop
|
|
_isinstance = isinstance; _CP = CompiledProc; _Pr = Proc
|
|
_ic = {} # inline cache: {instr_idx: (cached_env, cached_val)}
|
|
n_instrs = len(instrs)
|
|
while ip < n_instrs:
|
|
op, arg = instrs[ip]; ip += 1
|
|
if op == OP_CONST: _ap(arg)
|
|
elif op == OP_LOOKUP:
|
|
idx = ip - 1
|
|
cached = _ic.get(idx)
|
|
if cached is not None:
|
|
ce, _ = cached
|
|
# Cache valid only if no intermediate frame shadows
|
|
# the name between env and ce (the cached env, always
|
|
# the global env). Previously only `arg not in env.b`
|
|
# was checked, which missed parent-frame shadows such
|
|
# as a let-loop param sharing a global builtin name.
|
|
# We still read the value fresh from ce.b so that
|
|
# set! on globals is observed immediately.
|
|
e = env; shadowed = False
|
|
while e is not ce:
|
|
if e is None: shadowed = True; break
|
|
if arg in e.b: shadowed = True; break
|
|
e = e.p
|
|
if not shadowed and arg in ce.b:
|
|
_ap(ce.b[arg]); continue
|
|
val = env.lookup(arg)
|
|
# Cache only if the resolved value came from global —
|
|
# i.e. no intermediate frame shadowed on the way.
|
|
g = env.g
|
|
if g is not None and arg in g.b and val is g.b[arg]:
|
|
_ic[idx] = (g, val)
|
|
_ap(val)
|
|
elif op == OP_SET: env.set(arg, _po())
|
|
elif op == OP_DEFINE: env.define(arg, _po())
|
|
elif op == OP_POP: _po()
|
|
elif op == OP_DUP: _ap(stack[-1])
|
|
elif op == OP_VOID: _ap(VOID)
|
|
elif op == OP_JUMP:
|
|
ip = arg
|
|
if _portal_checkpoint[0] is not None:
|
|
_check_portal_checkpoint(instrs, ip, stack, env, frames, vm_id)
|
|
elif op == OP_JUMP_IF_FALSE:
|
|
if _po() is False: ip = arg
|
|
elif op == OP_JUMP_IF_FALSE_KEEP:
|
|
if stack[-1] is False: ip = arg
|
|
else: _po()
|
|
elif op == OP_JUMP_IF_TRUE_KEEP:
|
|
if stack[-1] is not False: ip = arg
|
|
else: _po()
|
|
elif op == OP_CALL:
|
|
n = arg
|
|
if n: args_ = stack[-n:]; del stack[-n:]
|
|
else: args_ = []
|
|
func = _po()
|
|
if _isinstance(func, _CP):
|
|
frames.append((instrs, ip, env, stack))
|
|
env = func.env.child(func.params, func.rest, args_)
|
|
instrs = func.code.instrs; ip = 0; n_instrs = len(instrs)
|
|
stack = []; _ap = stack.append; _po = stack.pop
|
|
continue
|
|
elif _isinstance(func, _Pr):
|
|
_ap(_call(func, args_, env))
|
|
elif callable(func):
|
|
_ap(func(args_, env))
|
|
else: raise LispErr(f'not callable: {show(func)}')
|
|
elif op == OP_TAIL_CALL:
|
|
n = arg
|
|
if n: args_ = stack[-n:]; del stack[-n:]
|
|
else: args_ = []
|
|
func = _po()
|
|
if _isinstance(func, _CP):
|
|
env = func.env.child(func.params, func.rest, args_)
|
|
instrs = func.code.instrs; ip = 0; n_instrs = len(instrs)
|
|
stack.clear()
|
|
if _portal_checkpoint[0] is not None:
|
|
_check_portal_checkpoint(instrs, ip, stack, env, frames, vm_id)
|
|
continue
|
|
elif _isinstance(func, _Pr):
|
|
c = func.env.child(func.params, func.rest, args_)
|
|
body = _body_env(func.body, c) if func.has_defs else func.body
|
|
for e in body[:-1]: leval(e, c)
|
|
ret = leval(body[-1], c)
|
|
if not frames: return ret
|
|
instrs, ip, env, stack = frames.pop(); n_instrs = len(instrs)
|
|
_ap = stack.append; _po = stack.pop
|
|
_ap(ret); continue
|
|
elif callable(func):
|
|
ret = func(args_, env)
|
|
if not frames: return ret
|
|
instrs, ip, env, stack = frames.pop(); n_instrs = len(instrs)
|
|
_ap = stack.append; _po = stack.pop
|
|
_ap(ret); continue
|
|
else: raise LispErr(f'not callable: {show(func)}')
|
|
elif op == OP_RETURN:
|
|
ret = _po() if stack else VOID
|
|
if not frames: return ret
|
|
instrs, ip, env, stack = frames.pop(); n_instrs = len(instrs)
|
|
_ap = stack.append; _po = stack.pop
|
|
_ap(ret); continue
|
|
elif op == OP_MAKE_CLOSURE:
|
|
inner_code, params, rest = arg
|
|
_ap(_CP(inner_code, params, rest, env, inner_code.name))
|
|
elif op == OP_PUSH_ENV: env = Env(env)
|
|
elif op == OP_POP_ENV: env = env.p
|
|
elif op == OP_BIND: env.define(arg, _po())
|
|
elif op == OP_EVAL: _ap(leval(arg, env))
|
|
elif op == OP_CALL_CC:
|
|
proc = _po()
|
|
cont = FullCont(frames, stack, ip, instrs, env, vm_id)
|
|
if _isinstance(proc, _CP):
|
|
frames.append((instrs, ip, env, stack))
|
|
env = proc.env.child(proc.params, proc.rest, [cont])
|
|
instrs = proc.code.instrs; ip = 0; n_instrs = len(instrs)
|
|
stack = []; _ap = stack.append; _po = stack.pop
|
|
continue
|
|
elif _isinstance(proc, _Pr):
|
|
_ap(_call(proc, [cont], env))
|
|
elif callable(proc):
|
|
_ap(proc([cont], env))
|
|
else: raise LispErr(f'call/cc: not callable: {show(proc)}')
|
|
# ── Specialized opcodes ──────────────────────────────────────────
|
|
elif op == OP_ADD: b = _po(); stack[-1] = stack[-1] + b
|
|
elif op == OP_SUB: b = _po(); stack[-1] = stack[-1] - b
|
|
elif op == OP_MUL: b = _po(); stack[-1] = stack[-1] * b
|
|
elif op == OP_NEG: stack[-1] = -stack[-1]
|
|
elif op == OP_ADD1: stack[-1] = stack[-1] + 1
|
|
elif op == OP_SUB1: stack[-1] = stack[-1] - 1
|
|
elif op == OP_NUM_EQ: b = _po(); stack[-1] = stack[-1] == b
|
|
elif op == OP_LT: b = _po(); stack[-1] = stack[-1] < b
|
|
elif op == OP_GT: b = _po(); stack[-1] = stack[-1] > b
|
|
elif op == OP_LE: b = _po(); stack[-1] = stack[-1] <= b
|
|
elif op == OP_GE: b = _po(); stack[-1] = stack[-1] >= b
|
|
elif op == OP_CAR: stack[-1] = stack[-1].car
|
|
elif op == OP_CDR: stack[-1] = stack[-1].cdr
|
|
elif op == OP_CONS: d = _po(); stack[-1] = Pair(stack[-1], d)
|
|
elif op == OP_NULL_P: stack[-1] = stack[-1] is NIL
|
|
elif op == OP_PAIR_P: stack[-1] = _isinstance(stack[-1], Pair)
|
|
elif op == OP_NOT: stack[-1] = stack[-1] is False
|
|
elif op == OP_ZERO_P: stack[-1] = stack[-1] == 0
|
|
elif op == OP_VEC_REF: i = _po(); stack[-1] = stack[-1][i]
|
|
elif op == OP_VEC_SET:
|
|
v = _po(); i = _po(); stack[-1][i] = v; stack[-1] = VOID
|
|
# ── Superinstructions ────────────────────────────────────────
|
|
elif op == OP_LOOK_LOOK:
|
|
s1, s2 = arg; _ap(env.lookup(s1)); _ap(env.lookup(s2))
|
|
elif op == OP_LOOK_ADD1:
|
|
_ap(env.lookup(arg) + 1)
|
|
elif op == OP_LOOK_SUB1:
|
|
_ap(env.lookup(arg) - 1)
|
|
elif op == OP_CONST_EQ_JF:
|
|
c, addr = arg
|
|
if _po() != c: ip = addr
|
|
elif op == OP_SELF_TAIL_CALL:
|
|
n, params = arg
|
|
if n: args_ = stack[-n:]; del stack[-n:]
|
|
else: args_ = []
|
|
b = env.b
|
|
for p, a in zip(params, args_): b[p] = a
|
|
ip = 0; stack.clear(); continue
|
|
elif op == OP_LOOK_CONST_CALL2:
|
|
sym, c = arg
|
|
func = env.lookup(sym)
|
|
if _isinstance(func, _CP):
|
|
frames.append((instrs, ip, env, stack))
|
|
env = func.env.child(func.params, func.rest, [stack[-1], c])
|
|
del stack[-1:]
|
|
instrs = func.code.instrs; ip = 0; n_instrs = len(instrs)
|
|
stack = []; _ap = stack.append; _po = stack.pop
|
|
continue
|
|
elif callable(func):
|
|
v = stack[-1]; stack[-1] = func([v, c], env)
|
|
else: _ap(func([stack.pop(), c], env))
|
|
return stack[-1] if stack else VOID
|
|
|
|
|
|
###############################################################################
|
|
# Bytecode Serialization
|
|
###############################################################################
|
|
|
|
import json as _json
|
|
|
|
def _serialize_operand(val):
|
|
"""Serialize a bytecode operand to a JSON-compatible value."""
|
|
if val is None: return None
|
|
if val is True: return {'t': 'bool', 'v': True}
|
|
if val is False: return {'t': 'bool', 'v': False}
|
|
if isinstance(val, int): return val # JSON native
|
|
if isinstance(val, float):
|
|
if math.isinf(val): return {'t': 'float', 'v': '+inf' if val > 0 else '-inf'}
|
|
if math.isnan(val): return {'t': 'float', 'v': 'nan'}
|
|
return {'t': 'float', 'v': val}
|
|
if isinstance(val, Fraction): return {'t': 'frac', 'n': val.numerator, 'd': val.denominator}
|
|
if isinstance(val, Symbol): return {'t': 'sym', 'v': str(val)}
|
|
if isinstance(val, MutableString): return {'t': 'str', 'v': str(val)}
|
|
if isinstance(val, str): return {'t': 'str', 'v': val}
|
|
if val is NIL: return {'t': 'nil'}
|
|
if val is VOID: return {'t': 'void'}
|
|
if val is EOF: return {'t': 'eof'}
|
|
if isinstance(val, Pair): return {'t': 'pair', 'car': _serialize_operand(val.car),
|
|
'cdr': _serialize_operand(val.cdr)}
|
|
if isinstance(val, list): # vector
|
|
return {'t': 'vec', 'v': [_serialize_operand(x) for x in val]}
|
|
if isinstance(val, tuple):
|
|
# OP_MAKE_CLOSURE: (CodeObj, params, rest)
|
|
if len(val) == 3 and isinstance(val[0], CodeObj):
|
|
code, params, rest = val
|
|
return {'t': 'closure', 'code': _serialize_code(code),
|
|
'params': [str(p) for p in params],
|
|
'rest': str(rest) if rest else None}
|
|
# OP_SELF_TAIL_CALL: (n_args, params_tuple)
|
|
if len(val) == 2 and isinstance(val[0], int) and isinstance(val[1], tuple):
|
|
return {'t': 'stc', 'n': val[0], 'p': [str(p) for p in val[1]]}
|
|
return {'t': 'repr', 'v': repr(val)}
|
|
|
|
def _deserialize_operand(data):
|
|
"""Deserialize a bytecode operand from JSON data."""
|
|
if data is None: return None
|
|
if isinstance(data, int): return data
|
|
if isinstance(data, dict):
|
|
t = data.get('t')
|
|
if t == 'bool': return data['v']
|
|
if t == 'float':
|
|
v = data['v']
|
|
if v == '+inf': return math.inf
|
|
if v == '-inf': return -math.inf
|
|
if v == 'nan': return float('nan')
|
|
return v
|
|
if t == 'frac': return Fraction(data['n'], data['d'])
|
|
if t == 'sym': return S(data['v'])
|
|
if t == 'str': return data['v']
|
|
if t == 'nil': return NIL
|
|
if t == 'void': return VOID
|
|
if t == 'eof': return EOF
|
|
if t == 'pair': return Pair(_deserialize_operand(data['car']),
|
|
_deserialize_operand(data['cdr']))
|
|
if t == 'vec': return [_deserialize_operand(x) for x in data['v']]
|
|
if t == 'closure':
|
|
code = _deserialize_code(data['code'])
|
|
params = [S(p) for p in data['params']]
|
|
rest = S(data['rest']) if data['rest'] else None
|
|
return (code, params, rest)
|
|
if t == 'stc':
|
|
return (data['n'], tuple(S(p) for p in data['p']))
|
|
return data
|
|
|
|
def _serialize_code(code):
|
|
"""Serialize a CodeObj to a JSON-compatible dict."""
|
|
return {
|
|
'name': code.name,
|
|
'instrs': [[op, _serialize_operand(arg)] for op, arg in code.instrs],
|
|
'source_map': code.source_map,
|
|
}
|
|
|
|
def _deserialize_code(data):
|
|
"""Deserialize a CodeObj from a JSON dict."""
|
|
code = CodeObj(name=data.get('name'))
|
|
code.instrs = [(op, _deserialize_operand(arg)) for op, arg in data['instrs']]
|
|
code.source_map = data.get('source_map', [None] * len(code.instrs))
|
|
return code
|
|
|
|
def save_compiled(path, proc):
|
|
"""Save a compiled procedure to a .lspc file."""
|
|
if not isinstance(proc, CompiledProc):
|
|
raise LispErr(f'save-compiled: not a compiled procedure: {show(proc)}')
|
|
data = {
|
|
'format': 'lspc-v1',
|
|
'name': proc.name,
|
|
'params': [str(p) for p in proc.params],
|
|
'rest': str(proc.rest) if proc.rest else None,
|
|
'code': _serialize_code(proc.code),
|
|
}
|
|
with open(path, 'w') as f:
|
|
_json.dump(data, f, separators=(',', ':'))
|
|
|
|
def load_compiled(path, env):
|
|
"""Load a compiled procedure from a .lspc file."""
|
|
with open(path) as f:
|
|
data = _json.load(f)
|
|
if data.get('format') != 'lspc-v1':
|
|
raise LispErr(f'load-compiled: unsupported format: {data.get("format")}')
|
|
code = _deserialize_code(data['code'])
|
|
params = [S(p) for p in data['params']]
|
|
rest = S(data['rest']) if data['rest'] else None
|
|
return CompiledProc(code, params, rest, env, data.get('name'))
|
|
|
|
|
|
###############################################################################
|
|
# 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': 'uncommonlisp-portal-v1',
|
|
'env': ser.serialize_env(env),
|
|
'continuation': ser.serialize_continuation(continuation) if continuation else None,
|
|
'auto_compile': _auto_compile[0],
|
|
}
|
|
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') != 'uncommonlisp-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)
|
|
cont = None
|
|
if state.get('continuation'):
|
|
cont = des.deserialize_value(state['continuation'])
|
|
return base_env, cont
|
|
|
|
|
|
# Portal checkpoint for mid-execution save
|
|
# MOAD-0002: Module-level global — intentional coupling. This is checked in the VM hot
|
|
# loop (OP_JUMP, OP_TAIL_CALL) so passing it as a parameter would add overhead to every
|
|
# iteration. The mutable list wrapper allows portal-checkpoint! to signal the VM without
|
|
# requiring a context object threaded through vm_exec/vm_loop.
|
|
_portal_checkpoint = [None] # set to a path to trigger save during VM execution
|
|
|
|
def _check_portal_checkpoint(instrs, ip, stack, env, frames, vm_id):
|
|
"""Check if a portal save was requested. Called from VM loop."""
|
|
path = _portal_checkpoint[0]
|
|
if path is None: return
|
|
_portal_checkpoint[0] = None
|
|
cont = FullCont(frames, stack, ip, instrs, env, vm_id)
|
|
portal_save(env, path, continuation=cont)
|
|
|
|
|
|
# Auto-compile flag
|
|
_auto_compile = [False]
|
|
|
|
|
|
def bc_compile_proc(proc, env):
|
|
"""Compile a Proc into a CompiledProc."""
|
|
if isinstance(proc, CompiledProc): return proc
|
|
if not isinstance(proc, Proc): raise LispErr(f'compile: not a procedure: {show(proc)}')
|
|
code = _bc_lambda(proc.body, proc.params, proc.rest, env, name=proc.name)
|
|
return CompiledProc(code, proc.params, proc.rest, proc.env, proc.name)
|
|
|
|
|
|
###############################################################################
|
|
# JIT: Transpile bytecode to Python source, exec() it
|
|
###############################################################################
|
|
|
|
def _jit_compile(proc):
|
|
"""JIT a Proc/CompiledProc to a native Python function via AST transpilation."""
|
|
if isinstance(proc, CompiledProc):
|
|
# Need the original AST — can't JIT from bytecode alone
|
|
return None
|
|
if not isinstance(proc, Proc): return None
|
|
if proc.rest: return None # rest args too complex
|
|
|
|
params = [_jit_pyname(p) for p in proc.params]
|
|
name = proc.name or '_fn'
|
|
pyname = _jit_pyname(name)
|
|
|
|
try:
|
|
body_src = _jit_expr(proc.body, params)
|
|
except _JitBail:
|
|
return None
|
|
|
|
source = f'def {pyname}({", ".join(params)}):\n return {body_src}'
|
|
ns = {'Pair': Pair, 'NIL': NIL, 'VOID': VOID, 'S': S, 'Fraction': Fraction,
|
|
'True': True, 'False': False}
|
|
# Add self-reference for recursion
|
|
try:
|
|
exec(source, ns)
|
|
fn = ns[pyname]
|
|
# For recursive functions, bind self
|
|
if name in source:
|
|
ns[pyname] = fn
|
|
exec(source, ns)
|
|
fn = ns[pyname]
|
|
def jit_wrapper(args, env):
|
|
return fn(*args)
|
|
jit_wrapper._jit_source = source
|
|
jit_wrapper._jit_name = name
|
|
return jit_wrapper
|
|
except Exception:
|
|
return None
|
|
|
|
|
|
class _JitBail(Exception): pass
|
|
|
|
def _jit_pyname(s):
|
|
"""Sanitize a Scheme identifier to a valid Python identifier."""
|
|
r = str(s).replace('-', '_').replace('?', '_p').replace('!', '_b').replace('>', '_gt').replace('<', '_lt').replace('/', '_sl').replace('*', '_st').replace('+', '_pl').replace('=', '_eq')
|
|
if not r or r[0].isdigit(): r = '_' + r
|
|
if r in ('and', 'or', 'not', 'if', 'else', 'return', 'while', 'for', 'in', 'is',
|
|
'True', 'False', 'None', 'def', 'class', 'lambda', 'pass', 'break', 'continue'):
|
|
r = r + '_'
|
|
return r
|
|
|
|
def _jit_expr(body, params):
|
|
"""Transpile Scheme body (list of exprs) to a Python expression string."""
|
|
if len(body) == 1: return _jit_one(body[0], params)
|
|
# begin: evaluate all, return last (only works if non-last are side-effect-free)
|
|
# For JIT, bail on side effects in non-tail position
|
|
return _jit_one(body[-1], params)
|
|
|
|
def _jit_one(expr, params):
|
|
"""Transpile a single Scheme expression to a Python expression string."""
|
|
if expr is True: return 'True'
|
|
if expr is False: return 'False'
|
|
if expr is NIL: return 'NIL'
|
|
if isinstance(expr, (int, float)): return repr(expr)
|
|
if isinstance(expr, Fraction): return f'Fraction({expr.numerator},{expr.denominator})'
|
|
if isinstance(expr, str) and not isinstance(expr, Symbol): return repr(expr)
|
|
if isinstance(expr, Symbol):
|
|
return _jit_pyname(expr)
|
|
if not isinstance(expr, Pair): raise _JitBail()
|
|
|
|
head = expr.car; args = _L(expr.cdr)
|
|
|
|
# Special forms
|
|
if head is S('if'):
|
|
test = _jit_one(args[0], params)
|
|
then = _jit_one(args[1], params)
|
|
els = _jit_one(args[2], params) if len(args) > 2 else 'VOID'
|
|
return f'({then} if {test} else {els})'
|
|
|
|
if head is S('cond'):
|
|
return _jit_cond(args, params)
|
|
|
|
if head is S('begin'):
|
|
return _jit_one(args[-1], params)
|
|
|
|
if head is S('let'):
|
|
if isinstance(args[0], Symbol):
|
|
# Named let → while loop as a helper function
|
|
return _jit_named_let(args, params)
|
|
# Regular let → inline
|
|
binds = _L(args[0]); body = args[1:]
|
|
bind_strs = []
|
|
new_params = list(params)
|
|
for b in binds:
|
|
bp = _L(b)
|
|
bind_strs.append(f'{bp[0]}={_jit_one(bp[1], params)}')
|
|
new_params.append(str(bp[0]))
|
|
body_str = _jit_expr(body, new_params)
|
|
return f'(lambda {",".join(str(_L(b)[0]) for b in binds)}: {body_str})({",".join(_jit_one(_L(b)[1], params) for b in binds)})'
|
|
|
|
if head is S('and'):
|
|
if not args: return 'True'
|
|
parts = [_jit_one(a, params) for a in args]
|
|
return ' and '.join(f'({p})' for p in parts)
|
|
|
|
if head is S('or'):
|
|
if not args: return 'False'
|
|
parts = [_jit_one(a, params) for a in args]
|
|
return ' or '.join(f'({p})' for p in parts)
|
|
|
|
if head is S('quote'):
|
|
raise _JitBail() # can't represent arbitrary quoted data
|
|
|
|
# Known pure functions → inline Python
|
|
_PYOP = {
|
|
S('+'): '+', S('-'): '-', S('*'): '*',
|
|
S('='): '==', S('<'): '<', S('>'): '>',
|
|
S('<='): '<=', S('>='): '>=',
|
|
}
|
|
if head in _PYOP and len(args) == 2:
|
|
a = _jit_one(args[0], params); b = _jit_one(args[1], params)
|
|
return f'({a} {_PYOP[head]} {b})'
|
|
if head is S('+') and len(args) == 1: return _jit_one(args[0], params)
|
|
if head is S('-') and len(args) == 1: return f'(-{_jit_one(args[0], params)})'
|
|
if head is S('not'): return f'(not {_jit_one(args[0], params)})'
|
|
if head is S('zero?'): return f'({_jit_one(args[0], params)} == 0)'
|
|
if head is S('null?'): return f'({_jit_one(args[0], params)} is NIL)'
|
|
if head is S('pair?'): return f'isinstance({_jit_one(args[0], params)}, Pair)'
|
|
if head is S('car'): return f'{_jit_one(args[0], params)}.car'
|
|
if head is S('cdr'): return f'{_jit_one(args[0], params)}.cdr'
|
|
if head is S('cons'): return f'Pair({_jit_one(args[0], params)},{_jit_one(args[1], params)})'
|
|
if head is S('remainder'): return f'({_jit_one(args[0], params)} % {_jit_one(args[1], params)})'
|
|
if head is S('modulo'): return f'({_jit_one(args[0], params)} % {_jit_one(args[1], params)})'
|
|
if head is S('abs'): return f'abs({_jit_one(args[0], params)})'
|
|
if head is S('expt'): return f'({_jit_one(args[0], params)} ** {_jit_one(args[1], params)})'
|
|
|
|
# Generic function call
|
|
if isinstance(head, Symbol):
|
|
fn = _jit_pyname(head)
|
|
call_args = ', '.join(_jit_one(a, params) for a in args)
|
|
return f'{fn}({call_args})'
|
|
|
|
raise _JitBail()
|
|
|
|
|
|
def _jit_cond(clauses, params):
|
|
"""Transpile cond to nested ternary."""
|
|
if not clauses: return 'VOID'
|
|
cl = _L(clauses[0])
|
|
if cl[0] is S('else'):
|
|
return _jit_expr(cl[1:], params)
|
|
test = _jit_one(cl[0], params)
|
|
then = _jit_expr(cl[1:], params) if len(cl) > 1 else test
|
|
rest = _jit_cond(clauses[1:], params)
|
|
return f'({then} if {test} else {rest})'
|
|
|
|
|
|
def _jit_named_let(args, params):
|
|
"""Transpile named let to a Python helper with while loop.
|
|
Returns a Python expression that calls the helper."""
|
|
name = str(args[0])
|
|
binds = _L(args[1]); body = args[2:]
|
|
bparams = [str(_L(b)[0]) for b in binds]
|
|
all_params = list(params) + bparams + [name]
|
|
|
|
# The body becomes a while-True loop with return/continue
|
|
body_expr = _jit_expr(body, all_params)
|
|
|
|
# For simple tail-recursive patterns (if test return_val (loop ...)),
|
|
# we can generate a while loop. But for the general case,
|
|
# use recursive Python function.
|
|
init_args = ', '.join(_jit_one(_L(b)[1], params) for b in binds)
|
|
# Generate as a local recursive function
|
|
raise _JitBail() # named-let needs statement-level code, not expression
|
|
|
|
|
|
def _jit_transpile(instrs, params, name, has_self_tc):
|
|
"""Transpile bytecode to Python source lines using recursive descent."""
|
|
lines = [f'def {name}({", ".join(params)}):']
|
|
indent = ' '
|
|
if has_self_tc:
|
|
lines.append(f'{indent}while True:')
|
|
indent = ' '
|
|
|
|
def _expr(ip):
|
|
"""Transpile expression starting at ip, return (python_expr_string, next_ip)."""
|
|
if ip >= len(instrs): raise _JitBail()
|
|
op, arg = instrs[ip]
|
|
if op == OP_CONST:
|
|
if arg is True: return 'True', ip+1
|
|
if arg is False: return 'False', ip+1
|
|
if arg is NIL: return 'NIL', ip+1
|
|
if isinstance(arg, str) and not isinstance(arg, Symbol): return repr(arg), ip+1
|
|
return repr(arg), ip+1
|
|
if op == OP_LOOKUP: return str(arg), ip+1
|
|
if op == OP_LOOK_ADD1: return f'({arg} + 1)', ip+1
|
|
if op == OP_LOOK_SUB1: return f'({arg} - 1)', ip+1
|
|
if op == OP_VOID: return 'VOID', ip+1
|
|
# Binary ops: left expr, right expr, op
|
|
if op in (OP_ADD, OP_SUB, OP_MUL, OP_NUM_EQ, OP_LT, OP_GT, OP_LE, OP_GE,
|
|
OP_CONS, OP_VEC_REF):
|
|
raise _JitBail() # handled by stack below
|
|
raise _JitBail()
|
|
|
|
def _block(ip, end):
|
|
"""Transpile a block of instructions [ip, end), return list of (stmt, next_ip)."""
|
|
stmts = []; stack = []
|
|
while ip < end:
|
|
op, arg = instrs[ip]
|
|
if op == OP_CONST:
|
|
if arg is True: stack.append('True')
|
|
elif arg is False: stack.append('False')
|
|
elif arg is NIL: stack.append('NIL')
|
|
elif isinstance(arg, str) and not isinstance(arg, Symbol):
|
|
stack.append(repr(arg))
|
|
else: stack.append(repr(arg))
|
|
ip += 1
|
|
elif op == OP_LOOKUP: stack.append(str(arg)); ip += 1
|
|
elif op == OP_LOOK_ADD1: stack.append(f'({arg} + 1)'); ip += 1
|
|
elif op == OP_LOOK_SUB1: stack.append(f'({arg} - 1)'); ip += 1
|
|
elif op == OP_VOID: stack.append('VOID'); ip += 1
|
|
elif op == OP_ADD: b=stack.pop(); a=stack.pop(); stack.append(f'({a} + {b})'); ip+=1
|
|
elif op == OP_SUB: b=stack.pop(); a=stack.pop(); stack.append(f'({a} - {b})'); ip+=1
|
|
elif op == OP_MUL: b=stack.pop(); a=stack.pop(); stack.append(f'({a} * {b})'); ip+=1
|
|
elif op == OP_NEG: a=stack.pop(); stack.append(f'(-{a})'); ip+=1
|
|
elif op == OP_ADD1: a=stack.pop(); stack.append(f'({a} + 1)'); ip+=1
|
|
elif op == OP_SUB1: a=stack.pop(); stack.append(f'({a} - 1)'); ip+=1
|
|
elif op == OP_NUM_EQ: b=stack.pop(); a=stack.pop(); stack.append(f'({a} == {b})'); ip+=1
|
|
elif op == OP_LT: b=stack.pop(); a=stack.pop(); stack.append(f'({a} < {b})'); ip+=1
|
|
elif op == OP_GT: b=stack.pop(); a=stack.pop(); stack.append(f'({a} > {b})'); ip+=1
|
|
elif op == OP_LE: b=stack.pop(); a=stack.pop(); stack.append(f'({a} <= {b})'); ip+=1
|
|
elif op == OP_GE: b=stack.pop(); a=stack.pop(); stack.append(f'({a} >= {b})'); ip+=1
|
|
elif op == OP_NOT: a=stack.pop(); stack.append(f'(not {a})'); ip+=1
|
|
elif op == OP_ZERO_P: a=stack.pop(); stack.append(f'({a} == 0)'); ip+=1
|
|
elif op == OP_NULL_P: a=stack.pop(); stack.append(f'({a} is NIL)'); ip+=1
|
|
elif op == OP_PAIR_P: a=stack.pop(); stack.append(f'isinstance({a}, Pair)'); ip+=1
|
|
elif op == OP_CAR: a=stack.pop(); stack.append(f'{a}.car'); ip+=1
|
|
elif op == OP_CDR: a=stack.pop(); stack.append(f'{a}.cdr'); ip+=1
|
|
elif op == OP_CONS: d=stack.pop(); a=stack.pop(); stack.append(f'Pair({a},{d})'); ip+=1
|
|
elif op == OP_VEC_REF: i=stack.pop(); v=stack.pop(); stack.append(f'{v}[{i}]'); ip+=1
|
|
elif op == OP_POP: stack.pop() if stack else None; ip+=1
|
|
elif op == OP_DUP: stack.append(stack[-1]); ip+=1
|
|
elif op == OP_JUMP: ip = arg # forward jump = skip to target
|
|
elif op == OP_JUMP_IF_FALSE:
|
|
cond = stack.pop()
|
|
else_ip = arg
|
|
# Find JUMP at end of then-block → end of if
|
|
# Pattern: [then-block] JUMP end [else-block] end:
|
|
then_end = else_ip - 1
|
|
if then_end >= 0 and instrs[then_end][0] == OP_JUMP:
|
|
end_ip = instrs[then_end][1]
|
|
then_stmts = _block(ip, then_end)
|
|
else_stmts = _block(else_ip, end_ip)
|
|
stmts.append(('if', cond, then_stmts, else_stmts))
|
|
ip = end_ip
|
|
else:
|
|
# No else: if (not cond) skip
|
|
then_stmts = _block(ip, else_ip)
|
|
stmts.append(('if', cond, then_stmts, []))
|
|
ip = else_ip
|
|
elif op == OP_RETURN:
|
|
val = stack.pop() if stack else 'VOID'
|
|
stmts.append(('return', val)); ip+=1
|
|
elif op == OP_SELF_TAIL_CALL:
|
|
tc_n, tc_params = arg
|
|
pnames = [str(p) for p in tc_params]
|
|
args = [];
|
|
for _ in range(tc_n): args.insert(0, stack.pop())
|
|
stmts.append(('self_tc', pnames, args)); ip+=1
|
|
elif op == OP_CALL:
|
|
call_args = [];
|
|
for _ in range(arg): call_args.insert(0, stack.pop())
|
|
func = stack.pop()
|
|
stack.append(f'{func}({",".join(call_args)})'); ip+=1
|
|
elif op == OP_TAIL_CALL:
|
|
call_args = []
|
|
for _ in range(arg): call_args.insert(0, stack.pop())
|
|
func = stack.pop()
|
|
stmts.append(('return', f'{func}({",".join(call_args)})')); ip+=1
|
|
elif op == OP_SET:
|
|
val = stack.pop()
|
|
stmts.append(('assign', str(arg), val)); ip+=1
|
|
elif op == OP_DEFINE:
|
|
val = stack.pop()
|
|
stmts.append(('assign', str(arg), val)); ip+=1
|
|
else:
|
|
raise _JitBail()
|
|
return stmts
|
|
|
|
def _emit(stmts, ind):
|
|
for s in stmts:
|
|
if s[0] == 'return':
|
|
lines.append(f'{ind}return {s[1]}')
|
|
elif s[0] == 'self_tc':
|
|
pnames, args = s[1], s[2]
|
|
lines.append(f'{ind}{", ".join(pnames)} = {", ".join(args)}')
|
|
lines.append(f'{ind}continue')
|
|
elif s[0] == 'assign':
|
|
lines.append(f'{ind}{s[1]} = {s[2]}')
|
|
elif s[0] == 'if':
|
|
_, cond, then_s, else_s = s
|
|
lines.append(f'{ind}if {cond}:')
|
|
if then_s: _emit(then_s, ind + ' ')
|
|
else: lines.append(f'{ind} pass')
|
|
if else_s:
|
|
lines.append(f'{ind}else:')
|
|
_emit(else_s, ind + ' ')
|
|
|
|
stmts = _block(0, len(instrs))
|
|
_emit(stmts, indent)
|
|
return lines
|
|
|
|
|
|
def _jit_try(proc, env):
|
|
"""Try to JIT a procedure. Returns JIT'd callable or original proc."""
|
|
if not isinstance(proc, (CompiledProc, Proc)): return proc
|
|
if isinstance(proc, Proc):
|
|
proc = bc_compile_proc(proc, env)
|
|
jit_fn = _jit_compile(proc)
|
|
return jit_fn if jit_fn else proc
|
|
|
|
|
|
def _disassemble(proc):
|
|
"""Return human-readable bytecode listing."""
|
|
if isinstance(proc, Proc):
|
|
return f'#<interpreted {proc.name or "λ"}> — not compiled'
|
|
if not isinstance(proc, CompiledProc):
|
|
return f'not a procedure: {show(proc)}'
|
|
_OP_NAMES = {
|
|
OP_CONST: 'CONST', OP_LOOKUP: 'LOOKUP', OP_SET: 'SET',
|
|
OP_DEFINE: 'DEFINE', OP_POP: 'POP', OP_DUP: 'DUP', OP_VOID: 'VOID',
|
|
OP_JUMP: 'JUMP', OP_JUMP_IF_FALSE: 'JUMP_IF_FALSE',
|
|
OP_JUMP_IF_FALSE_KEEP: 'JUMP_IF_FALSE_KEEP',
|
|
OP_JUMP_IF_TRUE_KEEP: 'JUMP_IF_TRUE_KEEP',
|
|
OP_CALL: 'CALL', OP_TAIL_CALL: 'TAIL_CALL', OP_RETURN: 'RETURN',
|
|
OP_MAKE_CLOSURE: 'MAKE_CLOSURE',
|
|
OP_PUSH_ENV: 'PUSH_ENV', OP_POP_ENV: 'POP_ENV', OP_BIND: 'BIND',
|
|
OP_EVAL: 'EVAL', OP_CALL_CC: 'CALL_CC',
|
|
OP_ADD: 'ADD', OP_SUB: 'SUB', OP_MUL: 'MUL', OP_NEG: 'NEG',
|
|
OP_ADD1: 'ADD1', OP_SUB1: 'SUB1',
|
|
OP_NUM_EQ: 'NUM_EQ', OP_LT: 'LT', OP_GT: 'GT', OP_LE: 'LE', OP_GE: 'GE',
|
|
OP_CAR: 'CAR', OP_CDR: 'CDR', OP_CONS: 'CONS',
|
|
OP_NULL_P: 'NULL?', OP_PAIR_P: 'PAIR?', OP_NOT: 'NOT', OP_ZERO_P: 'ZERO?',
|
|
OP_VEC_REF: 'VEC_REF', OP_VEC_SET: 'VEC_SET',
|
|
OP_LOOK_LOOK: 'LOOK²', OP_LOOK_ADD1: 'LOOK+1', OP_LOOK_SUB1: 'LOOK-1',
|
|
OP_CONST_EQ_JF: 'CONST=JF', OP_LOOK_CONST_CALL2: 'LOOK_C_CALL2',
|
|
OP_SELF_TAIL_CALL: 'SELF_TCALL',
|
|
}
|
|
lines = [f'--- {proc.name or "λ"} '
|
|
f'({" ".join(str(p) for p in proc.params)}'
|
|
f'{"" if not proc.rest else " . " + str(proc.rest)}) ---']
|
|
for i, (op, arg) in enumerate(proc.code.instrs):
|
|
name = _OP_NAMES.get(op, f'OP_{op}')
|
|
if op == OP_MAKE_CLOSURE:
|
|
inner_code, params, rest = arg
|
|
arg_str = f'({inner_code.name or "λ"} {" ".join(str(p) for p in params)})'
|
|
elif op == OP_EVAL:
|
|
arg_str = show(arg)[:50]
|
|
elif arg is not None:
|
|
arg_str = show(arg) if not isinstance(arg, int) or op in (
|
|
OP_CALL, OP_TAIL_CALL, OP_JUMP, OP_JUMP_IF_FALSE,
|
|
OP_JUMP_IF_FALSE_KEEP, OP_JUMP_IF_TRUE_KEEP) else show(arg)
|
|
else:
|
|
arg_str = ''
|
|
lines.append(f' {i:4d} {name:<22s} {arg_str}')
|
|
return '\n'.join(lines)
|
|
|
|
|
|
###############################################################################
|
|
# Built-ins
|
|
###############################################################################
|
|
|
|
_gensym_ctr = itertools.count()
|
|
_modules: dict = {} # module-name → Env
|
|
_mod_exports: dict = {} # module-name → [export-names]
|
|
_record_types: dict = {} # record-name → {'fields': [...], 'parent': name|None}
|
|
# MOAD-0002: Module-level global — intentional coupling. Only read in LispErr.__init__
|
|
# to snapshot the call stack for error messages. Kept global because threading it through
|
|
# every leval/apply call would add overhead to the common (non-error) path.
|
|
_call_stack: list = [] # call stack for error reporting
|
|
_traced_originals: dict = {} # name → original proc (for untrace)
|
|
|
|
def _num(x):
|
|
if isinstance(x, bool) or not isinstance(x, (int, float, Fraction)):
|
|
raise LispErr(f'not a number: {show(x)}')
|
|
return x
|
|
|
|
def _str_val(x):
|
|
if isinstance(x, MutableString): return x
|
|
if not isinstance(x, str) or isinstance(x, Symbol):
|
|
raise LispErr(f'not a string: {show(x)}')
|
|
return x
|
|
|
|
def _write_file(path, content):
|
|
try:
|
|
with open(path, 'w') as f:
|
|
f.write(str(content))
|
|
return True
|
|
except OSError:
|
|
return False
|
|
|
|
def _read_file_to_string(path):
|
|
try:
|
|
with open(path, 'r') as f:
|
|
return f.read()
|
|
except OSError:
|
|
return False
|
|
|
|
def _read_from_string(s):
|
|
"""Parse one S-expression from the given string. Returns first form."""
|
|
forms = list(read_all(s))
|
|
return forms[0] if forms else False
|
|
|
|
import socket as _sockmod
|
|
def _tcp_listen(port):
|
|
s = _sockmod.socket(_sockmod.AF_INET, _sockmod.SOCK_STREAM)
|
|
s.setsockopt(_sockmod.SOL_SOCKET, _sockmod.SO_REUSEADDR, 1)
|
|
s.bind(('0.0.0.0', port))
|
|
s.listen(128)
|
|
return s
|
|
|
|
def _tcp_accept(server):
|
|
client, _addr = server.accept()
|
|
return client
|
|
|
|
def _tcp_connect(host, port):
|
|
s = _sockmod.socket(_sockmod.AF_INET, _sockmod.SOCK_STREAM)
|
|
s.connect((host, port))
|
|
return s
|
|
|
|
def _tcp_recv(sock, n):
|
|
try:
|
|
data = sock.recv(n)
|
|
except OSError:
|
|
return False
|
|
return data.decode('utf-8', errors='replace')
|
|
|
|
def _tcp_send(sock, s):
|
|
data = s.encode('utf-8') if isinstance(s, str) else bytes(s)
|
|
try:
|
|
return sock.send(data)
|
|
except OSError:
|
|
return False
|
|
|
|
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, _: int(_num(a[0]) / _num(a[1])))
|
|
d(S('remainder'), lambda a, _: int(_num(a[0])) % int(_num(a[1])) * (1 if _num(a[0]) >= 0 else -1))
|
|
d(S('modulo'), lambda a, _: int(_num(a[0])) % int(_num(a[1])))
|
|
d(S('expt'), lambda a, _: _num(a[0]) ** _num(a[1]))
|
|
d(S('abs'), lambda a, _: abs(_num(a[0])))
|
|
d(S('floor'), lambda a, _: int(math.floor(_num(a[0]))))
|
|
d(S('ceiling'), lambda a, _: int(math.ceil(_num(a[0]))))
|
|
d(S('round'), lambda a, _: int(round(_num(a[0]))))
|
|
d(S('truncate'), lambda a, _: int(math.trunc(_num(a[0]))))
|
|
d(S('floor/'), lambda a, _: (math.floor(_num(a[0]) / _num(a[1])),
|
|
_num(a[0]) - _num(a[1]) * math.floor(_num(a[0]) / _num(a[1]))))
|
|
d(S('sqrt'), lambda a, _: math.sqrt(_num(a[0])))
|
|
d(S('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('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])
|
|
# 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')
|
|
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)
|
|
|
|
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*'), 'uncommonlisp')
|
|
|
|
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'uncommonlisp {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('''uncommonlisp — a Scheme in one Python file
|
|
|
|
Usage: uncommonlisp [options] [script.lsp] [args...]
|
|
uncommonlisp -e '(+ 1 2)'
|
|
uncommonlisp (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'uncommonlisp 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: uncommonlisp --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: uncommonlisp --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: uncommonlisp -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()
|