forked from urbit/archaeology
-
Notifications
You must be signed in to change notification settings - Fork 0
Hoon ut
Adam Bliss edited this page Oct 25, 2013
·
1 revision
++ ut
~% %ut
+>+
==
%fan fan
%rib rib
%vet vet
%fab fab
%burn burn
%cull cull
%crop crop
%dunk dunk
%find find
%fink fink
%fire fire
%firm firm
%fish fish
%fuse fuse
%gain gain
%heal heal
%lose lose
%mint mint
%moot moot
%mull mull
%nest nest
%play play
%park park
%peek peek
%repo repo
%rest rest
%seek seek
%snap snap
%swab swab
%tack tack
%tock tock
%wrap wrap
==
=+ :* fan=*(set ,[type gene])
rib=*(set ,[type type gene])
vet=`?`&
fab=`?`&
==
=+ sut=`type`%noun
|%
++ burn
=+ gil=*(set type)
|- ^- *
?- sut
[%atom *] 0
[%cell *] [$(sut p.sut) $(sut q.sut)]
[%core *] [p.r.q.sut $(sut p.sut)]
[%cube *] p.sut
[%face *] $(sut repo)
[%fork *] $(sut p.sut)
[%hold *] ?: (~(has in gil) sut)
~! (dunk %type)
~|(%burn-loop !!)
$(sut repo, gil (~(put in gil) sut))
%noun 0
%void ~|(%burn-void !!)
==
::
++ crop
~/ %crop
|= ref=type
=+ bix=*(set ,[type type])
=< dext
|%
++ dext
^- type
~| %crop-dext
:: ~! (dunk 'dext: sut')
:: ~! (dunk(sut ref) 'dext: ref')
?: |(=(sut ref) =(%noun ref))
%void
?: =(%void ref)
sut
?- sut
[%atom *]
?- ref
[%atom *] %void
[%cell *] sut
* sint
==
::
[%cell *]
?- ref
[%atom *] sut
[%cell *] ?: (nest(sut p.ref) | p.sut)
(cell p.sut dext(sut q.sut, ref q.ref))
sut
* sint
==
::
[%core *]
?: ?=(?([%atom *] [%cell *]) ref)
sut
sint
::
[%cube *]
?: &(?=([%cube *] ref) =(p.sut p.ref))
%void
?: ?=(?([%atom *] [%cell *]) ref)
=+ foz=dext(sut q.sut)
?: (firm(sut foz) p.sut)
(cube p.sut foz)
%void
sint
::
[%face *] (face p.sut dext(sut q.sut))
[%fork *] (fork dext(sut p.sut) dext(sut q.sut))
[%hold *]
?: (~(has in bix) [sut ref])
~|(%crop-loop !!)
(reco |=(a=type dext(sut a, bix (~(put in bix) [sut ref]))))
::
%noun (reco |=(a=type dext(sut a)))
%void %void
==
::
++ sint
^- type
?- ref
[%core *] sut
[%cube *] sut
[%face *] dext(ref repo(sut ref))
[%fork *] dext(sut dext(ref p.ref), ref q.ref)
[%hold *] dext(ref repo(sut ref))
* !!
==
--
::
++ cull
~/ %cull
|= [pol=? axe=axis ref=type]
^- type
?: =(1 axe)
?:(pol (fuse ref) (crop ref))
=+ [now=(cap axe) lat=(mas axe)]
=+ vil=*(set type)
|- ^- type
?- sut
[%atom *] %void
[%cell *]
?: =(2 now)
(cell ^$(axe lat, sut p.sut) q.sut)
(cell p.sut ^$(axe lat, sut q.sut))
::
[%core *] ?.(=(3 now) sut (core ^$(axe lat, sut p.sut) q.sut))
[%cube *] (reco |=(p=type ^$(sut p)))
[%face *] (reco |=(p=type (face p.sut ^$(sut p))))
[%fork *]
?: (~(has in vil) sut)
%void
=> .(vil (~(put in vil) sut))
(fork $(sut p.sut) $(sut q.sut))
::
[%hold *] (reco |=(p=type ^$(sut p)))
%noun (reco |=(p=type ^$(sut p)))
%void %void
==
::
++ dank |=(pax=path ^-(tank (dish [~ %path] pax)))
++ dart |=(pax=path ^-(tape ~(ram re (dank pax))))
++ deal |=(lum=* (dish dole lum))
++ dial
|= ham=calf
=+ gid=*(set ,@ud)
|- ^- tank
?- q.ham
%noun [%leaf '*' ~]
%path [%leaf '/' ~]
%tank [%leaf '*' 't' ~]
%void [%leaf '#' ~]
%wool [%leaf '*' '"' '"' ~]
%wall [%leaf '*' '\'' '\'' ~]
%yarn [%leaf '"' '"' ~]
[%atom *] [%leaf '@' (trip p.q.ham)]
[%core *]
:+ %rose
[[' ' ~] ['<' ~] ['>' ~]]
|- ^- (list tank)
?~ p.q.ham
[^$(q.ham q.q.ham) ~]
[[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
::
[%face *]
[%palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] $(q.ham q.q.ham) ~]
::
[%list *]
[%rose [[' ' ~] (weld (trip p.q.ham) '(' ~) [')' ~]] $(q.ham q.q.ham) ~]
::
[%pick *]
:+ %rose
[[' ' ~] ['{' ~] ['}' ~]]
|- ^- (list tank)
?~(p.q.ham ~ [^$(q.ham i.p.q.ham) $(p.q.ham t.p.q.ham)])
::
[%plot *]
:+ %rose
[[' ' ~] ['[' ~] [']' ~]]
|- ^- (list tank)
?~(p.q.ham ~ [^$(q.ham i.p.q.ham) $(p.q.ham t.p.q.ham)])
::
[%pear *]
[%leaf '%' ~(rend co [~ p.q.ham q.q.ham])]
::
[%stop *]
?: (~(has in gid) p.q.ham)
[%leaf '$' ~(rend co [~ %ud p.q.ham])]
:+ %palm
[['.' ~] ['^' '$' ~(rend co [~ %ud p.q.ham])] ~ ~]
[$(gid (~(put in gid) p.q.ham), q.ham (need (~(get by p.ham) p.q.ham))) ~]
::
[%tree *]
[%rose [[' ' ~] (weld (trip p.q.ham) '(' ~) [')' ~]] $(q.ham q.q.ham) ~]
::
[%unit *]
[%rose [[' ' ~] (weld (trip p.q.ham) '(' ~) [')' ~]] $(q.ham q.q.ham) ~]
==
::
++ dish
|= [ham=calf lum=*] ^- tank
~| [%dish-h ?@(q.ham q.ham -.q.ham)]
:: ~| [%lump lum]
%- need
|- ^- (unit tank)
?- q.ham
%noun
%= $
q.ham
?: ?=(@ lum)
[%atom %$]
:- %plot
|- ^- (list wine)
[%noun ?:(?=(@ +.lum) [[%atom %$] ~] $(lum +.lum))]
==
::
%path
:- ~
:+ %rose
[['/' ~] ['/' ~] ~]
|- ^- (list tank)
?@ lum
?>(?=(~ lum) ~)
?> ?=(@ -.lum)
[[%leaf (rip 3 -.lum)] $(lum +.lum)]
::
%tank
=+ cis=(tank lum)
?.(=(lum cis) ~ [~ cis])
::
%wall
:- ~
:+ %rose
[[' ' ~] ['<' '|' ~] ['|' '>' ~]]
|- ^- (list tank)
?@ lum
?>(?=(~ lum) ~)
[[%leaf (trip ((hard ,@) -.lum))] $(lum +.lum)]
::
%wool
:- ~
:+ %rose
[[' ' ~] ['<' '<' ~] ['>' '>' ~]]
|- ^- (list tank)
?@ lum
?>(?=(~ lum) ~)
[(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
::
%yarn
[~ %leaf '"' (weld (tape lum) `tape`['"' ~])]
::
%void
~
::
[%atom *]
?. ?=(@ lum)
~
:+ ~
%leaf
?: =(%$ p.q.ham) ~(rend co [~ %ud lum])
?: &(=(%ta p.q.ham) !=(0 lum)) ['\'' (weld (rip 3 lum) ['\'' ~])]
?: =(%tas p.q.ham) ['%' (rip 3 lum)]
~(rend co [~ p.q.ham lum])
::
[%core *]
:: XX needs rethinking for core metal
:: ?. ?=(^ lum) ~
:: => .(lum `*`lum)
:: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
:: ^= tok
:: |- ^- (unit (list tank))
:: ?~ p.q.ham
:: =+ den=^$(q.ham q.q.ham)
:: ?~(den ~ [~ u.den ~])
:: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum)
:: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
[~ (dial ham)]
::
[%face *]
=+ wal=$(q.ham q.q.ham)
?~ wal
~
[~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
::
[%list *]
?: =(~ lum)
[~ %leaf '~' ~]
=- ?~ tok
~
[~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?: ?=(@ lum)
?.(=(~ lum) ~ [~ ~])
=+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
?. &(?=(^ for) ?=(^ aft))
~
[~ u.for u.aft]
::
[%pick *]
|- ^- (unit tank)
?~ p.q.ham
~
=+ wal=^$(q.ham i.p.q.ham)
?~ wal
$(p.q.ham t.p.q.ham)
wal
::
[%plot *]
=- ?~ tok
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?~ p.q.ham
~
?: ?=([* ~] p.q.ham)
=+ wal=^$(q.ham i.p.q.ham)
?~(wal ~ [~ [u.wal ~]])
?@ lum
~
=+ gim=^$(q.ham i.p.q.ham, lum -.lum)
?~ gim
~
=+ myd=$(p.q.ham t.p.q.ham, lum +.lum)
?~ myd
~
[~ u.gim u.myd]
::
[%pear *]
?. =(lum q.q.ham)
~
=+ fox=~(rend co [~ p.q.ham q.q.ham])
[~ %leaf ?:(=(['~' ~] fox) fox ['%' fox])]
::
[%stop *]
=+ kep=(~(get by p.ham) p.q.ham)
?~ kep
~|([%stop-loss p.q.ham] !!)
$(q.ham u.kep)
::
[%tree *]
=- ?~ tok
~
[~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
^= tok
=+ tuk=*(list tank)
|- ^- (unit (list tank))
?: =(~ lum)
[~ tuk]
?. ?=([n=* l=* r=*] lum)
~
=+ rol=$(lum r.lum)
?~ rol
~
=+ tim=^$(q.ham q.q.ham, lum n.lum)
?~ tim
~
$(lum l.lum, tuk [u.tim u.rol])
::
[%unit *]
?@ lum
?.(=(~ lum) ~ [~ %leaf '~' ~])
?. =(~ -.lum)
~
=+ wal=$(q.ham q.q.ham, lum +.lum)
?~ wal
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
==
::
++ doge
|= ham=calf
=- ?+ woz woz
[%list * [%atom 'ta']] %path
[%list * [%atom 't']] %wall
[%list * [%atom 'tD']] %yarn
[%list * %yarn] %wool
==
^= woz
^- wine
?. ?=([%stop *] q.ham)
?: ?& ?= [%pick [%pear %n 0] [%plot [%pear %n 0] [%face *] ~] ~]
q.ham
=(1 (met 3 p.i.t.p.i.t.p.q.ham))
==
[%unit =<([p q] i.t.p.i.t.p.q.ham)]
q.ham
=+ may=(~(get by p.ham) p.q.ham)
?~ may
q.ham
?. ?& ?=([%pick *] u.may)
?=(^ p.u.may)
=([%pear %n 0] i.p.u.may)
==
q.ham
?: ?& ?=([[%plot [%face *] [%face * %stop *] ~] ~] t.p.u.may)
=(p.q.ham p.q.i.t.p.i.t.p.u.may)
=(1 (met 3 p.i.p.i.t.p.u.may))
=(1 (met 3 p.i.t.p.i.t.p.u.may))
==
:+ %list
(cat 3 p.i.p.i.t.p.u.may p.i.t.p.i.t.p.u.may)
q.i.p.i.t.p.u.may
?: ?& ?= :- :^ %plot
[%face *]
[%face * %stop *]
[[%face * %stop *] ~]
~
t.p.u.may
=(p.q.ham p.q.i.t.p.i.t.p.u.may)
=(p.q.ham p.q.i.t.t.p.i.t.p.u.may)
=(1 (met 3 p.i.p.i.t.p.u.may))
=(1 (met 3 p.i.t.p.i.t.p.u.may))
=(1 (met 3 p.i.t.t.p.i.t.p.u.may))
==
:+ %tree
%^ cat
3
p.i.p.i.t.p.u.may
(cat 3 p.i.t.p.i.t.p.u.may p.i.t.t.p.i.t.p.u.may)
q.i.p.i.t.p.u.may
q.ham
::
++ dole
^- calf
=+ gil=*(set type)
=+ dex=[p=*(map type ,@) q=*(map ,@ wine)]
=< [q.p q]
|- ^- [p=[p=(map type ,@) q=(map ,@ wine)] q=wine]
=- [p.tez (doge q.p.tez q.tez)]
^= tez
^- [p=[p=(map type ,@) q=(map ,@ wine)] q=wine]
?- sut
%noun [dex sut]
%void [dex sut]
[%atom *] [dex sut]
[%cell *]
=+ hin=$(sut p.sut)
=+ yon=$(dex p.hin, sut q.sut)
:- p.yon
:- %plot
?:(?=([%plot *] q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
::
[%core *]
=+ yad=$(sut p.sut)
:- p.yad
=+ ^= doy ^- [p=(list ,@ta) q=wine]
?: ?=([%core *] q.yad)
[p.q.yad q.q.yad]
[~ q.yad]
:- %core
:_ q.doy
:_ p.doy
%^ cat 3
%~ rent co
:+ ~ %ud
|- ^- @
?- q.r.q.sut
~ 0
[* ~ ~] 1
[* ~ *] +($(q.r.q.sut r.q.r.q.sut))
[* * ~] +($(q.r.q.sut l.q.r.q.sut))
[* * *] .+ %+ add
$(q.r.q.sut l.q.r.q.sut)
$(q.r.q.sut r.q.r.q.sut)
==
%^ cat 3
?-(p.q.sut %gold '.', %iron '|', %lead '?', %zinc '&')
=+ gum=(mug q.r.q.sut)
%+ can 3
:~ [1 (add 'a' (mod gum 26))]
[1 (add 'a' (mod (div gum 26) 26))]
[1 (add 'a' (mod (div gum 676) 26))]
==
::
[%cube *]
?. ?=(@ p.sut)
$(sut repo)
=+ pum=$(sut q.sut)
?> ?=([%atom *] q.pum)
[p.pum [%pear p.q.pum p.sut]]
::
[%face *]
=+ yad=$(sut q.sut)
[p.yad [%face p.sut q.yad]]
::
[%fork *]
=+ hin=$(sut p.sut)
=+ yon=$(dex p.hin, sut q.sut)
:- p.yon
?: =(%void q.hin)
q.yon
?: |(=(%void q.yon) =(q.hin q.yon))
q.hin
:- %pick
?. ?=([%pick *] q.yon)
[q.hin q.yon ~]
?> ?=(^ p.q.yon)
?:(=(q.hin i.p.q.yon) p.q.yon [q.hin p.q.yon])
::
[%hold *]
=+ hey=(~(get by p.dex) sut)
?^ hey
[dex [%stop u.hey]]
?: (~(has in gil) sut)
=+ dyr=~(wyt by p.dex)
[[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
=+ rom=$(gil (~(put in gil) sut), sut repo)
=+ rey=(~(get by p.p.rom) sut)
?~ rey
rom
[[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
==
::
++ duck ^-(tank (dial dole))
++ dunk
|= paz=term ^- tank
:+ %palm
[['.' ~] ['-' ~] ~ ~]
[[%leaf (mesc (trip paz))] duck ~]
::
++ find
~/ %find
|= [dep=@ud way=?(%read %rite) cog=term]
=+ gil=*(set type)
|- ^- [p=@ud q=(unit port)]
?+ sut [dep ~]
[%cell *]
=+ taf=$(sut p.sut)
?~ q.taf
=+ bov=$(dep p.taf, sut q.sut)
?~ q.bov
bov
[p.bov ~ (peg 3 p.u.q.bov) q.u.q.bov]
[p.taf ~ (peg 2 p.u.q.taf) q.u.q.taf]
::
[%core *]
=+ zem=(look cog q.r.q.sut)
=> ^+(. ?:(|(=(~ zem) =(0 dep)) . .(dep (dec dep), zem ~)))
?^ zem
[dep ~ 1 [%| (peg 2 p.u.zem) [[sut(p.q %gold) q.u.zem] ~]]]
=+ taf=$(sut p.sut)
?~ q.taf
taf
?. (park way p.u.q.taf)
~|(%find-park !!)
[p.taf ~ (peg 3 p.u.q.taf) q.u.q.taf]
::
[%cube *]
$(sut repo)
::
[%face *]
?: =(cog p.sut)
?. ?=(0 dep)
[(dec dep) ~]
[0 ~ 1 %& q.sut]
[dep ~]
::
[%fork *]
~| %fork
?: (~(has in gil) q.sut)
$(sut p.sut)
?: (~(has in gil) p.sut)
$(sut q.sut)
=+ [hax=$(sut p.sut) yor=$(sut q.sut)]
~| %find-fork
?: =(hax yor)
hax
?~ q.hax
?~ q.yor
?>(=(hax yor) hax)
?> =(0 p.hax)
?>((nest(sut %void) | (peek(sut p.sut) way p.u.q.yor)) yor)
?~ q.yor
?> =(0 p.yor)
?>((nest(sut %void) | (peek(sut q.sut) way p.u.q.hax)) hax)
?> =(p.u.q.hax p.u.q.yor)
:- 0
?- -.q.u.q.hax
&
?- -.q.u.q.yor
& [~ p.u.q.hax %& (fork p.q.u.q.hax p.q.u.q.yor)]
| !!
==
::
|
?- -.q.u.q.yor
& !!
|
?> =(p.q.u.q.yor p.q.u.q.hax)
[~ p.u.q.hax %| p.q.u.q.hax (weld q.q.u.q.hax q.q.u.q.yor)]
==
==
::
[%hold *]
?: (~(has in gil) sut)
[dep ~]
$(gil (~(put in gil) sut), sut repo)
==
::
++ fink
~/ %fink
|= [dep=@ud way=?(%read %rite) cog=term]
^- port
:: ~! (dunk 'type')
~! (show [%c 'find-limb'] ?:(=(%$ cog) '$' [%a cog]))
=+ hoq=(find dep way cog)
?~ q.hoq
~|(%find-none !!)
u.q.hoq
::
++ fire
~/ %fire
|= hag=(list ,[p=type q=foot])
^- type
?: ?=([[* [%elm ~ 1]] ~] hag)
p.i.hag
:- %hold
%+ turn
hag.$
|= [p=type q=foot]
?. ?=([%core *] p)
~|(%fire-core !!)
=+ dox=[%core q.q.p q.p]
?: ?=(%ash -.q)
~| %fire-ash
:: ~! (dunk(sut [%cell q.q.p p.p]) %fire-dry)
?> ?|(!vet (nest(sut q.q.p) & p.p))
[dox p.q]
~| [%fire-odd -.q]
?> ?=(%elm -.q)
~| %fire-elm
:: ~! (dunk(sut [%cell q.q.p p.p]) %fire-wet)
?> ?| !vet
(~(has in rib) [sut dox p.q])
(mull(sut p, rib (~(put in rib) [sut dox p.q])) %noun dox p.q)
==
[p p.q]
::
++ firm
~/ %firm
|= dib=*
=+ bix=*(set ,[type *])
|- ^- ?
?- sut
[%atom *] !.?(dib)
[%cell *] &(.?(dib) $(sut p.sut, dib -.dib) $(sut q.sut, dib +.dib))
[%core *]
?& .?(dib)
$(sut p.sut, dib -.dib)
=(+.dib ?:(=(~ p.r.q.sut) ~|(%firm-core !!) p.r.q.sut))
==
::
[%cube *] =(dib p.sut)
[%face *] $(sut q.sut)
[%fork *] |($(sut p.sut) $(sut q.sut))
[%hold *]
?| (~(has in bix) [sut dib])
$(bix (~(put in bix) [sut dib]), sut repo)
==
::
%noun &
%void |
==
::
++ fish
~/ %fish
|= axe=axis
=+ vot=*(set type)
|-
^- tool
?- sut
[%atom *] (flip [%3 %0 axe])
%void [%1 1]
%noun [%1 0]
::
[%cell *]
%+ flan
[%3 %0 axe]
(flan $(sut p.sut, axe (peg axe 2)) $(sut q.sut, axe (peg axe 3)))
::
[%core *] [%0 0]
[%cube *] [%5 [%1 p.sut] [%0 axe]]
[%face *] $(sut q.sut)
[%fork *] (flor $(sut p.sut) $(sut q.sut))
[%hold *]
?: (~(has in vot) sut)
[%0 0]
=> %=(. vot (~(put in vot) sut))
$(sut repo)
==
::
++ fuse
~/ %fuse
|= ref=type
=+ bix=*(set ,[type type])
|- ^- type
?: ?|(=(sut ref) =(%noun ref))
sut
?- sut
[%atom *]
?- ref
[%atom *] ?:((fitz p.ref p.sut) sut ref)
[%cell *] %void
* $(sut ref, ref sut)
==
::
[%cell *]
?- ref
[%cell *] (cell $(sut p.sut, ref p.ref) $(sut q.sut, ref q.ref))
* $(sut ref, ref sut)
==
::
[%core *] $(sut repo)
[%cube *]
=+ foz=$(sut q.sut)
?: (firm(sut foz) p.sut)
(cube p.sut foz)
%void
::
[%face *] (face p.sut $(sut q.sut))
[%fork *] (fork $(sut p.sut) $(sut q.sut))
[%hold *]
?: (~(has in bix) [sut ref])
~|(%fuse-loop !!)
(reco |=(a=type ^$(sut a, bix (~(put in bix) [sut ref]))))
::
%noun ref
%void %void
==
::
++ gain
~/ %gain
|= gen=gene ^- type
(chip & gen)
::
++ hang
~/ %hang
|= [dab=(map term foot) rud=(map term foot)]
^- (map term foot)
=+ goy=(~(tap by rud) ~)
=+ waf=dab
|- ^+ dab
?@ goy
waf
~| [%hang-on p.i.goy]
=+ yeq=(~(get by dab) p.i.goy)
?< ?=(~ yeq)
?- -.u.yeq
%ash
?> ?=([%ash *] q.i.goy)
$(goy t.goy, waf (~(put by waf) p.i.goy q.i.goy))
::
%elm
~|([%hang-elm p.i.goy] !!)
::
%oak
?> ?=([%yew *] q.i.goy)
$(goy t.goy, waf (~(put by waf) p.i.goy q.i.goy))
::
%yew
?> ?=([%yew *] q.i.goy)
%= $
goy t.goy
waf
%+ ~(put by waf)
p.i.goy
[%yew ^$(dab p.u.yeq, rud p.q.i.goy)]
==
==
::
++ hail
|= [dab=(map term foot) waf=(map term foot)]
=+ axe=1
=+ dif=*(list ,[p=axis q=tool])
|- ^+ dif
?~ dab
?>(?=(~ waf) dif)
=+ ^= goh
?- dab
[* ~ ~] [p=axe q=dif]
[* ~ *]
[p=(peg axe 2) q=$(dab r.dab, waf r.waf, axe (peg axe 3))]
::
[* * ~]
[p=(peg axe 2) q=$(dab l.dab, waf l.waf, axe (peg axe 3))]
::
[* * *]
:- p=(peg axe 2)
^= q
%= $
dif $(dab l.dab, waf l.waf, axe (peg axe 6))
dab r.dab
waf r.waf
axe (peg axe 7)
==
==
?> =(p.n.dab p.n.waf)
?: =(q.n.dab q.n.waf)
q.goh
:- :- p.goh
:- %1
?+ -.q.n.waf !!
%ash q:(mint %noun p.q.n.waf)
%yew (harp p.q.n.waf)
==
q.goh
::
++ harp
|= dab=(map term foot)
^- ?(~ ^)
?: ?=(~ dab)
~
=+ ^= vad
?+ -.q.n.dab !!
%ash q:(mint %noun p.q.n.dab)
%elm q:(mint(vet |) %noun p.q.n.dab)
==
?- dab
[* ~ ~] vad
[* ~ *] [vad $(dab r.dab)]
[* * ~] [vad $(dab l.dab)]
[* * *] [vad $(dab l.dab) $(dab r.dab)]
==
::
++ heir
~/ %heir
|= rud=(map term foot) ^- type
?. ?=([%core *] sut)
$(sut repo)
?. |(!vet =(%gold p.q.sut))
~|(%heir-metl !!)
sut(q.r.q (hang q.r.q.sut rud), q.q p.sut) :: XX handle elm
::
++ lose
~/ %lose
|= gen=gene ^- type
(chip | gen)
::
++ chip
~/ %chip
|= [way=? gen=gene] ^- type
?: ?=([%wtcn *] gen)
(cull way p:(seek %read ~(rake ap q.gen)) (play p.gen))
?: ?&(way ?=([%wtpm *] gen))
|-(?@(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
?: ?&(!way ?=([%wtbr *] gen))
|-(?@(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
=+ neg=~(open ap gen)
?:(=(neg gen) sut $(gen neg))
::
++ heal
~/ %heal
|= [qog=(unit term) axe=axis ref=type]
^- type
?: =(1 axe)
?@ qog
ref
|- ^- type
?- sut
[%core *] ref
[%face *] ?.(=(u.qog p.sut) ~|('heal-name' !!) (face p.sut ref))
[%fork *] (fork $(sut p.sut) $(sut q.sut))
[%hold *] $(sut repo)
* ~|([%name u.qog] ~|('heal-name' !!))
==
=+ [now=(cap axe) lat=(mas axe)]
=+ gil=*(set type)
|- ^- type
?- sut
[%atom *] %void
[%cell *]
?: =(2 now)
(cell ^$(sut p.sut, axe lat) q.sut)
(cell p.sut ^$(sut q.sut, axe lat))
::
[%core *]
?. =(3 now)
~|(%heal-core !!)
(core ^$(sut p.sut, axe lat) q.sut)
::
[%fork *] (fork $(sut p.sut) $(sut q.sut))
[%hold *]
?:((~(has in gil) sut) %void $(gil (~(put in gil) sut), sut repo))
::
* $(sut repo)
==
::
++ mint
~/ %mint
|= [gol=type gen=gene]
^- [p=type q=tool]
|^ ^- [p=type q=tool]
?: ?&(=(%void sut) !?=([%zpcb *] gen))
?. |(!vet ?=([%zpfs *] gen) ?=([%zpzp *] gen))
~|(%mint-vain !!)
[%void %0 0]
?- gen
::
[^ *]
=+ hed=$(gen p.gen, gol %noun)
=+ tal=$(gen q.gen, gol %noun)
[(nice (cell p.hed p.tal)) (cons q.hed q.tal)]
::
[%brcn *] (grow %gold [~ 1] p.gen)
[%brcl *]
~| %brcl
=+ heq=$(gen p.gen)
=+ cow=|-(?:(?=([%core *] p.heq) p.heq $(p.heq repo(sut p.heq))))
?. |(!vet =(%gold p.q.cow))
~|(%heir-metl !!)
=+ vir=(hang q.r.q.cow q.gen)
=+ nep=cow(q.r.q vir, q.q p.cow)
=+ bop=cow(p q.q.cow)
?> |(!vet (nest(sut (wrap(sut bop) %zinc)) & (wrap(sut nep) %zinc)))
:- (nice nep)
:+ %8
q.heq
:- (hike 4 (hail(sut nep) q.r.q.cow vir))
[%0 5]
::
[%cnts *]
=+ lar=(foil (seek %read p.gen))
=+ mew=(swab q.gen)
=- [(nice p.yom) ?:(=(0 p.q.lar) q.yom [%9 p.q.lar q.yom])]
^= yom
=+ hej=*(list ,[p=axis q=tool])
|- ^- [p=type q=tool]
?@ mew
[(fire q.q.lar) (hike p.lar hej)]
=+ zil=^$(gen q.i.mew, gol %noun)
=+ wip=(tock p.i.mew p.zil q.q.lar)
$(mew t.mew, q.q.lar q.wip, hej [[p.wip q.zil] hej])
::
[%dtkt *] [(nice %noun) [%11 q:$(gen p.gen, gol %noun)]]
[%dtls *] [(nice [%atom %$]) [%4 q:$(gen p.gen, gol [%atom %$])]]
[%dtpt *] [(nice (play gen)) [%1 q.gen]]
[%dtsg *] [(nice (play gen)) [%1 q.gen]]
[%dttr *]
[(nice %noun) [%2 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
::
[%dtts *]
[(nice bean) [%5 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
::
[%dtwt *] [(nice bean) [%3 q:$(gen p.gen, gol %noun)]]
[%ktbr *] =+(vat=$(gen p.gen) [(wrap(sut p.vat) %iron) q.vat])
[%ktdt *] $(gen (snap(sut (play p.gen)) q.gen))
[%ktls *]
=+(hif=(nice (play p.gen)) [hif q:$(gen q.gen, gol hif)])
::
[%ktpm *] =+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) q.vat])
[%ktsg *]
=+ nef=$(gen p.gen)
=+ moc=(mink [burn q.nef] |=(* ~))
[p.nef ?:(?=(0 -.moc) [%1 p.moc] q.nef)]
::
[%ktts *] =+(vat=$(gen q.gen) [(face p.gen p.vat) q.vat])
[%ktwt *] =+(vat=$(gen p.gen) [(wrap(sut p.vat) %lead) q.vat])
::
[%sggr *]
=+ hum=$(gen q.gen)
:- p.hum
:+ %10
?- p.gen
@ p.gen
^ [p.p.gen q:$(gen q.p.gen, gol %noun)]
==
q.hum
::
[%tsgr *]
=+ fid=$(gen p.gen, gol %noun)
=+ dov=$(sut p.fid, gen q.gen)
[p.dov (comb q.fid q.dov)]
::
[%wtcl *]
=+ nor=$(gen p.gen, gol bean)
=+ fex=(gain p.gen)
=+ wux=(lose p.gen)
=+ ^= duy
?: =(%void fex)
?:(=(%void wux) [%0 0] [%1 1])
?:(=(%void wux) [%1 0] q.nor)
=+ hiq=$(sut fex, gen q.gen)
=+ ran=$(sut wux, gen r.gen)
[(fork p.hiq p.ran) (cond duy q.hiq q.ran)]
::
[%wtcn *]
[(nice bean) (fish(sut (play p.gen)) (cove q:$(gen q.gen, gol %noun)))]
::
[%zpcb *]
~! (show %o p.gen)
=+ hum=$(gen q.gen)
[p.hum [%10 [%spot %1 p.gen] q.hum]]
::
[%zpcm *] [(nice (play p.gen)) [%1 q.gen]]
[%zpcn ~] =+(pet=seed [(nice p.pet) [%1 q.pet]])
[%zpfs *]
?: vet
~! (dunk(sut (play p.gen)) 'lost')
~|(%mint-lost !!)
[%void [%0 0]]
::
[%zpsm *]
=+ vos=$(gol %noun, gen q.gen) :: XX validate!
[(nice (cell (play p.gen) p.vos)) (cons [%1 p.vos] q.vos)]
::
[%zpts *] [(nice %noun) [%1 q:$(vet |, gen p.gen)]]
[%zpzp ~] [%void [%0 0]]
*
=+ doz=~(open ap gen)
?: =(doz gen)
~! (show [%c 'gene'] [%q gen])
~|(%mint-open !!)
$(gen doz)
==
::
++ nice
|= typ=type
~| %mint-nice
?> ?|(!vet (nest(sut gol) & typ))
typ
::
++ grow
|= [mel=?(%gold %iron %lead %zinc) ruf=gene dab=(map term foot)]
^- [p=type q=tool]
=+ dan=^$(gen ruf, gol %noun)
=+ toc=(core p.dan [%gold p.dan [~ dab]])
=+ dez=(harp(sut toc) dab)
:- (nice (core p.dan mel p.dan [dez dab]))
(cons [%1 dez] q.dan)
--
::
++ moot
=+ gil=*(set type)
|- ^- ?
?- sut
[%atom *] |
[%cell *] |($(sut p.sut) $(sut q.sut))
[%core *] $(sut p.sut)
[%cube *] |
[%face *] $(sut q.sut)
[%fork *] &($(sut p.sut) $(sut q.sut))
[%hold *] |((~(has in gil) sut) $(gil (~(put in gil) sut), sut repo))
%noun |
%void &
==
::
++ mull
~/ %mull
|= [gol=type dox=type gen=gene]
^- ?
?. vet
&
=< &
|^ ^- [p=type q=type]
?: =(%void sut)
~|(%mull-none !!)
?- gen
::
[^ *]
=+ hed=$(gen p.gen, gol %noun)
=+ tal=$(gen q.gen, gol %noun)
[(nice (cell p.hed p.tal)) (cell q.hed q.tal)]
::
[%brcn *] (grow %gold [~ 1] p.gen)
[%brcl *]
=+ gaf=$(gen p.gen, gol %noun)
=+ toc=[p=(heir(sut p.gaf) q.gen) q=(heir(sut q.gaf) q.gen)]
?> (nest(sut (wrap(sut p.gaf) %zinc)) & (wrap(sut p.toc) %zinc))
=+ (bake(sut p.toc, dox q.toc) q.gen)
[(nice p.toc) q.toc]
::
[%cnts *]
=+ lar=(foil (seek %read p.gen))
=+ vug=(foil (seek(sut dox) %read p.gen))
?. &(=(p.lar p.vug) =(p.q.lar p.q.vug))
~|(%mull-bonk-e !!)
=+ mew=(swab q.gen)
=- [(nice (fire p.yom)) (fire(vet |) q.yom)]
^= yom
|- ^- [p=(list ,[p=type q=foot]) q=(list ,[p=type q=foot])]
?@ mew
[q.q.lar q.q.vug]
=+ zil=^$(gen q.i.mew, gol %noun)
=+ cuf=(tock p.i.mew p.zil q.q.lar)
=+ dof=(tock p.i.mew q.zil q.q.vug)
?. .=(p.cuf p.dof)
~|(%mull-bonk-f !!)
$(mew t.mew, q.q.lar q.cuf, q.q.vug q.dof)
::
[%dtkt *] =+($(gen p.gen, gol %noun) (both %noun))
[%dtls *] =+($(gen p.gen, gol [%atom %$]) (both [%atom %$]))
[%dtpt *] (both (play gen))
[%dtsg *] (both (play gen))
[%dttr *]
=+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (both %noun))
::
[%dtts *]
=+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (both bean))
::
[%dtwt *] =+($(gen p.gen, gol %noun) (both bean)) :: XX =|
[%ktbr *]
=+(vat=$(gen p.gen) [(wrap(sut p.vat) %iron) (wrap(sut q.vat) %iron)])
::
[%ktdt *]
=+ wiv=[p=(play p.gen) q=(play(sut dox) p.gen)]
=+ hef=[p=(snap(sut p.wiv) q.gen) q=(snap(sut q.wiv) q.gen)]
?: =(p.hef q.hef)
$(gen p.hef)
=+ zyn=$(gen p.hef)
[p.zyn (play(sut dox) q.hef)]
::
[%ktls *]
=+ hif=[p=(nice (play p.gen)) q=(play(sut dox) p.gen)]
=+($(gen q.gen, gol p.hif) hif)
::
[%ktpm *]
=+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) (wrap(sut q.vat) %zinc)])
::
[%ktts *]
=+(vat=$(gen q.gen) [(face p.gen p.vat) (face p.gen q.vat)])
::
[%ktwt *]
=+(vat=$(gen p.gen) [(wrap(sut p.vat) %lead) (wrap(sut q.vat) %lead)])
::
[%ktsg *] $(gen p.gen)
[%sggr *] $(gen q.gen)
[%tsgr *]
=+ lem=$(gen p.gen, gol %noun)
$(gen q.gen, sut p.lem, dox q.lem)
::
[%wtcl *]
=+ nor=$(gen p.gen, gol bean)
=+ ^= hiq ^- [p=type q=type]
=+ fex=[p=(gain p.gen) q=(gain(sut dox) p.gen)]
?: =(%void p.fex)
[%void ?:(=(%void q.fex) %void ~|(%wtcl-z (play(sut q.fex) q.gen)))]
?: =(%void q.fex)
~|(%mull-bonk-b !!)
$(sut p.fex, dox q.fex, gen q.gen)
=+ ^= ran ^- [p=type q=type]
=+ wux=[p=(lose p.gen) q=(lose(sut dox) p.gen)]
?: =(%void p.wux)
[%void ?:(=(%void q.wux) %void ~|(%wtcl-a (play(sut q.wux) r.gen)))]
?: =(%void q.wux)
~|(%mull-bonk-c !!)
$(sut p.wux, dox q.wux, gen r.gen)
[(nice (fork p.hiq p.ran)) (fork q.hiq q.ran)]
::
[%wtcn *]
=+ waz=[p=(play p.gen) q=(play(sut dox) p.gen)]
=+ ^= syx :- p=(cove q:(mint %noun q.gen))
q=(cove q:(mint(sut dox) %noun q.gen))
=+ pov=[p=(fish(sut p.waz) p.syx) q=(fish(sut q.waz) q.syx)]
?. &(=(p.syx q.syx) =(p.pov q.pov))
~|(%mull-bonk-a !!)
(both bean)
::
[%zpcb *] ~!((show %o p.gen) $(gen q.gen))
[%zpcm *] [(nice (play p.gen)) (play(sut dox) p.gen)]
[%zpcn ~] =+(pet=seed [(nice p.pet) p.pet])
[%zpfs *]
?: vet
:: ~! (dunk(sut (play p.gen)) 'also')
~|(%mull-skip !!)
(both %void)
::
[%zpts *] (both %noun)
[%zpsm *]
=+ vos=$(gol %noun, gen q.gen) :: XX validate!
[(nice (cell (play p.gen) p.vos)) (cell (play(sut dox) p.gen) q.vos)]
::
[%zpzp ~] (both %void)
*
=+ doz=~(open ap gen)
?: =(doz gen)
~! (show [%c 'gene'] [%q gen])
~|(%mull-open !!)
$(gen doz)
==
::
++ both
|= typ=type
[(nice typ) typ]
::
++ nice
|= typ=type
:: ~! (dunk(sut gol) 'need')
:: ~! (dunk(sut typ) 'have')
~| %mull-nice
?> ?|(!vet (nest(sut gol) & typ))
typ
::
++ grow
|= [mel=?(%gold %iron %lead %zinc) ruf=gene dab=(map term foot)]
~| %mull-grow
^- [p=type q=type]
=+ dan=^$(gen ruf, gol %noun)
=+ ^= toc :- p=(core p.dan [%gold p.dan [~ dab]])
q=(core q.dan [%gold q.dan [~ dab]])
=+ (bake(sut p.toc, dox q.toc) dab)
:- (nice (core p.dan mel p.dan [[%0 0] dab]))
(core q.dan [mel q.dan [[%0 0] dab]])
::
++ bake
|= dab=(map term foot)
^- *
?: ?=(~ dab)
~
=+ ^= vad
?+ -.q.n.dab !!
%ash ^$(gol %noun, gen p.q.n.dab)
%elm ~
==
?- dab
[* ~ ~] vad
[* ~ *] [vad $(dab r.dab)]
[* * ~] [vad $(dab l.dab)]
[* * *] [vad $(dab l.dab) $(dab r.dab)]
==
--
::
++ meet |=(ref=type &((nest | ref) (nest(sut ref) | sut)))
++ nest
~/ %nest
|= [tel=? ref=type]
^- ?
=+ gil=*(set ,[p=type q=type])
=< dext
|%
++ cong
^- ?
?> ?&(?=([%core *] sut) ?=([%core *] ref))
?: =(q.sut q.ref)
dext(sut p.sut, ref p.ref)
?. ?& dext(sut q.q.sut, ref p.sut)
dext(sut p.sut, ref q.q.sut)
dext(sut q.q.ref, ref p.ref)
==
|
?&
?|(=(p.q.sut p.q.ref) =(%gold p.q.ref))
::
?| (~(has in gil) [sut ref])
%+ %= cram
gil (~(put in gil) [sut ref])
sut sut(p q.q.sut)
ref ref(p q.q.ref)
==
q.r.q.sut
q.r.q.ref
==
::
?- p.q.sut
%gold
=+ pac=[s=q.q.sut r=q.q.ref]
?& dext(sut s.pac, ref r.pac)
dext(sut r.pac, ref s.pac)
==
::
%iron
=+ sam=[s=(peek(sut q.q.sut) %rite 2) r=(peek(sut q.q.ref) %rite 2)]
dext(sut r.sam, ref s.sam)
::
%lead &
%zinc
=+ pal=[s=(peek(sut q.q.sut) %read 2) r=(peek(sut q.q.ref) %read 2)]
dext(sut s.pal, ref r.pal)
==
==
::
++ cram
|= [dab=(map term foot) hem=(map term foot)]
^- ?
?- dab
~ =(hem ~)
^
?& ?=(^ hem)
=(p.n.dab p.n.hem)
$(dab l.dab, hem l.hem)
$(dab r.dab, hem r.hem)
?- -.q.n.dab
%ash
?& ?=(%ash -.q.n.hem)
dext(sut (play p.q.n.dab), ref (play(sut ref) p.q.n.hem))
==
%elm =(q.n.dab q.n.hem)
%oak ?=(?(%oak %yew) -.q.n.hem)
%yew
?& ?=(%yew -.q.n.hem)
$(dab p.q.n.dab, hem p.q.n.hem)
==
==
==
==
::
++ dext
^- ?
=- ?: tyn
&
?: tel
:: ~! (dunk %need)
:: ~! (dunk(sut ref) %have)
~|(%type-fail !!)
|
^= tyn
?: =(sut ref)
&
?- sut
%void sint
%noun &
::
[%atom *]
?. ?=([%atom *] ref)
sint
(fitz p.sut p.ref)
::
[%cell *]
?. ?=([%cell *] ref)
sint
?&
dext(sut p.sut, ref p.ref)
dext(sut q.sut, ref q.ref)
==
::
[%core *]
?. ?=([%core *] ref)
sint
cong
::
[%cube *]
?: ?=([%cube *] ref)
=(p.sut p.ref)
sint
::
[%face *] dext(sut q.sut)
[%fork *]
?. ?=(?([%atom *] %noun [%cell *] [%cube *] [%core *]) ref)
sint
?|(dext(tel |, sut p.sut) dext(tel |, sut q.sut))
::
[%hold *]
?|
(~(has in gil) [sut ref])
dext(gil (~(put in gil) [sut ref]), sut repo)
==
==
::
++ sint
^- ?
?- ref
[%atom *] |
[%cell *] |
[%fork *] ?&(dext(ref p.ref) dext(ref q.ref))
[%hold *]
?|
(~(has in gil) [sut ref])
dext(gil (~(put in gil) [sut ref]), ref repo(sut ref))
==
::
%noun |
%void &
* dext(ref repo(sut ref))
==
--
::
++ park
~/ %park
|= [way=?(%read %rite) axe=axis]
^- ?
?> ?=([%core *] sut)
?|
!vet
?- way
%read
?- p.q.sut
%gold &
%iron |
%lead |
%zinc =(2 (cap axe))
==
::
%rite
?- p.q.sut
%gold &
%iron =(2 (cap axe))
%lead |
%zinc |
==
==
==
::
++ peek
~/ %peek
|= [way=?(%read %rite) axe=axis]
^- type
?: =(1 axe)
sut
=+ [now=(cap axe) lat=(mas axe)]
=+ gil=*(set type)
|- ^- type
?- sut
[%atom *] %void
[%cell *] ?:(=(2 now) ^$(sut p.sut, axe lat) ^$(sut q.sut, axe lat))
[%core *]
?: =(3 now)
?. (park way lat)
:: ~! (dunk 'type')
~! (show [%c 'axis'] [%d axe])
~|(%peek-park !!)
^$(sut p.sut, axe lat)
%noun
::
[%fork *] (fork $(sut p.sut) $(sut q.sut))
[%hold *]
?: (~(has in gil) sut)
%void
$(gil (~(put in gil) sut), sut repo)
::
%void %void
%noun %noun
* $(sut repo)
==
::
++ play
~/ %play
=> .(vet |)
|= gen=gene
?- gen
[^ *] (cell $(gen p.gen) $(gen q.gen))
[%brcl *] (heir(sut $(gen p.gen)) q.gen)
[%brcn *] (core sut %gold sut [[%0 0] p.gen])
[%cnts *] =+ lar=(foil (seek %read p.gen))
=+ mew=(swab q.gen)
=+ rag=q.q.lar
%- fire
|- ^- (list ,[p=type q=foot])
?@ mew
rag
$(mew t.mew, rag q:(tock p.i.mew ^$(gen q.i.mew) rag))
[%dtkt *] %noun
[%dtls *] [%atom %$]
[%dtpt *] ?:(=(%f p.gen) ?>((lte q.gen 1) bean) [%atom p.gen])
[%dtsg *] [%cube q.gen ?:(.?(q.gen) %noun [%atom p.gen])]
[%dttr *] %noun
[%dtts *] bean
[%dtwt *] bean
[%ktbr *] (wrap(sut $(gen p.gen)) %iron)
[%ktdt *] $(gen (snap(sut $(gen p.gen)) q.gen))
[%ktls *] $(gen p.gen)
[%ktpm *] (wrap(sut $(gen p.gen)) %zinc)
[%ktsg *] $(gen p.gen)
[%ktts *] (face p.gen $(gen q.gen))
[%ktwt *] (wrap(sut $(gen p.gen)) %lead)
[%sggr *] $(gen q.gen)
[%tsgr *] $(gen q.gen, sut $(gen p.gen))
[%wtcl *] =+ [fex=(gain p.gen) wux=(lose p.gen)]
%+ fork
?:(=(%void fex) %void $(sut fex, gen q.gen))
?:(=(%void wux) %void $(sut wux, gen r.gen))
[%wtcn *] bean
[%zpcb *] ~!((show %o p.gen) $(gen q.gen))
[%zpcm *] (play p.gen)
[%zpcn ~] p:seed
[%zpfs *] %void
[%zpsm *] (cell $(gen p.gen) $(gen q.gen))
[%zpts *] %noun
[%zpzp ~] %void
* =+ doz=~(open ap gen)
?: =(doz gen)
~! (show [%c 'gene'] [%q gen])
~|(%play-open !!)
$(gen doz)
==
::
++ reco
|* fuy=_|=(p=type p)
=+ por=repo
=+ yot=(fuy por)
?: =(yot por)
?:(=(%void por) por sut)
yot
::
++ repo
^- type
?- sut
[%core *] [%cell %noun p.sut]
[%cube *] q.sut
[%face *] q.sut
[%hold *] (rest p.sut)
%noun [%fork [%atom %$] [%cell %noun %noun]]
* ~|(%repo-fltt !!)
==
::
++ rest
~/ %rest
|= leg=(list ,[p=type q=gene])
^- type
?: (lien leg |=([p=type q=gene] (~(has in fan) [p q])))
~|(%rest-loop !!)
=> .(fan (~(gas in fan) leg))
%+ roll
%- %~ tap
in
%- ~(gas in *(set type))
(turn leg |=([p=type q=gene] (play(sut p) q)))
~
=+([p=*type q=`type`%void] |.((fork p q)))
::
++ silk
|= [syx=term tor=port]
^- (unit port)
~| %silk
?- -.q.tor
& ~
|
=+ ^= hey ^- (list ,[p=axis q=foot])
|- ?~ q.q.tor
~
=+ yon=$(q.q.tor t.q.q.tor)
?. ?=([%yew *] q.i.q.q.tor)
yon
[(need (look syx p.q.i.q.q.tor)) yon]
?: =(~ hey)
~
?> =((lent hey) (lent q.q.tor))
=+ ^= yaw
=+ yaw=p.i.hey
|-(?~(t.hey yaw ?>(=(p.i.t.hey yaw) $(t.hey t.t.hey))))
:- ~
:- p.tor
:+ %|
(peg p.q.tor yaw)
|- ^- (list ,[p=type q=foot])
?~ q.q.tor
~
?< ?=(~ hey)
[[p.i.q.q.tor q.i.hey] $(q.q.tor t.q.q.tor, hey t.hey)]
==
::
++ seek
~/ %seek
|= [way=?(%read %rite) hyp=wing]
^- port
?@ hyp
[1 %& sut]
=> .(i.hyp ?^(i.hyp i.hyp [%| p=0 q=i.hyp]))
=+ zar=$(hyp t.hyp)
=+ sic=?.(?=([| *] i.hyp) ~ (silk q.i.hyp zar))
?. ?=(~ sic)
u.sic
=+ ^= syp
?- -.q.zar
& p.q.zar
| (fire (turn q.q.zar |=([p=type q=foot] [p [%ash ~ 1]])))
==
?- i.hyp
[& *]
[(peg p.zar p.i.hyp) %& (peek(sut syp) way p.i.hyp)]
::
[| *]
=> .(sut syp)
=+ hud=(fink p.i.hyp way q.i.hyp)
[(peg p.zar p.hud) q.hud]
==
::
++ snap
~/ %snap
|= gen=gene
^- gene
?- sut
[%cell *] =+ haq=~(hack ap gen)
?- -.haq
| p.haq
& :- $(sut p.sut, gen p.haq)
$(sut q.sut, gen q.haq)
==
[%cube *] $(sut repo)
[%face *] [%ktts p.sut $(sut q.sut)]
[%fork *] =+ haq=~(hack ap gen)
?- -.haq
| p.haq
& :- $(sut (peek %read 2), gen p.haq)
$(sut (peek %read 3), gen q.haq)
==
[%hold *] $(sut repo)
* gen
==
::
++ swab
~/ %swab
|= har=(list ,[p=gene q=gene])
^- (list ,[p=wing q=gene])
%+ turn
har
|=([a=gene b=gene] [(flop ~(rake ap a)) b])
::
++ tack
~/ %tack
|= [peh=wing mur=type]
=+ axe=1
|- ^- [p=axis q=type]
?@ peh
[axe mur]
=> .(i.peh ?^(i.peh i.peh [%| p=0 q=i.peh]))
?- i.peh
[& *]
=+ vas=(peek %rite p.i.peh)
=+ gav=$(peh t.peh, sut vas, axe (peg axe p.i.peh))
[p.gav (heal ~ p.i.peh q.gav)]
::
[| *]
=+ wuf=(flay (fink p.i.peh %rite q.i.peh))
=+ gav=$(peh t.peh, sut q.wuf, axe (peg axe p.wuf))
[p.gav (heal [~ q.i.peh] p.wuf q.gav)]
==
::
++ tock
~/ %tock
|= [peh=wing mur=type men=(list ,[p=type q=foot])]
^- [p=axis q=(list ,[p=type q=foot])]
=- [(need p.wib) q.wib]
^= wib
|- ^- [p=(unit axis) q=(list ,[p=type q=foot])]
?@ men
[*(unit axis) ~]
=+ geq=(tack(sut p.i.men) peh mur)
=+ mox=$(men t.men)
[(mate p.mox `_p.mox`[~ p.geq]) [[q.geq q.i.men] q.mox]]
::
++ wrap
~/ %wrap
|= yoz=?(%lead %iron %zinc)
^- type
?- sut
[%core *] ?.(=(%gold p.q.sut) ~|(%wrap-metl !!) sut(p.q yoz))
[%fork *] (fork $(sut p.sut) $(sut q.sut))
[%hold *] $(sut repo)
* ~|(%wrap-type !!)
==
--
Parts of this document are generated automatically. Edits within the comments section will be preserved.