Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
#!/usr/bin/env lforth # (eev "cd ~/LFORTH/; ./yoneda.lforth") # (find-lforth "lforth") # (find-lforth "stdlib.lforth") # (find-lforth "kernel.lua") # (find-lforth "README") # (find-lua50ref "getglobals") # (find-lua50ref "Pattern Item" "followed by -") [lua heads["h_var"] = function () dspush(mem[ip]); ip = rspop(); state = states.forthret end dncterms = {} newdnc = function (tbl) local name = tbl.name dncterms[name] = tbl prim(name, function () dspush(dncterms[name]) end) return tbl end lua] :lua pp: local name = getword() local value = newdnc {name=name, cctype="atom"} compile(name, "h_var", value) dspush(value) lua; :lua newarrow: local whicharrow = getword() prim(whicharrow, function () local r = dspop() local l = dspop() local lname, rname if l.cctype=="atom" then lname=l.name else lname="("..l.name..")" end if r.cctype=="atom" then rname=r.name else rname="("..r.name..")" end local this = newdnc {lname=l.name, rname=r.name, name=lname..whicharrow..rname, cctype="arrow", cc=whicharrow} dspush(this) end) lua; :lua pp;pp local r = dspop() local l = dspop() dspush(newdnc {lname=l.name, rname=r.name, name=l.name..";"..r.name, cctype=";", cc=";"}) lua; newarrow: |-> newarrow: <-> newarrow: => newarrow: -.> pp: a drop pp: x drop pp: a^F drop pp: x^F drop # (a;x=>x^F)-.>(a^F<->(x-.>((a|->x)|->x^F))) a x x^F => pp;pp a^F x a x |-> x^F |-> -.> <-> -.> field: name field: cctype field: cc :lua ->dnc ds[1] = dncterms[ds[1]] lua; field: lname : .l .lname ->dnc ; field: rname : .r .rname ->dnc ; dup .name . dup .l .name . dup .r .name . drop x-.>((a|->x)|->x^F) dup .name . .cc .