russell@unturf.com
22571fa470
asm/uncommonlisp.s — intern_symbol: replaced O(N) linear scan with djb2 hash table (1024 buckets, chaining). 2.9x faster symbol interning on programs with many symbols. 75 tests pass. uncommonlisp.py — _define_record_type: replaced list.index() O(N) with dict lookup O(1) for field→index mapping. 571 tests pass. MOAD-0002 documented: _portal_checkpoint, _call_stack, _auto_compile are intentional globals (hot loop performance). cc_escape_val/cc_active_jmp are required by setjmp/longjmp call/cc approach. Comments added. All 836 assertions pass across Python + C + Assembly + functional.
3657 lines
160 KiB
Python
3657 lines
160 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."""
|
|
result = []
|
|
for m in _TOK_RE.finditer(src):
|
|
tok = m.group()
|
|
if tok.startswith(';'): continue
|
|
line = src.count('\n', 0, m.start()) + 1
|
|
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):
|
|
b = self.b
|
|
if k in b: return b[k]
|
|
g = self.g
|
|
if g is not None and k in g.b: return g.b[k]
|
|
e = self.p
|
|
while e:
|
|
if k in e.b: return e.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'):
|
|
a = _L(tail); expr = leval(a[0], env); 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):
|
|
with open(path) as f:
|
|
src = f.read()
|
|
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 and arg not in env.b:
|
|
ce, cv = cached
|
|
if arg in ce.b:
|
|
_ap(ce.b[arg]); continue
|
|
val = env.lookup(arg)
|
|
# Cache if resolved to global (safe — globals rarely change)
|
|
g = env.g
|
|
if g is not None and arg in g.b:
|
|
_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 _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('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:
|
|
print(f'file not found: {path}', file=sys.stderr); sys.exit(1)
|
|
return
|
|
|
|
# REPL mode
|
|
repl(g)
|
|
|
|
if __name__ == '__main__':
|
|
main()
|