lisp.bend source
lisp.bend on the hub · documented module
import Base# Root of Lisp (PG) in Bend.# Faithful: atoms/pairs, quote/atom/eq/car/cdr/cons/cond, lambda, label,# assoc/pair/append helpers, code as data (LCell lists).# Refactored (forced by Bend): PG's mutually-recursive eval./evcon./evlis.# trio becomes ONE fuel-stepped CEK machine (l_run), because Bend has no# forward references / no mutual recursion, and `match` only inspects# parameters or pattern-bound variables. Fuel goes first, so every# self-call terminates by checker rule (args after a shrunk param are free).# Parallel from the start: TArgs evaluates head/tail as a parallel pair# (this IS evlis.), LEq/LCons evaluate both sides in parallel via frames,# l_batch runs whole programs in parallel. `l_batch_gpu` is the same# runner handed to the GPU with `!` (correct everywhere; GPU only wins# on uniform numeric work -- eval is divergent, so CPU stays faster).type LExp is Data: LNil{} LTrue{} LNum{val: U32} LSym{name: String} LCell{head: LExp, tail: LExp} LQuote{e: LExp} LAtom{e: LExp} LEq{a: LExp, b: LExp} LCar{e: LExp} LCdr{e: LExp} LCons{a: LExp, b: LExp} LCond{cls: LExp} LApp{fn: LExp, args: LExp} LLam{ps: LExp, body: LExp} LRec{name: String, ps: LExp, body: LExp} LClos{ps: LExp, body: LExp, env: Map<&2, LExp>} LClosR{name: String, ps: LExp, body: LExp, env: Map<&2, LExp>}type LK is Data: KDone{} KAtom{k: LK} KEqA{b: LExp, env: Map<&2, LExp>, k: LK} KEqB{a: LExp, k: LK} KCar{k: LK} KCdr{k: LK} KConsA{b: LExp, env: Map<&2, LExp>, k: LK} KConsB{a: LExp, k: LK} KAppF{args: LExp, env: Map<&2, LExp>, k: LK} KCondC{then: LExp, rest: LExp, env: Map<&2, LExp>, k: LK}type LTask is Data: TEval{e: LExp, env: Map<&2, LExp>, k: LK} TRet{k: LK, v: LExp} TArgs{es: LExp, env: Map<&2, LExp>} TCond{cls: LExp, env: Map<&2, LExp>, k: LK}def l_cons(+a: LExp, +b: LExp) -> LExp: LCell{a, b}def l_car(+e: LExp) -> LExp: match e: case LCell{h, t}: h case _: LNil{}def l_cdr(+e: LExp) -> LExp: match e: case LCell{h, t}: t case _: LNil{}def l_is_atom(+e: LExp) -> Bool: match e: case LCell{h, t}: False{} case _: True{}def l_bool(b: Bool) -> LExp: match b: case True{}: LTrue{} case False{}: LNil{}# McCarthy eq: atoms only, like the original.def l_eq(+a: LExp, +b: LExp) -> Bool: match a: case LSym{x}: match b: case LSym{y}: String.eq(x, y) case _: False{} case LNum{m}: match b: case LNum{n}: U32.is_eq(m, n) case _: False{} case LNil{}: match b: case LNil{}: True{} case _: False{} case LTrue{}: match b: case LTrue{}: True{} case _: False{} case _: False{}# PG's append. (non-lists pass through so l_append_nil holds generally.)def l_append(+a: LExp, +b: LExp) -> LExp: match a: case LNil{}: b case LCell{h, t}: LCell{h, l_append(t, b)} case _: a# PG's pair.: zip param names with arg values into the env.def l_bind(+ps: LExp, +vs: LExp, env: Map<&2, LExp>) -> Map<&2, LExp>: match ps vs: case LCell{LSym{n}, pt} LCell{vh, vt}: l_bind(pt, vt, Map.set(&2, LExp, env, n, vh)) case LCell{ph, pt} LCell{vh, vt}: l_bind(pt, vt, env) case _ _: envdef l_pick(r: Map<&2, LExp> & LExp) -> LExp: (m, v) = r vdef l_run(+f: Nat, +t: LTask) -> LExp: match f: case 0n: LNil{} case 1n+p: match t: case TEval{e, env, k}: match e: case LNil{}: l_run(p, TRet{k, LNil{}}) case LTrue{}: l_run(p, TRet{k, LTrue{}}) case LNum{v}: l_run(p, TRet{k, LNum{v}}) case LSym{name}: l_run(p, TRet{k, l_pick(Map.get(LExp, LNil{}, env, name))}) case LCell{h, t}: l_run(p, TRet{k, LCell{h, t}}) case LQuote{e2}: l_run(p, TRet{k, e2}) case LAtom{e2}: l_run(p, TEval{e2, env, KAtom{k}}) case LEq{a, b}: l_run(p, TEval{a, env, KEqA{b, env, k}}) case LCar{e2}: l_run(p, TEval{e2, env, KCar{k}}) case LCdr{e2}: l_run(p, TEval{e2, env, KCdr{k}}) case LCons{a, b}: l_run(p, TEval{a, env, KConsA{b, env, k}}) case LCond{cls}: l_run(p, TCond{cls, env, k}) case LApp{fn, args}: l_run(p, TEval{fn, env, KAppF{args, env, k}}) case LLam{ps, body}: l_run(p, TRet{k, LClos{ps, body, env}}) case LRec{name, ps, body}: l_run(p, TRet{k, LClosR{name, ps, body, env}}) case _: l_run(p, TRet{k, LNil{}}) case TRet{k, v}: match k: case KDone{}: v case KAtom{k2}: l_run(p, TRet{k2, l_bool(l_is_atom(v))}) case KEqA{b, env, k2}: l_run(p, TEval{b, env, KEqB{v, k2}}) case KEqB{a, k2}: l_run(p, TRet{k2, l_bool(l_eq(a, v))}) case KCar{k2}: l_run(p, TRet{k2, l_car(v)}) case KCdr{k2}: l_run(p, TRet{k2, l_cdr(v)}) case KConsA{b, env, k2}: l_run(p, TEval{b, env, KConsB{v, k2}}) case KConsB{a, k2}: l_run(p, TRet{k2, LCell{a, v}}) case KAppF{args, env, k2}: match v: case LClos{ps, body, cenv}: av = l_run(p, TArgs{args, env}) l_run(p, TEval{body, l_bind(ps, av, cenv), k2}) case LClosR{name, ps, body, cenv}: av = l_run(p, TArgs{args, env}) env2 = l_bind(ps, av, cenv) l_run(p, TEval{body, Map.set(&2, LExp, env2, name, v), k2}) case _: l_run(p, TRet{k2, LNil{}}) case KCondC{then, rest, env, k2}: match v: case LTrue{}: l_run(p, TEval{then, env, k2}) case _: l_run(p, TCond{rest, env, k2}) case TArgs{es, env}: match es: case LNil{}: LNil{} case LCell{h, t}: hv tv = l_run(p, TEval{h, env, KDone{}}) l_run(p, TArgs{t, env}) LCell{hv, tv} case _: LNil{} case TCond{cls, env, k}: match cls: case LNil{}: l_run(p, TRet{k, LNil{}}) case LCell{cl, rest}: match cl: case LCell{test, tc}: match tc: case LCell{then, tt}: l_run(p, TEval{test, env, KCondC{then, rest, env, k}}) case _: l_run(p, TCond{rest, env, k}) case _: l_run(p, TCond{rest, env, k}) case _: l_run(p, TRet{k, LNil{}})def l_eval(+f: Nat, +e: LExp) -> LExp: l_run(f, TEval{e, Map.new(&2, LExp), KDone{}})# Whole programs are independent: fork-join over the list.def l_batch(+f: Nat, +es: List<&2, LExp>) -> List<&2, LExp>: match es: case Nil{}: Nil{} case Con{h, t}: r rs = l_eval(f, h) l_batch(f, t) Con{r, rs}def l_batch_gpu(+f: Nat, +es: List<&2, LExp>) -> List<&2, LExp>: l_batch!(f, es)def main() -> List<&2, LExp>: l_batch(50n, [LCar{LCons{LQuote{LSym{"a"}}, LQuote{LSym{"b"}}}}, LCond{LCell{LCell{LTrue{}, LCell{LQuote{LSym{"yes"}}, LNil{}}}, LNil{}}}])