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