mirror of
https://github.com/urbit/ares.git
synced 2024-11-22 06:32:47 +03:00
codegen: SACK analysis and new linearizer
This commit is contained in:
Edward Amsden
parent
4dd009c04c
commit
e17095a55a
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
466
hoon/codegen/lib/runt.hoon
Normal file
466
hoon/codegen/lib/runt.hoon
Normal file
@ -0,0 +1,466 @@
|
||||
/- *noir
|
||||
/- gene
|
||||
/+ sack
|
||||
/+ line
|
||||
=* moan moan.sack
|
||||
=* cole cole.sack
|
||||
=/ lena (lean:line moan)
|
||||
=* hill hill.lena
|
||||
=>
|
||||
:: "jets"
|
||||
|%
|
||||
++ jdec
|
||||
|= s=*
|
||||
^- (unit)
|
||||
?. ?=([* @ *] s) ~
|
||||
?: =(0 +6.s) ~
|
||||
`(dec +6.s)
|
||||
--
|
||||
:: hot state: path->jet matching
|
||||
=/ heat
|
||||
%- ~(gas in *(map [path @] $-(* (unit))))
|
||||
:~
|
||||
[[/dec/test100 1] jdec]
|
||||
==
|
||||
:: warm state: label->jet matching
|
||||
=| warm=(map [sock *] [p=path q=$-(* (unit))])
|
||||
|%
|
||||
++ lane
|
||||
|= [s=* f=*]
|
||||
=* this .
|
||||
^- (unit *)
|
||||
=| tack=(list [salt=@ turn=bile:gene s=* f=* mean=(list ^) stir=(map @uvre *) dirt=pile:gene])
|
||||
=<
|
||||
=^ tear this (dyn s f)
|
||||
?: ?=(%| -.tear)
|
||||
(q.p.tear s)
|
||||
=/ fram=[stir=(map @ *) dirt=pile:gene] [*(map @ *) p.tear]
|
||||
=| mean=(list ^)
|
||||
=/ [todo=(list pole:gene) then=site:gene] (~(got by will.dirt.fram) wish.dirt.fram)
|
||||
=. stir.fram (~(put by stir.fram) sire.dirt.fram s)
|
||||
|- ^- (unit *)
|
||||
=> |% ++ r |=(a=@uvre (~(got by stir.fram) a)) --
|
||||
?^ todo
|
||||
~& i.todo
|
||||
=> |% ++ go $(todo t.todo) --
|
||||
?+ -.i.todo ~&("skip/todo: {<i.todo>}" go)
|
||||
%imm
|
||||
=. stir.fram (~(put by stir.fram) +>.i.todo +<.i.todo)
|
||||
go
|
||||
::
|
||||
%mov
|
||||
=. stir.fram (~(put by stir.fram) +>.i.todo (r +<.i.todo))
|
||||
go
|
||||
::
|
||||
%phi
|
||||
|- ^- (unit *)
|
||||
?~ +<.i.todo !!
|
||||
=/ v (~(get by stir.fram) i.+<.i.todo)
|
||||
?~ v $(+<.i.todo t.+<.i.todo)
|
||||
=. stir.fram (~(put by stir.fram) +>.i.todo u.v)
|
||||
go
|
||||
::
|
||||
%inc
|
||||
=/ a (r +<.i.todo)
|
||||
?^ a ~
|
||||
=. stir.fram (~(put by stir.fram) +>.i.todo .+(a))
|
||||
go
|
||||
::
|
||||
%con
|
||||
=. stir.fram (~(put by stir.fram) +>+.i.todo [(r +<.i.todo) (r +>-.i.todo)])
|
||||
go
|
||||
::
|
||||
%hed
|
||||
=. stir.fram (~(put by stir.fram) +>.i.todo -:(r +<.i.todo))
|
||||
go
|
||||
::
|
||||
%tal
|
||||
=. stir.fram (~(put by stir.fram) +>.i.todo +:(r +<.i.todo))
|
||||
go
|
||||
==
|
||||
~& then
|
||||
=> |%
|
||||
++ go |=(b=bile:gene =+((~(got by will.dirt.fram) b) ^$(todo body, then bend)))
|
||||
++ ar
|
||||
|= [a=(list @uvre) n=need:gene]
|
||||
=/ nack=(list need:gene) ~[n]
|
||||
=| whip=(map @uvre *)
|
||||
|- ^- (map @uvre *)
|
||||
?^ nack
|
||||
?- -.i.nack
|
||||
%none $(nack t.nack)
|
||||
%both $(nack [left.i.nack rite.i.nack t.nack])
|
||||
%this
|
||||
?> ?=(^ a)
|
||||
$(whip (~(put by whip) sass.i.nack (r i.a)), a t.a, nack t.nack)
|
||||
==
|
||||
whip
|
||||
++ re
|
||||
|= x=*
|
||||
?^ tack
|
||||
=. stir.i.tack (~(put by stir.i.tack) salt.i.tack x)
|
||||
=/ post (~(got by will.dirt.i.tack) turn.i.tack)
|
||||
%= ^$
|
||||
tack t.tack
|
||||
stir.fram stir.i.tack
|
||||
dirt.fram dirt.i.tack
|
||||
s s.i.tack
|
||||
f f.i.tack
|
||||
mean mean.i.tack
|
||||
todo body.post
|
||||
then bend.post
|
||||
==
|
||||
`x
|
||||
--
|
||||
?- -.then
|
||||
%clq
|
||||
?^ (r +<.then)
|
||||
(go +>-.then)
|
||||
(go +>+.then)
|
||||
::
|
||||
%eqq
|
||||
?: =((r +<.then) (r +>-.then))
|
||||
(go +>+<.then)
|
||||
(go +>+>.then)
|
||||
::
|
||||
%brn
|
||||
=/ c (r +<.then)
|
||||
?: =(0 c)
|
||||
(go +>+<.then)
|
||||
?: =(1 c)
|
||||
(go +>+>.then)
|
||||
(go +>-.then)
|
||||
::
|
||||
%hop
|
||||
(go +.then)
|
||||
::
|
||||
%lnk
|
||||
=/ s (r +<.then)
|
||||
=/ f (r +>-.then)
|
||||
=^ tear this (dyn s f)
|
||||
?: ?=(%| -.tear)
|
||||
=/ silt (q.p.tear s)
|
||||
?~ silt ~
|
||||
=. stir.fram (~(put by stir.fram) +>+<.then u.silt)
|
||||
(go +>+>.then)
|
||||
=/ wish (~(got by will.p.tear) wish.p.tear)
|
||||
%= $
|
||||
tack [[+>+<.then +>+>.then ^s ^f mean fram] tack]
|
||||
s s
|
||||
f f
|
||||
dirt.fram p.tear
|
||||
stir.fram (~(put by *(map @ *)) sire.p.tear s)
|
||||
mean ~
|
||||
todo body.wish
|
||||
then bend.wish
|
||||
==
|
||||
::
|
||||
%cal
|
||||
=/ s (r +>-.then)
|
||||
=/ f +<+.then
|
||||
=/ jute (~(get by warm) +<.then)
|
||||
?^ jute
|
||||
=/ silt (q.u.jute s)
|
||||
?~ silt ~
|
||||
=. stir.fram (~(put by stir.fram) +>+>-.then u.silt)
|
||||
(go +>+>+.then)
|
||||
=/ pill (~(got by hill) +<.then)
|
||||
=/ long (~(got by will.pill) long.pill)
|
||||
%= $
|
||||
tack [[+>+>-.then +>+>+.then ^s ^f mean fram] tack]
|
||||
s s
|
||||
f f
|
||||
stir.fram (ar +>+<.then want.pill)
|
||||
dirt.fram pill
|
||||
mean ~
|
||||
todo body.long
|
||||
then bend.long
|
||||
==
|
||||
::
|
||||
%lnt
|
||||
=/ s (r +<.then)
|
||||
=/ f (r +>.then)
|
||||
=^ tear this (dyn s f)
|
||||
?: ?=(%| -.tear)
|
||||
=/ silt (q.p.tear s)
|
||||
?~ silt ~
|
||||
(re u.silt)
|
||||
=/ wish (~(got by will.p.tear) wish.p.tear)
|
||||
%= $
|
||||
s s
|
||||
f f
|
||||
dirt.fram p.tear
|
||||
stir.fram (~(put by *(map @ *)) sire.p.tear s)
|
||||
todo body.wish
|
||||
then bend.wish
|
||||
==
|
||||
::
|
||||
%jmp
|
||||
=/ s (r +>-.then)
|
||||
=/ f +<+.then
|
||||
=/ jute (~(get by warm) +<.then)
|
||||
?^ jute
|
||||
=/ silt (q.u.jute s)
|
||||
?~ silt ~
|
||||
(re u.silt)
|
||||
=/ pill (~(got by hill) +<.then)
|
||||
=/ long (~(got by will.pill) long.pill)
|
||||
%= $
|
||||
s s
|
||||
f f
|
||||
stir.fram (ar +>+.then want.pill)
|
||||
dirt.fram pill
|
||||
todo body.long
|
||||
then bend.long
|
||||
==
|
||||
::
|
||||
%spy
|
||||
~& 'todo: spy' ~
|
||||
::
|
||||
%mer
|
||||
~& 'todo: mer' (go +>+>+>.then)
|
||||
::
|
||||
%don (re (r +.then))
|
||||
%bom ~
|
||||
%pun ~& 'todo: punt' ~
|
||||
==
|
||||
|%
|
||||
++ dyn
|
||||
|= [s=* f=*]
|
||||
^- [(each pile:gene [p=path q=$-(* (unit))]) _this]
|
||||
=/ mile (fin s f)
|
||||
?^ mile [u.mile this]
|
||||
=. sack (rout:sack [& s] f)
|
||||
=. warm wag
|
||||
=. lena (lena moan)
|
||||
=/ milt (fin s f)
|
||||
?> ?=(^ milt)
|
||||
[u.milt this]
|
||||
++ fin |=([s=* f=*] (fan [& s] f))
|
||||
++ fan
|
||||
|= [s=sock f=*]
|
||||
^- (unit (each pile:gene [p=path q=$-(* (unit))]))
|
||||
=/ huns (~(get ja moan) f)
|
||||
|- ^- (unit (each pile:gene [p=path q=$-(* (unit))]))
|
||||
?~ huns ~
|
||||
?: (~(huge so:sack soot.i.huns) s)
|
||||
=/ jute (~(get by warm) [soot.i.huns f])
|
||||
?^ jute `[%| u.jute]
|
||||
=/ mile (~(get by hill) [soot.i.huns f])
|
||||
?~ mile ~
|
||||
`[%& u.mile]
|
||||
$(huns t.huns)
|
||||
++ wag
|
||||
^- _warm
|
||||
=/ jets ~(tap by heat)
|
||||
=. warm ~
|
||||
|- ^- _warm
|
||||
?^ jets
|
||||
=/ labs ~(tap in (~(get ju call.cole) -.i.jets))
|
||||
|- ^- _warm
|
||||
?^ labs
|
||||
$(warm (~(put by warm) i.labs [-< +]:i.jets), labs t.labs)
|
||||
^$(jets t.jets)
|
||||
warm
|
||||
--
|
||||
++ morn
|
||||
|= [s=* f=*]
|
||||
=* this .
|
||||
^- (unit *)
|
||||
=| tack=(list) :: result stack
|
||||
=/ silt=(list) ~[s] :: subject stack
|
||||
=<
|
||||
=^ h this (dyn s f)
|
||||
?: ?=(%| -.h)
|
||||
=/ jolt ~& jet+p.p.h (q.p.h s)
|
||||
~? =(~ jolt) %jet-bail
|
||||
jolt
|
||||
=/ toll=(list (each nomm toms)) [%& nomm.norm.p.h]~ :: instruction stack
|
||||
=/ icey=(list (map @hail [=sock form=*])) ~[ices.norm.p.h] :: code table stack
|
||||
|-
|
||||
?~ toll
|
||||
?> ?=(^ tack)
|
||||
?> ?=(~ t.tack)
|
||||
`i.tack
|
||||
?: ?=(%& -.i.toll)
|
||||
=* form p.i.toll
|
||||
?- -.form
|
||||
%par $(toll [[%& left.form] [%& rite.form] [%| %par] t.toll])
|
||||
%not
|
||||
=/ salt (get here.form)
|
||||
?~ salt ~
|
||||
$(toll t.toll, tack [u.salt tack])
|
||||
::
|
||||
%one $(toll t.toll, tack [moan.form tack])
|
||||
%two $(toll [[%& cost.form] [%& corn.form] [%| %two rail.form] t.toll])
|
||||
%the $(toll [[%& pell.form] [%| %the] t.toll])
|
||||
%for $(toll [[%& mall.form] [%| %for] t.toll])
|
||||
%ivy $(toll [[%& this.form] [%& that.form] [%| %ivy] t.toll])
|
||||
%six
|
||||
$(toll [[%& what.form] [%| %six] [%& then.form] [%& else.form] t.toll])
|
||||
::
|
||||
%eve $(toll [[%& once.form] [%| %eve] [%& then.form] [%| %vee] t.toll])
|
||||
%ten $(toll [[%& twig.form] [%& tree.form] [%| %ten here.form] t.toll])
|
||||
%sip $(toll [[%& then.form] t.toll])
|
||||
%tip $(toll [[%& vice.form] [%| %tip hint.form rail.form] [%& then.form] t.toll])
|
||||
%elf $(toll [[%& rent.form] [%& walk.form] [%| %elf] t.toll])
|
||||
==
|
||||
=* fern p.i.toll
|
||||
?- fern
|
||||
%par
|
||||
?> ?=(^ tack)
|
||||
?> ?=(^ t.tack)
|
||||
$(toll t.toll, tack [[i.t.tack i.tack] t.t.tack])
|
||||
::
|
||||
%wot
|
||||
?> ?=(^ icey)
|
||||
?> ?=(^ silt)
|
||||
$(toll t.toll, icey t.icey, silt t.silt)
|
||||
::
|
||||
%the
|
||||
?> ?=(^ tack)
|
||||
$(toll t.toll, tack [?=(^ i.tack) t.tack])
|
||||
::
|
||||
%for
|
||||
?> ?=(^ tack)
|
||||
?^ i.tack ~
|
||||
$(toll t.toll, tack [.+(i.tack) t.tack])
|
||||
::
|
||||
%ivy
|
||||
?> ?=(^ tack)
|
||||
?> ?=(^ t.tack)
|
||||
$(toll t.toll, tack [=(i.t.tack i.tack) t.t.tack])
|
||||
::
|
||||
%six
|
||||
?> ?=(^ tack)
|
||||
?> ?=(^ t.toll)
|
||||
?> ?=(^ t.t.toll)
|
||||
?. ?=(? i.tack) ~
|
||||
?: i.tack
|
||||
$(toll [i.t.toll t.t.t.toll], tack t.tack)
|
||||
$(toll [i.t.t.toll t.t.t.toll], tack t.tack)
|
||||
::
|
||||
%eve
|
||||
?> ?=(^ tack)
|
||||
$(toll t.toll, silt [i.tack silt], tack t.tack)
|
||||
::
|
||||
%vee
|
||||
?> ?=(^ silt)
|
||||
$(toll t.toll, silt t.silt)
|
||||
::
|
||||
%elf ~
|
||||
[%two *]
|
||||
?> ?=(^ icey)
|
||||
?> ?=(^ tack)
|
||||
?> ?=(^ t.tack)
|
||||
=/ snow (~(get by i.icey) rail.fern)
|
||||
?~ snow
|
||||
=^ honk this (dyn i.t.tack i.tack)
|
||||
?: ?=(%| -.honk)
|
||||
=/ jolt ~&(jet+p.p.honk (q.p.honk i.t.tack))
|
||||
?~ jolt ~& %jet-bail ~
|
||||
%= $
|
||||
toll t.toll
|
||||
tack [u.jolt t.t.tack]
|
||||
==
|
||||
%= $
|
||||
toll [[%& nomm.norm.p.honk] [%| %wot] t.toll]
|
||||
icey [ices.norm.p.honk icey]
|
||||
silt [i.t.tack silt]
|
||||
tack t.t.tack
|
||||
==
|
||||
=/ honk (fan u.snow)
|
||||
?> ?=(^ honk)
|
||||
?: ?=(%| -.u.honk)
|
||||
=/ jolt ~&(jet+p.p.u.honk (q.p.u.honk i.t.tack))
|
||||
?~ jolt ~& %jet-bail ~
|
||||
%= $
|
||||
toll t.toll
|
||||
tack [u.jolt t.t.tack]
|
||||
==
|
||||
%= $
|
||||
toll [[%& nomm.norm.p.u.honk] [%| %wot] t.toll]
|
||||
icey [ices.norm.p.u.honk icey]
|
||||
silt [i.t.tack silt]
|
||||
tack t.t.tack
|
||||
==
|
||||
::
|
||||
[%ten *]
|
||||
?> ?=(^ tack)
|
||||
?> ?=(^ t.tack)
|
||||
=/ salt (put here.fern i.t.tack i.tack)
|
||||
?~ salt ~
|
||||
$(toll t.toll, tack [u.salt t.t.tack])
|
||||
::
|
||||
[%tip *]
|
||||
?> ?=(^ tack)
|
||||
$(toll t.toll, tack t.tack)
|
||||
==
|
||||
|%
|
||||
++ put
|
||||
|= [axe=@ twig=* tree=*]
|
||||
^- (unit)
|
||||
?: =(0 axe) ~
|
||||
|- ^- (unit)
|
||||
?: =(1 axe) `twig
|
||||
?@ tree ~
|
||||
?- (cap axe)
|
||||
%2
|
||||
=/ l $(axe (mas axe), tree -.tree)
|
||||
?~(l ~ `[u.l +.tree])
|
||||
::
|
||||
%3
|
||||
=/ r $(axe (mas axe), tree +.tree)
|
||||
?~(r ~ `[-.tree u.r])
|
||||
==
|
||||
++ get
|
||||
|= axe=@
|
||||
^- (unit)
|
||||
?: =(0 axe) ~
|
||||
?> ?=(^ silt)
|
||||
|- ^- (unit)
|
||||
?: =(1 axe) `i.silt
|
||||
?@ i.silt ~
|
||||
?- (cap axe)
|
||||
%2 $(i.silt -.i.silt, axe (mas axe))
|
||||
%3 $(i.silt +.i.silt, axe (mas axe))
|
||||
==
|
||||
++ dyn
|
||||
|= [s=* f=*]
|
||||
^- [(each hone [p=path q=$-(* (unit))]) _this]
|
||||
=/ honk (fin s f)
|
||||
?^ honk [u.honk this]
|
||||
=. sack (rout:sack [& s] f)
|
||||
=. warm wag
|
||||
=/ hunk (fin s f)
|
||||
?> ?=(^ hunk)
|
||||
[u.hunk this]
|
||||
++ wag
|
||||
^- _warm
|
||||
=/ jets ~(tap by heat)
|
||||
=. warm ~ :: full regeneration
|
||||
|- ^- _warm
|
||||
?^ jets
|
||||
=/ labs ~(tap in (~(get ju call.cole) -.i.jets))
|
||||
|- ^- _warm
|
||||
?^ labs
|
||||
$(warm (~(put by warm) i.labs [-< +]:i.jets), labs t.labs)
|
||||
^$(jets t.jets)
|
||||
warm
|
||||
++ fin
|
||||
|= [s=* f=*]
|
||||
^- (unit (each hone [p=path q=$-(* (unit))]))
|
||||
(fan [& s] f)
|
||||
++ fan
|
||||
|= [s=sock f=*]
|
||||
^- (unit (each hone [p=path q=$-(* (unit))]))
|
||||
=/ huns (~(get ja moan) f)
|
||||
|- ^- (unit (each hone [p=path q=$-(* (unit))]))
|
||||
?~ huns ~
|
||||
?: (~(huge so:sack soot.i.huns) s)
|
||||
=/ jute (~(get by warm) [soot.i.huns f])
|
||||
?^ jute `[%| u.jute]
|
||||
`[%& i.huns]
|
||||
$(huns t.huns)
|
||||
--
|
||||
--
|
||||
715
hoon/codegen/lib/sack.hoon
Normal file
715
hoon/codegen/lib/sack.hoon
Normal file
@ -0,0 +1,715 @@
|
||||
/- *noir
|
||||
/+ *soak
|
||||
=| moan=(jar * hone)
|
||||
=| cole=cool
|
||||
|%
|
||||
++ thus .
|
||||
++ rout
|
||||
|= [soot=sock form=*]
|
||||
^- _thus
|
||||
=/ moot
|
||||
%+ ~(put by *(map @hail toot)) `@hail`1
|
||||
:* soot |
|
||||
`form ~
|
||||
[| ~] | ~
|
||||
==
|
||||
=| mind=(map @hail hind)
|
||||
=/ work=(list @hail) ~[`@hail`1]
|
||||
=/ mite (~(put in *(set @hail)) `@hail`1)
|
||||
=| kids=(jug @hail @hail)
|
||||
|^ ^- _thus
|
||||
=> raid
|
||||
=> loot
|
||||
=> espy
|
||||
=> ruin
|
||||
?~(work thus $)
|
||||
++ this .
|
||||
++ raid
|
||||
=/ cork work
|
||||
|- ^- _this
|
||||
?~ cork this
|
||||
=* hail i.cork
|
||||
=/ firm form:(~(got by moot) hail)
|
||||
?> ?=(^ firm)
|
||||
=* form u.firm
|
||||
=; code
|
||||
%= $
|
||||
moot
|
||||
%+ ~(jab by moot) hail
|
||||
|= =toot
|
||||
toot(norm `code)
|
||||
::
|
||||
cork t.cork
|
||||
==
|
||||
|- ^- nomm
|
||||
?+ form [%not 0] :: invalid nock crashes
|
||||
[^ *]
|
||||
[%par $(form -.form, hail (peg hail 2)) $(form +.form, hail (peg hail 3))]
|
||||
::
|
||||
[%0 axe=@]
|
||||
[%not axe.form]
|
||||
::
|
||||
[%1 non=*]
|
||||
[%one non.form]
|
||||
::
|
||||
[%2 sofa=* fora=*]
|
||||
:* %two
|
||||
:: we treat the cell [sofa fora] as axis 6 and the
|
||||
:: hypothetically inlined called formula as axis 7
|
||||
:: so the hypothetical inlining looks like
|
||||
:: [%2 [sofa fora] <called formula>]
|
||||
$(form sofa.form, hail (peg hail 12))
|
||||
$(form fora.form, hail (peg hail 13))
|
||||
hail
|
||||
==
|
||||
::
|
||||
[%3 coat=*]
|
||||
[%the $(form coat.form, hail (peg hail 3))]
|
||||
::
|
||||
[%4 tome=*]
|
||||
[%for $(form tome.form, hail (peg hail 3))]
|
||||
::
|
||||
[%5 this=* that=*]
|
||||
:* %ivy
|
||||
$(form this.form, hail (peg hail 6))
|
||||
$(form that.form, hail (peg hail 7))
|
||||
==
|
||||
::
|
||||
[%6 what=* then=* else=*]
|
||||
:* %six
|
||||
$(form what.form, hail (peg hail 6))
|
||||
$(form then.form, hail (peg hail 14))
|
||||
$(form else.form, hail (peg hail 15))
|
||||
==
|
||||
::
|
||||
[%7 once=* then=*]
|
||||
:* %eve
|
||||
$(form once.form, hail (peg hail 6))
|
||||
$(form then.form, hail (peg hail 7))
|
||||
==
|
||||
::
|
||||
[%8 pint=* then=*]
|
||||
$(form [%7 [pint.form [%0 1]] then.form])
|
||||
::
|
||||
[%9 here=@ coil=*]
|
||||
$(form [%7 coil.form [%2 [%0 1] [%0 here.form]]])
|
||||
::
|
||||
[%10 [here=@ twig=*] tree=*]
|
||||
:* %ten
|
||||
here.form
|
||||
$(form twig.form, hail (peg hail 13))
|
||||
$(form tree.form, hail (peg hail 7))
|
||||
==
|
||||
::
|
||||
[%11 hint=@ then=*]
|
||||
[%sip hint.form $(form then.form, hail (peg hail 7))]
|
||||
::
|
||||
[%11 [hint=@ vice=*] then=*]
|
||||
:* %tip
|
||||
hint.form
|
||||
$(form vice.form, hail (peg hail 13))
|
||||
$(form then.form, hail (peg hail 7))
|
||||
hail
|
||||
==
|
||||
::
|
||||
[%12 rent=* walk=*]
|
||||
:* %elf
|
||||
$(form rent.form, hail (peg hail 6))
|
||||
$(form walk.form, hail (peg hail 7))
|
||||
==
|
||||
==
|
||||
:: learn/backpropagate battery masks
|
||||
++ espy
|
||||
=/ cork work
|
||||
|- ^- _this
|
||||
?~ cork this
|
||||
=* hail i.cork
|
||||
=/ [norm=(unit nomm) rake=cape]
|
||||
[norm rake]:(~(got by moot) hail)
|
||||
?> ?=(^ norm)
|
||||
=* code u.norm
|
||||
=^ soon moot
|
||||
|- ^- [cape _moot]
|
||||
?- -.code
|
||||
%par
|
||||
=/ [lack=cape rack=cape] ~(rip ca rake)
|
||||
=^ lead moot $(code left.code, rake lack)
|
||||
=^ reed moot $(code rite.code, rake rack)
|
||||
[(~(uni ca lead) reed) moot]
|
||||
::
|
||||
%not
|
||||
?: =(0 here.code) [| moot]
|
||||
[(~(pat ca rake) here.code) moot]
|
||||
::
|
||||
%one [| moot]
|
||||
%two
|
||||
=/ [soot=sock fake=cape form=(unit) norm=(unit nomm)]
|
||||
[soot rake form norm]:(~(got by moot) rail.code)
|
||||
=/ mole=(list hone) ?~(form ~ (~(get ja moan) u.form))
|
||||
|- ^- [cape _moot]
|
||||
?^ mole
|
||||
?: ?& (~(huge so soot.i.mole) soot)
|
||||
!(~(big ca cape.root.i.mole) rake)
|
||||
==
|
||||
[cape.soot.i.mole moot]
|
||||
$(mole t.mole)
|
||||
=. moot
|
||||
%+ ~(jab by moot) rail.code
|
||||
|= =toot
|
||||
toot(rake rake)
|
||||
=? moot ?&(?=(^ norm) (~(big ca fake) rake))
|
||||
+:^$(hail rail.code, code u.norm, rake rake)
|
||||
=/ lake sake:(~(got by moot) rail.code)
|
||||
=^ sake moot ^$(rake lake, code cost.code)
|
||||
=^ folk moot ^$(rake &, code corn.code)
|
||||
[(~(uni ca sake) folk) moot]
|
||||
::
|
||||
%the
|
||||
$(code pell.code, rake |)
|
||||
::
|
||||
%for
|
||||
$(code mall.code, rake |)
|
||||
::
|
||||
%ivy
|
||||
=^ lake moot $(code this.code, rake |)
|
||||
=^ rare moot $(code that.code, rake |)
|
||||
[(~(uni ca lake) rare) moot]
|
||||
::
|
||||
%six
|
||||
=^ cake moot $(code what.code, rake |)
|
||||
=^ lake moot $(code then.code)
|
||||
=^ rare moot $(code else.code)
|
||||
[(~(uni ca cake) (~(uni ca lake) rare)) moot]
|
||||
::
|
||||
%eve
|
||||
=^ rare moot $(code then.code)
|
||||
$(code once.code, rake rare)
|
||||
::
|
||||
%ten
|
||||
?: =(0 here.code) [| moot]
|
||||
=/ [wipe=cape wine=cape] (~(awl ca rake) here.code)
|
||||
=^ lake moot $(code twig.code, rake wipe)
|
||||
=^ rare moot $(code tree.code, rake wine)
|
||||
[(~(uni ca lake) rare) moot]
|
||||
::
|
||||
%sip
|
||||
$(code then.code)
|
||||
::
|
||||
%tip
|
||||
?: =(hint.code %slow) [| moot]
|
||||
=? rake =(hint.code %fast)
|
||||
=/ kind (~(got by mind) rail.code)
|
||||
?> ?=([%fast *] kind)
|
||||
?~ tire.kind |
|
||||
cape.bats.u.tire.kind
|
||||
=^ lake moot $(code vice.code, rake |)
|
||||
=^ rare moot $(code then.code)
|
||||
[(~(uni ca lake) rare) moot]
|
||||
::
|
||||
%elf
|
||||
=^ lake moot $(code rent.code, rake |)
|
||||
=^ rare moot $(code walk.code, rake |)
|
||||
[(~(uni ca lake) rare) moot]
|
||||
==
|
||||
=. moot
|
||||
%+ ~(jab by moot) hail
|
||||
|=(=toot toot(sake soon))
|
||||
$(cork t.cork)
|
||||
:: propagate subject knowledge forward
|
||||
++ loot
|
||||
=/ cork work
|
||||
|- ^- _this
|
||||
?~ cork this
|
||||
=* hail i.cork
|
||||
=/ [norm=(unit nomm) soot=sock root=sock rake=cape sire=(unit @hail)]
|
||||
[norm soot root rake sire]:(~(got by moot) hail)
|
||||
?> ?=(^ norm)
|
||||
=* code u.norm
|
||||
=/ soda=(list (each nomm toms)) ~[[%& code] [%| %wot]]
|
||||
=/ silt=(list sock) ~[soot]
|
||||
=| salt=(list sock)
|
||||
=/ halt=(list @hail) ~[hail]
|
||||
|- ^- _this
|
||||
?~ soda ^$(cork t.cork)
|
||||
?: ?=(%& -.i.soda)
|
||||
=* cone p.i.soda
|
||||
?- -.cone
|
||||
%par
|
||||
$(soda [[%& left.cone] [%& rite.cone] [%| %par] t.soda])
|
||||
::
|
||||
%not
|
||||
?: =(0 here.cone) $(soda t.soda, salt [[| ~] salt])
|
||||
?> ?=(^ silt)
|
||||
=/ sand (~(pull so i.silt) here.cone)
|
||||
?~ sand $(soda t.soda, salt [[| ~] salt])
|
||||
$(soda t.soda, salt [u.sand salt])
|
||||
::
|
||||
%one
|
||||
$(soda t.soda, salt [[& moan.cone] salt])
|
||||
::
|
||||
%two
|
||||
$(soda [[%& cost.cone] [%& corn.cone] [%| %two rail.cone] t.soda])
|
||||
::
|
||||
%the
|
||||
$(soda [[%& pell.cone] [%| %the] t.soda])
|
||||
::
|
||||
%for
|
||||
$(soda [[%& mall.cone] [%| %for] t.soda])
|
||||
::
|
||||
%ivy
|
||||
$(soda [[%& this.cone] [%& that.cone] [%| %ivy] t.soda])
|
||||
::
|
||||
%six
|
||||
$(soda [[%& what.cone] [%& then.cone] [%& else.cone] [%| %six] t.soda])
|
||||
::
|
||||
%eve
|
||||
$(soda [[%& once.cone] [%| %eve] [%& then.cone] [%| %vee] t.soda])
|
||||
::
|
||||
%ten
|
||||
?: =(0 here.cone) $(soda t.soda, salt [[| ~] salt])
|
||||
$(soda [[%& twig.cone] [%& tree.cone] [%| %ten here.cone] t.soda])
|
||||
::
|
||||
%sip
|
||||
$(soda [[%& then.cone] t.soda])
|
||||
::
|
||||
%tip
|
||||
?: =(hint.cone %slow) :: %slow hint handling: no evaluation, just dynamic calls
|
||||
=/ pots=(list nomm) ~[vice.cone then.cone]
|
||||
|- ^- _this :: make sure we have moot entries for the dynamic calls
|
||||
?^ pots
|
||||
?- -.i.pots
|
||||
%par $(pots [left.i.pots rite.i.pots t.pots])
|
||||
%not $(pots t.pots)
|
||||
%one $(pots t.pots)
|
||||
%two
|
||||
=? moot ?!((~(has by moot) rail.i.pots))
|
||||
%+ ~(put by moot) rail.i.pots
|
||||
:* [| ~] |
|
||||
~ ~
|
||||
[| ~] rake
|
||||
`hail
|
||||
==
|
||||
$(pots [cost.i.pots corn.i.pots t.pots])
|
||||
::
|
||||
%the $(pots [pell.i.pots t.pots])
|
||||
%for $(pots [mall.i.pots t.pots])
|
||||
%ivy $(pots [this.i.pots that.i.pots t.pots])
|
||||
%six $(pots [what.i.pots then.i.pots else.i.pots t.pots])
|
||||
%eve $(pots [once.i.pots then.i.pots t.pots])
|
||||
%ten $(pots [twig.i.pots tree.i.pots t.pots])
|
||||
%sip $(pots [then.i.pots t.pots])
|
||||
%tip $(pots [vice.i.pots then.i.pots t.pots])
|
||||
%elf $(pots [rent.i.pots walk.i.pots t.pots])
|
||||
==
|
||||
^$(soda t.soda, salt [[| ~] salt])
|
||||
$(soda [[%& vice.cone] [%& then.cone] [%| %tip hint.cone rail.cone] t.soda])
|
||||
::
|
||||
%elf
|
||||
$(soda [[%& rent.cone] [%& walk.cone] [%| %elf] t.soda])
|
||||
==
|
||||
=* kant p.i.soda
|
||||
?- kant
|
||||
%par
|
||||
?> ?=(^ salt)
|
||||
?> ?=(^ t.salt)
|
||||
$(soda t.soda, salt [(~(knit so i.t.salt) i.salt) t.t.salt])
|
||||
::
|
||||
%the
|
||||
?> ?=(^ salt)
|
||||
$(soda t.soda, salt [[| ~] t.salt])
|
||||
::
|
||||
%for
|
||||
?> ?=(^ salt)
|
||||
$(soda t.soda, salt [[| ~] t.salt])
|
||||
::
|
||||
%ivy
|
||||
?> ?=(^ salt)
|
||||
?> ?=(^ t.salt)
|
||||
$(soda t.soda, salt [[| ~] t.t.salt])
|
||||
::
|
||||
%six
|
||||
?> ?=(^ salt)
|
||||
?> ?=(^ t.salt)
|
||||
?> ?=(^ t.t.salt)
|
||||
$(soda t.soda, salt [(~(purr so i.t.salt) i.salt) t.t.t.salt])
|
||||
::
|
||||
%eve
|
||||
?> ?=(^ salt)
|
||||
$(soda t.soda, salt t.salt, silt [i.salt silt])
|
||||
::
|
||||
%vee
|
||||
?> ?=(^ silt)
|
||||
$(soda t.soda, silt t.silt)
|
||||
::
|
||||
%elf
|
||||
?> ?=(^ salt)
|
||||
?> ?=(^ t.salt)
|
||||
$(soda t.soda, salt [[| ~] t.t.salt])
|
||||
::
|
||||
%wot
|
||||
?> ?=(^ halt)
|
||||
?> ?=(^ salt)
|
||||
?> ?=(^ silt)
|
||||
=. moot
|
||||
(~(jab by moot) i.halt |=(=toot toot(root i.salt)))
|
||||
=/ rook (~(app ca rake) root)
|
||||
=/ soap (~(app ca rake) i.salt)
|
||||
?: ?&(=(~ t.soda) ?!(=(cape.rook cape.soap)) ?=(^ sire))
|
||||
:: stack is empty but we learned more to pass on to our sire
|
||||
=/ pate (~(got by moot) u.sire)
|
||||
?> ?=(^ norm.pate)
|
||||
%= $
|
||||
soda ~[[%& u.norm.pate] [%| %wot]]
|
||||
silt ~[soot.pate]
|
||||
salt ~
|
||||
halt ~[u.sire]
|
||||
root root.pate
|
||||
sire sire.pate
|
||||
==
|
||||
$(soda t.soda, halt t.halt, silt t.silt)
|
||||
::
|
||||
[%two *]
|
||||
?> ?=(^ salt)
|
||||
?> ?=(^ t.salt)
|
||||
=? moot ?!((~(has by moot) rail.kant))
|
||||
%+ ~(put by moot) rail.kant
|
||||
:* [| ~] |
|
||||
~ ~
|
||||
[| ~] |
|
||||
`hail
|
||||
==
|
||||
=/ [soot=sock sake=cape root=sock form=(unit) noir=(unit nomm) rack=cape]
|
||||
[soot sake root form norm rake]:(~(got by moot) rail.kant)
|
||||
=/ roan=(unit hone)
|
||||
?: =(& cape.i.salt) :: equality because a cape can be a cell
|
||||
=/ huns (~(get ja moan) data.i.salt)
|
||||
|- ^- (unit hone)
|
||||
?~ huns ~
|
||||
?: ?& (~(huge so soot.i.huns) i.t.salt)
|
||||
!(~(big ca cape.root.i.huns) rack)
|
||||
==
|
||||
`i.huns
|
||||
$(huns t.huns)
|
||||
~
|
||||
?^ roan
|
||||
=. moot :: copy info into moot
|
||||
%+ ~(jab by moot) rail.kant
|
||||
|= =toot
|
||||
%= toot
|
||||
soot i.t.salt
|
||||
sake cape.soot.u.roan
|
||||
root root.u.roan
|
||||
rake cape.root.u.roan
|
||||
form `data.i.salt
|
||||
norm `nomm.norm.u.roan
|
||||
==
|
||||
$(soda t.soda, salt [root.u.roan t.t.salt])
|
||||
?. ?|(?!(=(cape.soot cape.i.t.salt)) ?&(=(& cape.i.salt) =(~ form)))
|
||||
$(soda t.soda, salt [root t.t.salt])
|
||||
=/ note ?:(=(& cape.i.salt) `data.i.salt ~)
|
||||
=? mite ?&(?=(^ note) =(~ form)) (~(put in mite) rail.kant)
|
||||
=. moot
|
||||
(~(jab by moot) rail.kant |=(=toot toot(soot i.t.salt, form note)))
|
||||
?~ noir $(soda t.soda, salt [[| ~] t.t.salt])
|
||||
?. (~(huge so soot) i.t.salt) $(soda t.soda, salt [soot t.t.salt])
|
||||
%= $
|
||||
soda [[%& u.noir] [%| %wot] t.soda]
|
||||
halt [rail.kant halt]
|
||||
salt t.t.salt
|
||||
silt [i.t.salt silt]
|
||||
==
|
||||
::
|
||||
[%ten *]
|
||||
?> ?=(^ salt)
|
||||
?> ?=(^ t.salt)
|
||||
=/ dawn (~(darn so i.salt) here.kant i.t.salt)
|
||||
?~ dawn $(soda t.soda, salt [[| ~] t.t.salt])
|
||||
$(soda t.soda, salt [u.dawn t.t.salt])
|
||||
::
|
||||
[%tip *]
|
||||
?> ?=(^ salt)
|
||||
?> ?=(^ t.salt)
|
||||
?> ?=(^ halt)
|
||||
?: =(hint.kant %slow)
|
||||
?> ?=(^ silt)
|
||||
$(soda t.soda, salt [[| ~] t.t.salt], silt t.silt)
|
||||
?: =(hint.kant %fast)
|
||||
?. =(& cape.i.t.salt) ~& %fast-miss $(soda t.soda, salt [i.salt t.t.salt])
|
||||
=/ pest (past data.i.t.salt)
|
||||
?~ pest $(soda t.soda, salt [[| ~] t.t.salt])
|
||||
=+ u.pest
|
||||
=? mind !(~(has by mind) rail.kant)
|
||||
(~(put by mind) rail.kant [%fast ~])
|
||||
=/ kind (~(got by mind) rail.kant)
|
||||
?> ?=([%fast *] kind)
|
||||
?^ tire.kind
|
||||
?> (~(huge so bats.u.tire.kind) i.salt)
|
||||
$(soda t.soda, salt [bats.u.tire.kind t.t.salt])
|
||||
=/ boas (~(pull so i.salt) 2)
|
||||
?~ boas ~& fast-fake-b+name $(soda t.soda, salt [i.salt t.t.salt])
|
||||
=/ pork (~(pull so i.salt) ?~(park 3 u.park))
|
||||
?~ pork ~& fast-fake-p+name $(soda t.soda, salt [i.salt t.t.salt])
|
||||
?. =(& cape.u.boas) $(soda t.soda, salt [[| ~] t.t.salt])
|
||||
=/ papa=(unit [=path =sock])
|
||||
?~ park ?:(=(& cape.u.pork) `[~ u.pork] ~)
|
||||
=/ bart (~(pull so u.pork) 2)
|
||||
?~ bart ~& fast-fake-pb+name ~
|
||||
?. =(& cape.u.bart) ~
|
||||
?@ data.u.bart ~& fast-fake-pba+name ~
|
||||
=/ pats ~(tap in (~(get ju batt.cole) data.u.bart))
|
||||
|- ^- (unit [=path =sock])
|
||||
?^ pats
|
||||
=/ cure ~(tap in (~(get ju core.cole) i.pats))
|
||||
|- ^- (unit [=path =sock])
|
||||
?^ cure
|
||||
?: (~(huge so i.cure) u.pork)
|
||||
`[i.pats i.cure]
|
||||
$(cure t.cure)
|
||||
^$(pats t.pats)
|
||||
~& fast-fake-np+name ~
|
||||
?~ papa $(soda t.soda, salt [[| ~] t.t.salt])
|
||||
=/ kids (~(darn so (~(knit so u.boas) [| ~])) ?~(park 3 u.park) sock.u.papa)
|
||||
?> ?=(^ kids)
|
||||
=/ walk [name path.u.papa]
|
||||
=. core.cole (~(put ju core.cole) walk u.kids)
|
||||
?@ data.u.boas ~& fast-fake-ba+name $(soda t.soda, salt [[| ~] t.t.salt])
|
||||
=. batt.cole (~(put ju batt.cole) data.u.boas walk)
|
||||
=/ matt
|
||||
%- ~(gas by *(map @ [@hail *]))
|
||||
%+ turn (peel data.u.boas)
|
||||
|= [axe=@ form=*]
|
||||
[axe (peg rail.kant axe) form]
|
||||
=. mind (~(put by mind) rail.kant [%fast `[walk u.kids matt]])
|
||||
=. moot
|
||||
%- ~(gas by moot)
|
||||
%+ turn ~(val by matt)
|
||||
|= [rail=@hail form=*]
|
||||
:- rail
|
||||
:* u.kids |
|
||||
`form ~
|
||||
[| ~] | `i.halt
|
||||
==
|
||||
=. mite
|
||||
%- ~(gas in mite)
|
||||
%+ turn ~(val by matt)
|
||||
|=([rail=@hail *] rail)
|
||||
$(soda t.soda, salt [u.kids t.t.salt])
|
||||
$(soda t.soda, salt [i.salt t.t.salt])
|
||||
==
|
||||
:: recursion detection
|
||||
++ ruin
|
||||
=/ mile=(list @hail) ~(tap in mite)
|
||||
=. work ~ :: non-recursive direct calls
|
||||
=| slag=(set @hail) :: excluded as finalization roots
|
||||
=| flux=(set @hail) :: possible finalization roots
|
||||
=| loop=(map @hail @hail) :: recursive call targets
|
||||
|- ^- _this
|
||||
?^ mile
|
||||
=/ mill i.mile
|
||||
=/ [mail=(unit @hail) soot=sock form=(unit) rack=cape]
|
||||
[sire soot form rake]:(~(got by moot) mill)
|
||||
?> ?=(^ form) :: shouldn't get added to mite unless we know it
|
||||
=/ mole (~(get ja moan) u.form)
|
||||
|- ^- _this
|
||||
?^ mole
|
||||
?: ?& (~(huge so soot.i.mole) soot)
|
||||
!(~(big ca cape.root.i.mole) rack)
|
||||
==
|
||||
^$(mile t.mile)
|
||||
$(mole t.mole)
|
||||
=| sirs=(list @hail)
|
||||
|- ^- _this
|
||||
?~ mail
|
||||
?~ sirs :: not actually a call just the entrypoint
|
||||
^^$(mile t.mile, flux (~(put in flux) mill))
|
||||
%= ^^$ :: an un-analyzed indirect call
|
||||
mile t.mile
|
||||
work [i.mile work]
|
||||
slag (~(gas in slag) [mill sirs])
|
||||
==
|
||||
=. kids (~(put ju kids) u.mail mill)
|
||||
=. mill u.mail
|
||||
=/ [suit=sock soju=cape firm=(unit) mire=(unit @hail) ruck=cape]
|
||||
[soot sake form sire rake]:(~(got by moot) mill)
|
||||
?> ?=(^ firm)
|
||||
?: ?& =(u.form u.firm)
|
||||
(~(huge so (~(app ca soju) suit)) soot)
|
||||
!(~(big ca ruck) rack)
|
||||
==
|
||||
%= ^^$ :: found a recursive direct call
|
||||
mile t.mile
|
||||
slag (~(gas in slag) sirs)
|
||||
flux (~(put in flux) mill)
|
||||
loop (~(put by loop) i.mile mill)
|
||||
==
|
||||
$(sirs [mill sirs], mail mire)
|
||||
=. mite (~(dif in mite) (~(gas in *(set @hail)) work))
|
||||
|
||||
=/ done ~(tap in (~(dif in flux) slag))
|
||||
=| enod=(list (list @hail))
|
||||
|- ^- _this
|
||||
?~ done
|
||||
?~ enod this
|
||||
$(done i.enod, enod t.enod)
|
||||
=/ hood (~(got by moot) i.done)
|
||||
?: (~(has by loop) i.done) $(done t.done) :: recursive
|
||||
:: safe to apply masks because we only use things from moan if
|
||||
:: output battery mask and input sock match
|
||||
=. soot.hood ~(norm so (~(app ca sake.hood) soot.hood))
|
||||
=. root.hood ~(norm so (~(app ca rake.hood) root.hood))
|
||||
=. moot (~(put by moot) i.done hood)
|
||||
?> ?=(^ form.hood)
|
||||
?: =/ huns (~(get ja moan) u.form.hood)
|
||||
|- ^- ?
|
||||
?^ huns
|
||||
?: ?& (~(huge so soot.i.huns) soot.hood)
|
||||
!(~(big ca cape.root.i.huns) rake.hood)
|
||||
==
|
||||
&
|
||||
$(huns t.huns)
|
||||
|
|
||||
$(done t.done)
|
||||
?> ?=(^ norm.hood)
|
||||
=. call.cole (~(gas ju call.cole) (sale u.norm.hood))
|
||||
=. moan
|
||||
%+ ~(add ja moan) u.form.hood
|
||||
[soot.hood (cook u.norm.hood loop) root.hood]
|
||||
=/ next ~(tap in (~(get ju kids) i.done))
|
||||
?~ next
|
||||
$(done t.done)
|
||||
$(done t.done, enod [next enod])
|
||||
:: new entries for cold state
|
||||
++ sale
|
||||
|= norm=nomm
|
||||
^- (list [[path @] sock *])
|
||||
?- -.norm
|
||||
%par (weld $(norm left.norm) $(norm rite.norm))
|
||||
%not ~
|
||||
%one ~
|
||||
%two (weld $(norm cost.norm) $(norm corn.norm))
|
||||
%the $(norm pell.norm)
|
||||
%for $(norm mall.norm)
|
||||
%ivy (weld $(norm this.norm) $(norm that.norm))
|
||||
%six
|
||||
(weld $(norm what.norm) (weld $(norm then.norm) $(norm else.norm)))
|
||||
::
|
||||
%eve (weld $(norm once.norm) $(norm then.norm))
|
||||
%ten (weld $(norm twig.norm) $(norm tree.norm))
|
||||
%sip $(norm then.norm)
|
||||
%tip
|
||||
?. =(%fast hint.norm) (weld $(norm vice.norm) $(norm then.norm))
|
||||
=/ =hind (~(got by mind) rail.norm)
|
||||
?~ hind (weld $(norm vice.norm) $(norm then.norm))
|
||||
?~ tire.hind (weld $(norm vice.norm) $(norm then.norm))
|
||||
=* tine u.tire.hind
|
||||
=| kale=(list [[path @] sock *])
|
||||
=| calm=(map @ [=cape form=*])
|
||||
=/ tack=(list @) ~[1]
|
||||
|- ^- (list [[path @] sock *])
|
||||
?^ tack
|
||||
=/ mart (~(get by matt.tine) i.tack)
|
||||
?^ mart
|
||||
=/ =toot (~(got by moot) -.u.mart)
|
||||
?> =(bats.tine soot.toot)
|
||||
%= $
|
||||
calm (~(put by calm) i.tack [sake.toot +.u.mart])
|
||||
kale
|
||||
:_ kale
|
||||
:- [cone.tine i.tack]
|
||||
[~(norm so (~(app ca sake.toot) bats.tine)) +.u.mart]
|
||||
::
|
||||
tack t.tack
|
||||
==
|
||||
=/ clam (~(get by calm) (peg i.tack 2))
|
||||
=/ cram (~(get by calm) (peg i.tack 3))
|
||||
?: ?&(?=(^ clam) ?=(^ cram))
|
||||
=/ sake (~(uni ca cape.u.clam) cape.u.cram)
|
||||
=/ form [form.u.clam form.u.cram]
|
||||
%= $
|
||||
calm (~(put by calm) i.tack sake form)
|
||||
kale
|
||||
:_ kale
|
||||
[[cone.tine i.tack] ~(norm so (~(app ca sake) bats.tine)) form]
|
||||
::
|
||||
tack t.tack
|
||||
==
|
||||
$(tack [(peg 2 i.tack) (peg 3 i.tack) tack])
|
||||
(weld kale (weld ^$(norm vice.norm) ^$(norm then.norm)))
|
||||
::
|
||||
%elf (weld $(norm rent.norm) $(norm walk.norm))
|
||||
==
|
||||
:: pick out food for nomm
|
||||
++ cook
|
||||
|= [norm=nomm pool=(map @hail @hail)]
|
||||
^- food
|
||||
=| ices=(map @hail [=sock form=*])
|
||||
=| leap=(set [=sock form=*])
|
||||
=/ fore=(list nomm) ~[norm]
|
||||
|- ^- food
|
||||
?^ fore
|
||||
?- -.i.fore
|
||||
%par $(fore [rite.i.fore left.i.fore t.fore])
|
||||
%not $(fore t.fore)
|
||||
%one $(fore t.fore)
|
||||
%two
|
||||
=/ roil (~(gut by pool) rail.i.fore rail.i.fore)
|
||||
=/ foot (~(get by moot) roil)
|
||||
?> ?=(^ foot)
|
||||
~? ?=(~ form.u.foot) indirect+rail.i.fore
|
||||
=? ices ?=(^ form.u.foot)
|
||||
%+ ~(put by ices) rail.i.fore
|
||||
[soot u.form]:u.foot
|
||||
=? leap ?&((~(has by pool) rail.i.fore) ?=(^ form.u.foot))
|
||||
%- ~(put in leap) [soot u.form]:u.foot
|
||||
$(fore [corn.i.fore cost.i.fore t.fore])
|
||||
::
|
||||
%the $(fore [pell.i.fore t.fore])
|
||||
%for $(fore [mall.i.fore t.fore])
|
||||
%ivy $(fore [this.i.fore that.i.fore t.fore])
|
||||
%six $(fore [what.i.fore then.i.fore else.i.fore t.fore])
|
||||
%eve $(fore [once.i.fore then.i.fore t.fore])
|
||||
%ten $(fore [twig.i.fore tree.i.fore t.fore])
|
||||
%sip $(fore [then.i.fore t.fore])
|
||||
%tip $(fore [vice.i.fore then.i.fore t.fore])
|
||||
%elf $(fore [rent.i.fore walk.i.fore t.fore])
|
||||
==
|
||||
[norm ices leap]
|
||||
--
|
||||
:: parse a fast hint
|
||||
++ past
|
||||
|= a=*
|
||||
^- (unit [name=term park=(unit @) hock=(list [term @])])
|
||||
?. ?=([* [@ @] *] a) ~& [%fast-isnt a] ~
|
||||
=/ nume (bait -.a)
|
||||
?~ nume ~& [%fast-isnt a] ~
|
||||
=/ huck +>.a
|
||||
=| hock=(list [term @])
|
||||
|- ^- (unit [name=term park=(unit @) hock=(list [term @])])
|
||||
?^ huck
|
||||
?. ?&(?=([@ @] -.huck) ((sane %ta) -<.huck)) ~& [%fast-isnt a] ~
|
||||
$(hock [-.huck hock], huck +.huck)
|
||||
?. =(~ huck) ~& [%fast-isnt a] ~
|
||||
?: =(0 +<-.a) `[u.nume `+<+.a (flop hock)]
|
||||
?: =([1 0] +<.a) `[u.nume ~ (flop hock)]
|
||||
~& [%fast-isnt a] ~
|
||||
:: recursively take apart autocons
|
||||
++ peel
|
||||
|= f=*
|
||||
^- (list [axe=@ form=*])
|
||||
=/ tack=(list [@ *]) [1 f]~
|
||||
=| salt=(list [axe=@ form=*])
|
||||
|- ^- (list [axe=@ form=*])
|
||||
?^ tack
|
||||
?: ?=([^ *] +.i.tack)
|
||||
$(tack [[(peg -.i.tack 2) +<.i.tack] [(peg -.i.tack 3) +>.i.tack] t.tack])
|
||||
$(tack t.tack, salt [i.tack salt])
|
||||
salt
|
||||
:: parse a $chum from a fast hint and turn it into a term
|
||||
++ bait
|
||||
|= a=*
|
||||
^- (unit term)
|
||||
?@ a ?.(((sane %tas) a) ~ ``@tas`a)
|
||||
?. ?=([@ @] a) ~
|
||||
?. ((sane %tas) -.a) ~
|
||||
`(crip (scag 32 (weld (trip -.a) (a-co:co +.a))))
|
||||
--
|
||||
@ -1,702 +0,0 @@
|
||||
/- *sock
|
||||
!:
|
||||
|%
|
||||
++ trip
|
||||
|= toob=$<(%boom boot)
|
||||
^- (unit *)
|
||||
?- -.toob
|
||||
%safe (stub sure.toob)
|
||||
%risk (stub hope.toob)
|
||||
==
|
||||
++ stub
|
||||
|= =sock
|
||||
^- (unit *)
|
||||
?: ?=(%know -.sock)
|
||||
`know.sock
|
||||
~
|
||||
:: Split an axis into a sock into safe and unsafe components
|
||||
++ punt
|
||||
|= [axe=@ =sock]
|
||||
^- [@ @ ^sock]
|
||||
?: =(0 axe)
|
||||
[0 0 %toss ~]
|
||||
=/ saf 1
|
||||
|-
|
||||
?: =(axe 1)
|
||||
[saf 1 sock]
|
||||
?+ sock [0 0 %toss ~]
|
||||
[%know * *]
|
||||
?- (cap axe)
|
||||
%2 $(axe (mas axe), sock [%know -.know.sock], saf (peg saf 2))
|
||||
%3 $(axe (mas axe), sock [%know +.know.sock], saf (peg saf 3))
|
||||
==
|
||||
::
|
||||
[%bets *]
|
||||
?- (cap axe)
|
||||
%2 $(axe (mas axe), sock hed.sock, saf (peg saf 2))
|
||||
%3 $(axe (mas axe), sock tal.sock, saf (peg saf 3))
|
||||
==
|
||||
::
|
||||
[%toss ~]
|
||||
[saf axe %toss ~]
|
||||
==
|
||||
:: Get an axis from a sock
|
||||
++ pull
|
||||
|= arg=[@ sock]
|
||||
^- boot
|
||||
=+ [saf rik ken]=(punt arg)
|
||||
?: =(0 saf) [%boom ~]
|
||||
?: =(1 rik) [%safe ken]
|
||||
[%risk ken]
|
||||
++ yank
|
||||
|= [axe=@ =boot]
|
||||
?- boot
|
||||
[%safe *] (pull axe sure.boot)
|
||||
[%risk *] (dare (pull axe hope.boot))
|
||||
[%boom ~] [%boom ~]
|
||||
==
|
||||
:: Test if sock is atom or cell, or unknown
|
||||
++ fits
|
||||
|= =sock
|
||||
^- ^sock
|
||||
?- sock
|
||||
::
|
||||
[%know @]
|
||||
[%know 1]
|
||||
::
|
||||
[%know * *]
|
||||
[%know 0]
|
||||
::
|
||||
[%bets *]
|
||||
[%know 0]
|
||||
::
|
||||
[%dice ~]
|
||||
[%know 1]
|
||||
::
|
||||
[%flip ~]
|
||||
[%know 1]
|
||||
::
|
||||
[%toss ~]
|
||||
[%flip ~]
|
||||
==
|
||||
:: Test if we can know two socks are equal
|
||||
++ pear
|
||||
|= [a=sock b=sock]
|
||||
^- sock
|
||||
?: ?&(?=([%know *] a) ?=([%know *] b))
|
||||
?: =(know.a know.b)
|
||||
[%know 0]
|
||||
[%know 1]
|
||||
[%flip ~]
|
||||
:: Test if we can know two boots are equal
|
||||
++ bopp
|
||||
|= [a=boot b=boot]
|
||||
^- boot
|
||||
?: ?= [%boom ~] a
|
||||
[%boom ~]
|
||||
?: ?= [%boom ~] b
|
||||
[%boom ~]
|
||||
?- a
|
||||
::
|
||||
[%safe *]
|
||||
?- b
|
||||
::
|
||||
[%safe *]
|
||||
[%safe (pear sure.a sure.b)]
|
||||
::
|
||||
[%risk *]
|
||||
[%risk (pear sure.a hope.b)]
|
||||
==
|
||||
::
|
||||
[%risk *]
|
||||
?- b
|
||||
::
|
||||
[%safe *]
|
||||
[%risk (pear hope.a sure.b)]
|
||||
::
|
||||
[%risk *]
|
||||
[%risk (pear hope.a hope.b)]
|
||||
==
|
||||
==
|
||||
:: combine two socks into a sock of a cell
|
||||
++ knit
|
||||
|= [a=sock b=sock]
|
||||
^- sock
|
||||
?. ?= [%know *] a
|
||||
[%bets a b]
|
||||
?. ?= [%know *] b
|
||||
[%bets a b]
|
||||
[%know [know.a know.b]]
|
||||
:: combine two boots into a boot of a cell
|
||||
++ cobb
|
||||
|= [hed=boot tal=boot]
|
||||
^- boot
|
||||
?: ?= [%boom ~] hed
|
||||
[%boom ~]
|
||||
?: ?= [%boom ~] tal
|
||||
[%boom ~]
|
||||
?- hed
|
||||
::
|
||||
[%safe *]
|
||||
?- tal
|
||||
::
|
||||
[%safe *]
|
||||
[%safe (knit sure.hed sure.tal)]
|
||||
::
|
||||
[%risk *]
|
||||
[%risk (knit sure.hed hope.tal)]
|
||||
==
|
||||
::
|
||||
[%risk *]
|
||||
?- tal
|
||||
::
|
||||
[%safe *]
|
||||
[%risk (knit hope.hed sure.tal)]
|
||||
::
|
||||
[%risk *]
|
||||
[%risk (knit hope.hed hope.tal)]
|
||||
==
|
||||
==
|
||||
:: patch a sock
|
||||
++ darn
|
||||
|= [axe=@ pat=sock =sock]
|
||||
^- boot
|
||||
?: .= 0 axe
|
||||
[%boom ~]
|
||||
|-
|
||||
^- boot
|
||||
?: =(axe 1)
|
||||
[%safe pat]
|
||||
?: ?= [%dice ~] sock
|
||||
[%boom ~]
|
||||
?: ?= [%flip ~] sock
|
||||
[%boom ~]
|
||||
?: ?= [%know @] sock
|
||||
[%boom ~]
|
||||
?- (cap axe)
|
||||
::
|
||||
%2
|
||||
?- sock
|
||||
::
|
||||
[%know * *]
|
||||
(cobb $(axe (mas axe), sock [%know -.know.sock]) [%safe %know +.know.sock])
|
||||
::
|
||||
[%bets * *]
|
||||
(cobb $(axe (mas axe), sock hed.sock) [%safe tal.sock])
|
||||
::
|
||||
[%toss ~]
|
||||
(cobb $(axe (mas axe)) [%risk %toss ~])
|
||||
==
|
||||
::
|
||||
%3
|
||||
?- sock
|
||||
::
|
||||
[%know * *]
|
||||
(cobb [%safe %know -.know.sock] $(axe (mas axe), sock [%know +.know.sock]))
|
||||
::
|
||||
[%bets * *]
|
||||
(cobb [%safe hed.sock] $(axe (mas axe), sock tal.sock))
|
||||
::
|
||||
[%toss ~]
|
||||
(cobb [%risk %toss ~] $(axe (mas axe)))
|
||||
==
|
||||
==
|
||||
:: Stitch a boot into another boot
|
||||
++ welt
|
||||
|= [axe=@ pach=boot wole=boot]
|
||||
^- boot
|
||||
?: ?= [%boom ~] pach
|
||||
[%boom ~]
|
||||
?: ?= [%boom ~] wole
|
||||
[%boom ~]
|
||||
=/ poch
|
||||
?- pach
|
||||
::
|
||||
[%safe *]
|
||||
sure.pach
|
||||
::
|
||||
[%risk *]
|
||||
hope.pach
|
||||
==
|
||||
=/ wool
|
||||
?- wole
|
||||
::
|
||||
[%safe *]
|
||||
sure.wole
|
||||
::
|
||||
[%risk *]
|
||||
hope.wole
|
||||
==
|
||||
?: ?& ?= [%safe *] wole ?= [%safe *] pach ==
|
||||
(darn axe poch wool)
|
||||
(dare (darn axe poch wool))
|
||||
|
||||
:: Pessimize a boot by making it %risk even if it's %safe
|
||||
++ dare
|
||||
|= =boot
|
||||
?- boot
|
||||
::
|
||||
[%boom ~]
|
||||
[%boom ~]
|
||||
::
|
||||
[%risk *]
|
||||
[%risk hope.boot]
|
||||
::
|
||||
[%safe *]
|
||||
[%risk sure.boot]
|
||||
==
|
||||
:: Weaken a %know
|
||||
++ fray
|
||||
|= a=*
|
||||
^- sock
|
||||
?: ?= @ a
|
||||
[%dice ~]
|
||||
[%bets [%know -.a] [%know +.a]]
|
||||
:: Produce the intersection of two socks
|
||||
++ mous
|
||||
|= [a=sock b=sock]
|
||||
?: ?&(?=([%know *] a) ?=([%know *] b))
|
||||
?: =(know.a know.b)
|
||||
a
|
||||
$(a (fray know.a), b (fray know.b))
|
||||
?: ?=([%know *] a)
|
||||
$(a (fray know.a))
|
||||
?: ?=([%know *] b)
|
||||
$(b (fray know.b))
|
||||
?: ?&(?=([%bets *] a) ?=([%bets *] b))
|
||||
[%bets $(a hed.a, b hed.b) $(a tal.a, b tal.b)]
|
||||
?: ?&(?=([%dice ~] a) ?|(?=([%dice ~] b) ?=([%flip ~] b)))
|
||||
[%dice ~]
|
||||
?: ?&(?=([%dice ~] b) ?=([%flip ~] a))
|
||||
[%dice ~]
|
||||
?: ?&(?=([%flip ~] a) ?=([%flip ~] b))
|
||||
[%flip ~]
|
||||
[%toss ~]
|
||||
:: Produce the intersection of two boots
|
||||
::
|
||||
:: Note that the intersection of a safe or risk
|
||||
:: boot and a boom boot is a risk boot, since
|
||||
:: in a branch between a possibly non-crashing computation
|
||||
:: and a crashing computation, we might crash and we might not.
|
||||
::
|
||||
:: In particular, we have to handle assertions and
|
||||
:: error cases where it is intended that one branch of a conditional
|
||||
:: will crash
|
||||
++ gnaw
|
||||
|= [a=boot b=boot]
|
||||
?: ?= [%safe *] a
|
||||
?: ?= [%safe *] b
|
||||
[%safe (mous sure.a sure.b)]
|
||||
?: ?= [%risk *] b
|
||||
[%risk (mous sure.a hope.b)]
|
||||
[%risk sure.a]
|
||||
?: ?= [%risk *] a
|
||||
?: ?= [%safe *] b
|
||||
[%risk (mous hope.a sure.b)]
|
||||
?: ?= [%risk *] b
|
||||
[%risk (mous hope.a hope.b)]
|
||||
[%risk hope.a]
|
||||
?: ?= [%safe *] b
|
||||
[%risk sure.b]
|
||||
?: ?= [%risk *] b
|
||||
[%risk hope.b]
|
||||
[%boom ~]
|
||||
:: Produce a boot of whether a given boot is a cell or atom
|
||||
++ ques
|
||||
|= non=boot
|
||||
^- boot
|
||||
?: ?=([%boom ~] non)
|
||||
[%boom ~]
|
||||
?- non
|
||||
::
|
||||
[%safe %know @]
|
||||
[%safe %know 1]
|
||||
::
|
||||
[%safe %know * *]
|
||||
[%safe %know 0]
|
||||
::
|
||||
[%safe %bets *]
|
||||
[%safe %know 0]
|
||||
::
|
||||
[%safe %dice ~]
|
||||
[%safe %know 1]
|
||||
::
|
||||
[%safe %flip ~]
|
||||
[%safe %know 1]
|
||||
::
|
||||
[%safe %toss ~]
|
||||
[%safe %flip ~]
|
||||
::
|
||||
[%risk %know @]
|
||||
[%risk %know 1]
|
||||
::
|
||||
[%risk %know * *]
|
||||
[%risk %know 0]
|
||||
::
|
||||
[%risk %bets *]
|
||||
[%risk %know 0]
|
||||
::
|
||||
[%risk %dice ~]
|
||||
[%risk %know 1]
|
||||
::
|
||||
[%risk %flip ~]
|
||||
[%risk %know 1]
|
||||
::
|
||||
[%risk %toss ~]
|
||||
[%risk %flip ~]
|
||||
==
|
||||
++ pile
|
||||
|= tom=boot
|
||||
^- boot
|
||||
?+ tom [%boom ~]
|
||||
::
|
||||
[%safe %know @]
|
||||
[%safe %dice ~]
|
||||
::
|
||||
[%safe %dice ~]
|
||||
[%safe %dice ~]
|
||||
::
|
||||
[%safe %flip ~]
|
||||
[%safe %dice ~]
|
||||
::
|
||||
[%safe %toss ~]
|
||||
[%risk %dice ~]
|
||||
::
|
||||
[%risk %know @]
|
||||
[%risk %dice ~]
|
||||
::
|
||||
[%risk %dice ~]
|
||||
[%risk %dice ~]
|
||||
::
|
||||
[%risk %flip ~]
|
||||
[%risk %dice ~]
|
||||
::
|
||||
[%risk %toss ~]
|
||||
[%risk %dice ~]
|
||||
==
|
||||
:: Produce knowledge of the result given knowledge of the subject
|
||||
++ wash
|
||||
|= [subj=sock form=*]
|
||||
^- boot
|
||||
=| bare=[ward=(map [sock *] boot) dir=@ ind=@]
|
||||
=. ward.bare (~(put by ward.bare) [subj form] [%risk %toss ~])
|
||||
|^
|
||||
=+ swab
|
||||
~& "direct calls: {<dir>}"
|
||||
~& "indirect calls: {<ind>}"
|
||||
-<
|
||||
++ swab
|
||||
|-
|
||||
^- [boot _bare]
|
||||
?> ?=(^ form)
|
||||
?+ form [[%boom ~] bare]
|
||||
::
|
||||
[[* *] *]
|
||||
=^ l bare $(form -.form)
|
||||
=^ r bare $(form +.form)
|
||||
:_ bare
|
||||
(cobb l r)
|
||||
::
|
||||
[%0 @]
|
||||
:_ bare
|
||||
(pull +.form subj)
|
||||
::
|
||||
[%1 *]
|
||||
:_ bare
|
||||
[%safe %know +.form]
|
||||
::
|
||||
[%2 * *]
|
||||
=^ subn bare $(form +<.form)
|
||||
?: ?=([%boom ~] subn)
|
||||
[[%boom ~] bare]
|
||||
=^ forn bare $(form +>.form)
|
||||
?: ?=([%boom ~] forn)
|
||||
[[%boom ~] bare]
|
||||
?: ?= [%safe %dice ~] forn
|
||||
[[%boom ~] bare]
|
||||
?: ?= [%safe %flip ~] forn
|
||||
[[%boom ~] bare]
|
||||
?: ?= [%risk %dice ~] forn
|
||||
[[%boom ~] bare]
|
||||
?: ?= [%risk %flip ~] forn
|
||||
[[%boom ~] bare]
|
||||
?+ forn [[%risk %toss ~] bare(ind .+(ind.bare))]
|
||||
::
|
||||
[%safe %know *]
|
||||
=. dir.bare .+(dir.bare)
|
||||
?- subn
|
||||
::
|
||||
[%safe *]
|
||||
=/ nubs sure.subn
|
||||
=/ norm know.sure.forn
|
||||
=/ mem (~(get by ward.bare) [nubs norm])
|
||||
?. ?=(~ mem) [u.mem bare]
|
||||
=. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~])
|
||||
=^ r bare $(subj nubs, form norm)
|
||||
[r bare(ward (~(put by ward.bare) [nubs norm] r))]
|
||||
::
|
||||
[%risk *]
|
||||
=/ nubs hope.subn
|
||||
=/ norm know.sure.forn
|
||||
=/ mem (~(get by ward.bare) [nubs norm])
|
||||
?. ?=(~ mem) [u.mem bare]
|
||||
=. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~])
|
||||
=^ r bare $(subj nubs, form norm)
|
||||
[(dare r) bare(ward (~(put by ward.bare) [nubs norm] (dare r)))] :: XX fix up ward modifications
|
||||
==
|
||||
::
|
||||
[%risk %know *]
|
||||
=. dir.bare .+(dir.bare)
|
||||
?- subn
|
||||
::
|
||||
[%safe *]
|
||||
=/ nubs sure.subn
|
||||
=/ norm know.hope.forn
|
||||
=/ mem (~(get by ward.bare) [nubs norm])
|
||||
?. ?=(~ mem) [u.mem bare]
|
||||
=. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~])
|
||||
=^ r bare $(subj nubs, form norm)
|
||||
[(dare r) bare(ward (~(put by ward.bare) [nubs norm] (dare r)))]
|
||||
::
|
||||
[%risk *]
|
||||
=/ nubs hope.subn
|
||||
=/ norm know.hope.forn
|
||||
=/ mem (~(get by ward.bare) [nubs norm])
|
||||
?. ?=(~ mem) [u.mem bare]
|
||||
=. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~])
|
||||
=^ r bare $(subj nubs, form norm)
|
||||
[(dare r) bare(ward (~(put by ward.bare) [nubs norm] (dare r)))]
|
||||
==
|
||||
==
|
||||
::
|
||||
[%3 *]
|
||||
=^ s bare $(form +.form)
|
||||
:_ bare
|
||||
(ques s)
|
||||
::
|
||||
[%4 *]
|
||||
=^ s bare $(form +.form)
|
||||
:_ bare
|
||||
(pile s)
|
||||
::
|
||||
[%5 * *]
|
||||
=^ l bare $(form +<.form)
|
||||
=^ r bare $(form +>.form)
|
||||
:_ bare
|
||||
(bopp l r)
|
||||
::
|
||||
[%6 * * *]
|
||||
=^ cond bare $(form +<.form)
|
||||
?+ cond [[%boom ~] bare]
|
||||
::
|
||||
[%safe *]
|
||||
?+ sure.cond [[%boom ~] bare]
|
||||
::
|
||||
[%know %0]
|
||||
$(form +>-.form)
|
||||
::
|
||||
[%know %1]
|
||||
$(form +>+.form)
|
||||
::
|
||||
[%flip ~]
|
||||
=^ t bare $(form +>-.form)
|
||||
=^ f bare $(form +>+.form)
|
||||
:_ bare
|
||||
(gnaw t f)
|
||||
::
|
||||
[%dice ~]
|
||||
=^ t bare $(form +>-.form)
|
||||
=^ f bare $(form +>+.form)
|
||||
:_ bare
|
||||
(dare (gnaw t f))
|
||||
::
|
||||
[%toss ~]
|
||||
=^ t bare $(form +>-.form)
|
||||
=^ f bare $(form +>+.form)
|
||||
:_ bare
|
||||
(dare (gnaw t f))
|
||||
==
|
||||
::
|
||||
[%risk *]
|
||||
?+ hope.cond [[%boom ~] bare]
|
||||
::
|
||||
[%know %0]
|
||||
=^ t bare $(form +>-.form)
|
||||
:_ bare
|
||||
(dare t)
|
||||
::
|
||||
[%know %1]
|
||||
=^ f bare $(form +>+.form)
|
||||
:_ bare
|
||||
(dare f)
|
||||
::
|
||||
[%flip ~]
|
||||
=^ t bare $(form +>-.form)
|
||||
=^ f bare $(form +>+.form)
|
||||
:_ bare
|
||||
(dare (gnaw t f))
|
||||
::
|
||||
[%dice ~]
|
||||
=^ t bare $(form +>-.form)
|
||||
=^ f bare $(form +>+.form)
|
||||
:_ bare
|
||||
(dare (gnaw t f))
|
||||
::
|
||||
[%toss ~]
|
||||
=^ t bare $(form +>-.form)
|
||||
=^ f bare $(form +>+.form)
|
||||
:_ bare
|
||||
(dare (gnaw t f))
|
||||
==
|
||||
==
|
||||
::
|
||||
[%7 * *]
|
||||
=^ news bare $(form +<.form)
|
||||
?+ news [[%boom ~] bare]
|
||||
::
|
||||
[%safe *]
|
||||
$(subj sure.news, form +>.form)
|
||||
::
|
||||
[%risk *]
|
||||
=^ r bare $(subj hope.news, form +>.form)
|
||||
:_ bare
|
||||
(dare r)
|
||||
==
|
||||
::
|
||||
[%8 * *]
|
||||
=^ news bare $(form +<.form)
|
||||
?+ news [[%boom ~] bare]
|
||||
::
|
||||
[%safe *]
|
||||
$(subj (knit sure.news subj), form +>.form)
|
||||
::
|
||||
[%risk *]
|
||||
=^ r bare $(subj (knit hope.news subj), form +>.form)
|
||||
:_ bare
|
||||
(dare r)
|
||||
==
|
||||
::
|
||||
[%9 @ *]
|
||||
=^ news bare $(form +>.form)
|
||||
?+ news [[%boom ~] bare]
|
||||
::
|
||||
[%safe *]
|
||||
=/ newf (pull +<.form sure.news)
|
||||
?+ newf [[%boom ~] bare]
|
||||
::
|
||||
[%safe %know *]
|
||||
=. dir.bare .+(dir.bare)
|
||||
=/ nubs sure.news
|
||||
=/ norm know.sure.newf
|
||||
=/ mem (~(get by ward.bare) [nubs norm])
|
||||
?. ?=(~ mem) [u.mem bare]
|
||||
=. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~])
|
||||
=^ r bare $(subj nubs, form norm)
|
||||
:_ bare(ward (~(put by ward.bare) [nubs norm] r))
|
||||
r
|
||||
::
|
||||
[%risk %know *]
|
||||
=. dir.bare .+(dir.bare)
|
||||
=/ nubs sure.news
|
||||
=/ norm know.hope.newf
|
||||
=/ mem (~(get by ward.bare) [nubs norm])
|
||||
?. ?=(~ mem) [u.mem bare]
|
||||
=. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~])
|
||||
=^ r bare $(subj nubs, form norm)
|
||||
:_ bare(ward (~(put by ward.bare) [nubs norm] (dare r)))
|
||||
(dare r)
|
||||
::
|
||||
[%safe *]
|
||||
=. ind.bare .+(ind.bare)
|
||||
[[%risk %toss ~] bare]
|
||||
::
|
||||
[%risk *]
|
||||
=. ind.bare .+(ind.bare)
|
||||
[[%risk %toss ~] bare]
|
||||
==
|
||||
::
|
||||
[%risk *]
|
||||
=/ newf (pull +<.form hope.news)
|
||||
?+ newf [[%boom ~] bare]
|
||||
::
|
||||
[%safe %know *]
|
||||
=. dir.bare .+(dir.bare)
|
||||
=/ nubs hope.news
|
||||
=/ norm know.sure.newf
|
||||
=/ mem (~(get by ward.bare) [nubs norm])
|
||||
?. ?=(~ mem) [u.mem bare]
|
||||
=. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~])
|
||||
=^ r bare $(subj nubs, form norm)
|
||||
:_ bare(ward (~(put by ward.bare) [nubs norm] (dare r)))
|
||||
(dare r)
|
||||
::
|
||||
[%risk %know *]
|
||||
=. dir.bare .+(dir.bare)
|
||||
=/ nubs hope.news
|
||||
=/ norm know.hope.newf
|
||||
=/ mem (~(get by ward.bare) [nubs norm])
|
||||
?. ?=(~ mem) [u.mem bare]
|
||||
=. ward.bare (~(put by ward.bare) [nubs norm] [%risk %toss ~])
|
||||
=^ r bare $(subj nubs, form norm)
|
||||
:_ bare(ward (~(put by ward.bare) [nubs norm] (dare r)))
|
||||
(dare r)
|
||||
::
|
||||
[%safe *]
|
||||
=. ind.bare .+(ind.bare)
|
||||
[[%risk %toss ~] bare]
|
||||
::
|
||||
[%risk *]
|
||||
=. ind.bare .+(ind.bare)
|
||||
[[%risk %toss ~] bare]
|
||||
==
|
||||
==
|
||||
::
|
||||
[%10 [@ *] *]
|
||||
=^ p bare $(form +<+.form)
|
||||
=^ w bare $(form +>.form)
|
||||
:_ bare
|
||||
(welt +<-.form p w)
|
||||
::
|
||||
[%11 @ *]
|
||||
$(form +>.form)
|
||||
::
|
||||
[%11 [* *] *]
|
||||
=^ hint bare $(form +<+.form)
|
||||
?+ hint [[%boom ~] bare]
|
||||
::
|
||||
[%safe *]
|
||||
$(form +>.form)
|
||||
::
|
||||
[%risk *]
|
||||
=^ r bare $(form +<.form)
|
||||
:_ bare
|
||||
(dare r)
|
||||
==
|
||||
::
|
||||
[%12 *]
|
||||
[[%risk %toss ~] bare]
|
||||
==
|
||||
--
|
||||
++ cuff
|
||||
|= =sock
|
||||
=/ axe 1
|
||||
|-
|
||||
^- (list @)
|
||||
?- sock
|
||||
::
|
||||
[%know *]
|
||||
(limo [axe ~])
|
||||
::
|
||||
[%bets *]
|
||||
(weld $(axe (add axe axe), sock hed.sock) $(axe (add (add axe axe) 1), sock tal.sock))
|
||||
::
|
||||
[%dice ~]
|
||||
(limo [axe ~])
|
||||
::
|
||||
[%flip ~]
|
||||
(limo [axe ~])
|
||||
::
|
||||
[%toss ~]
|
||||
(limo [axe ~])
|
||||
==
|
||||
--
|
||||
@ -1,132 +0,0 @@
|
||||
/- *sock
|
||||
/+ ska
|
||||
|%
|
||||
:: mask axes in a noun to make a sock
|
||||
++ dope
|
||||
|= [mask=(list @) non=noun]
|
||||
^- boot
|
||||
=/ sack=boot [%safe %know non]
|
||||
|-
|
||||
^- boot
|
||||
?~ mask sack
|
||||
$(sack (welt:ska i.mask [%safe %toss ~] sack), mask t.mask)
|
||||
:: turn a hoon type into a boot
|
||||
++ wove
|
||||
|= kine=type
|
||||
^- boot
|
||||
=| gil=(set type)
|
||||
?@ kine
|
||||
?- kine
|
||||
%noun [%risk %toss ~]
|
||||
%void [%boom ~]
|
||||
==
|
||||
?- -.kine
|
||||
%atom
|
||||
?~ q.kine
|
||||
[%risk %dice ~]
|
||||
[%risk %know u.q.kine]
|
||||
::
|
||||
%cell
|
||||
(cobb:ska $(kine p.kine) $(kine q.kine))
|
||||
::
|
||||
%core
|
||||
%+ cobb:ska
|
||||
(spry p.r.q.kine) :: compiled battery
|
||||
$(kine p.kine) :: current payload
|
||||
::
|
||||
%face
|
||||
$(kine q.kine)
|
||||
::
|
||||
%fork
|
||||
=/ tins ~(tap in p.kine)
|
||||
?~ tins [%boom ~]
|
||||
=/ hypo $(kine i.tins)
|
||||
=/ tons t.tins
|
||||
|-
|
||||
^- boot
|
||||
?~ tons hypo
|
||||
$(hypo (gnaw:ska ^$(kine i.tons) hypo), tons t.tons)
|
||||
::
|
||||
%hint
|
||||
$(kine q.kine)
|
||||
::
|
||||
%hold
|
||||
?: (~(has in gil) kine)
|
||||
[%risk %toss ~]
|
||||
$(gil (~(put in gil) kine), kine ~(repo ut kine))
|
||||
==
|
||||
:: turn a seminoun into a sock
|
||||
++ spry
|
||||
|= seminoun
|
||||
^- boot
|
||||
?- -.mask
|
||||
%half
|
||||
?> ?=(^ data)
|
||||
(cobb:ska $(mask left.mask, data -.data) $(mask rite.mask, data +.data))
|
||||
::
|
||||
%full
|
||||
?~ blocks.mask
|
||||
[%risk %know data]
|
||||
[%risk %toss ~]
|
||||
::
|
||||
%lazy
|
||||
[%risk %toss ~]
|
||||
==
|
||||
:: for a stateful core, figure out what we can assume across all state
|
||||
:: transitions
|
||||
::
|
||||
:: step is a list of arm axes and result axes which are expected to produce gates
|
||||
:: the gates will be simul-slammed with %toss
|
||||
:: then the result axis will be intersected with the stateful core
|
||||
:: knowledge
|
||||
::
|
||||
:: fixed point termination argument: we can only know the same or less
|
||||
:: than what we knew last time (intersection cannot add knowledge)
|
||||
:: if we know the same, we stop now. We can only subtract finitely many
|
||||
:: axes of knowledge from the tree before we know [%boom ~] or
|
||||
:: [%risk %toss ~] at which point we will learn the same thing twice
|
||||
:: and terminate
|
||||
++ arid
|
||||
|= [muck=boot step=(list [@ @])]
|
||||
^- boot
|
||||
=/ yuck muck
|
||||
=/ stop step
|
||||
?: ?=(%boom -.muck)
|
||||
[%boom ~]
|
||||
|-
|
||||
^- boot
|
||||
?~ stop
|
||||
?: =(yuck muck)
|
||||
yuck
|
||||
^$(muck yuck)
|
||||
=/ erm (yank:ska -.i.stop muck)
|
||||
?: ?=(%boom -.erm)
|
||||
$(stop t.stop, yuck (gnaw:ska [%boom ~] yuck))
|
||||
=/ arm (trip:ska erm)
|
||||
?~ arm
|
||||
$(stop t.stop, yuck (gnaw:ska [%risk %toss ~] yuck))
|
||||
=/ cor
|
||||
?- -.muck
|
||||
%safe sure.muck
|
||||
%risk hope.muck
|
||||
==
|
||||
=/ mat (wash:ska cor u.arm)
|
||||
?: ?=(%boom -.mat)
|
||||
$(stop t.stop, yuck (gnaw:ska [%boom ~] yuck))
|
||||
=/ ear (yank:ska 2 mat)
|
||||
?: ?=(%boom -.ear)
|
||||
$(stop t.stop, yuck (gnaw:ska [%boom ~] yuck))
|
||||
=/ gar (trip:ska ear)
|
||||
?~ gar
|
||||
$(stop t.stop, yuck (gnaw:ska [%risk %toss ~] yuck))
|
||||
=/ mar (welt:ska 6 [%risk %toss ~] mat)
|
||||
?: ?=(%boom -.mar)
|
||||
$(stop t.stop, yuck (gnaw:ska [%boom ~] yuck))
|
||||
=/ gor
|
||||
?- -.mar
|
||||
%safe sure.mar
|
||||
%risk hope.mar
|
||||
==
|
||||
=/ beg (wash:ska gor u.gar)
|
||||
$(stop t.stop, yuck (gnaw:ska (yank:ska +.i.stop beg) yuck))
|
||||
--
|
||||
279
hoon/codegen/lib/soak.hoon
Normal file
279
hoon/codegen/lib/soak.hoon
Normal file
@ -0,0 +1,279 @@
|
||||
/- *sock
|
||||
|%
|
||||
:: operations on $cape
|
||||
++ ca
|
||||
|_ one=cape
|
||||
:: axes of yes
|
||||
++ yea
|
||||
^- (list @)
|
||||
=/ axe 1
|
||||
|- ^- (list @)
|
||||
?- one
|
||||
%| ~
|
||||
%& ~[axe]
|
||||
^ (weld $(one -.one, axe (peg axe 2)) $(one +.one, axe (peg axe 3)))
|
||||
==
|
||||
:: intersect two capes
|
||||
++ int
|
||||
|= two=cape
|
||||
^- cape
|
||||
?- one
|
||||
%| %|
|
||||
%& two
|
||||
^
|
||||
?- two
|
||||
%| %|
|
||||
%& one
|
||||
^
|
||||
=/ l $(one -.one, two -.two)
|
||||
=/ r $(one +.one, two +.two)
|
||||
?:(?&(?=(@ l) =(l r)) l [l r])
|
||||
==
|
||||
==
|
||||
:: apply a cape as a mask to a sock
|
||||
++ app
|
||||
|= know=sock
|
||||
|- ^- sock
|
||||
?- one
|
||||
%| [%| ~]
|
||||
%& know
|
||||
^
|
||||
?: ?=(%| cape.know) [%| ~]
|
||||
?> ?=(^ data.know)
|
||||
?: ?=(^ cape.know)
|
||||
=/ l $(one -.one, cape.know -.cape.know, data.know -.data.know)
|
||||
=/ r $(one +.one, cape.know +.cape.know, data.know +.data.know)
|
||||
[[cape.l cape.r] data.l data.r]
|
||||
=/ l $(one -.one, data.know -.data.know)
|
||||
=/ r $(one +.one, data.know +.data.know)
|
||||
[[cape.l cape.r] data.l data.r]
|
||||
==
|
||||
:: unify two capes
|
||||
++ uni
|
||||
|= two=cape
|
||||
^- cape
|
||||
?- one
|
||||
%| two
|
||||
%& one
|
||||
^
|
||||
?- two
|
||||
%| one
|
||||
%& two
|
||||
^
|
||||
=/ l $(one -.one, two -.two)
|
||||
=/ r $(one +.one, two +.two)
|
||||
?:(?&(?=(@ l) =(l r)) l [l r])
|
||||
==
|
||||
==
|
||||
:: does two add axes to one?
|
||||
:: XX make big and huge consistent
|
||||
++ big
|
||||
|= two=cape
|
||||
^- ?
|
||||
?- one
|
||||
%& |
|
||||
%| ?@(two two ?|($(two -.two) $(two +.two)))
|
||||
^
|
||||
?@ two ?|($(one -.one) $(one +.one))
|
||||
?|($(one -.one, two -.two) $(one +.one, two +.two))
|
||||
==
|
||||
:: does one actually have any axes
|
||||
++ any
|
||||
^- ?
|
||||
?@ one one
|
||||
?|(any(one -.one) any(one +.one))
|
||||
:: push a cape down to an axis
|
||||
++ pat
|
||||
|= axe=@
|
||||
?< =(0 axe)
|
||||
|- ^- cape
|
||||
?: =(1 axe) one
|
||||
?- (cap axe)
|
||||
%2 [$(axe (mas axe)) |]
|
||||
%3 [| $(axe (mas axe))]
|
||||
==
|
||||
:: split a cape
|
||||
++ rip
|
||||
^- [cape cape]
|
||||
?- one
|
||||
%| [| |]
|
||||
%& [& &]
|
||||
^ one
|
||||
==
|
||||
:: poke a hole in a cape
|
||||
++ awl
|
||||
|= axe=@
|
||||
?< =(0 axe)
|
||||
|- ^- [cape cape]
|
||||
?: ?=(%| one) [| |]
|
||||
?: =(1 axe) [one |]
|
||||
?- (cap axe)
|
||||
%2
|
||||
?- one
|
||||
%&
|
||||
=/ [p=cape t=cape] $(axe (mas axe))
|
||||
[p t &]
|
||||
::
|
||||
^
|
||||
=/ [p=cape t=cape] $(axe (mas axe), one -.one)
|
||||
[p t +.one]
|
||||
==
|
||||
::
|
||||
%3
|
||||
?- one
|
||||
%&
|
||||
=/ [p=cape t=cape] $(axe (mas axe))
|
||||
[p & t]
|
||||
::
|
||||
^
|
||||
=/ [p=cape t=cape] $(axe (mas axe), one +.one)
|
||||
[p -.one t]
|
||||
==
|
||||
==
|
||||
--
|
||||
:: operations on sock
|
||||
++ so
|
||||
|_ one=sock
|
||||
:: check that a sock is a vaid representation
|
||||
++ apt
|
||||
|- ^- ?
|
||||
?@ cape.one
|
||||
&
|
||||
?@ data.one
|
||||
|
|
||||
?& $(cape.one -.cape.one, data.one -.data.one)
|
||||
$(cape.one +.cape.one, data.one +.data.one)
|
||||
==
|
||||
:: normalize, throwing away unknown axes in data
|
||||
++ norm
|
||||
|- ^- sock
|
||||
?- cape.one
|
||||
%| [%| ~]
|
||||
%& one
|
||||
^
|
||||
?> ?=(^ data.one)
|
||||
=/ l $(cape.one -.cape.one, data.one -.data.one)
|
||||
=/ r $(cape.one +.cape.one, data.one +.data.one)
|
||||
?: ?&(=(& cape.l) =(& cape.r))
|
||||
[& data.l data.r]
|
||||
?: ?&(=(| cape.l) =(| cape.r))
|
||||
[| ~]
|
||||
[[cape.l cape.r] data.l data.r]
|
||||
==
|
||||
:: nesting
|
||||
++ huge
|
||||
|= two=sock
|
||||
^- ?
|
||||
?@ data.one
|
||||
?. ?=(@ cape.one) ~| badone+one !!
|
||||
?. cape.one &
|
||||
?&(?=(@ cape.two) cape.two =(data.one data.two))
|
||||
?@ data.two ?>(?=(@ cape.two) |)
|
||||
=/ [lope=cape rope=cape] ?:(?=(^ cape.one) cape.one [cape.one cape.one])
|
||||
=/ [loop=cape roop=cape] ?:(?=(^ cape.two) cape.two [cape.two cape.two])
|
||||
?& $(one [lope -.data.one], two [loop -.data.two])
|
||||
$(one [rope +.data.one], two [roop +.data.two])
|
||||
==
|
||||
:: axis
|
||||
++ pull
|
||||
|= axe=@
|
||||
^- (unit sock)
|
||||
?: =(0 axe) ~
|
||||
|- ^- (unit sock)
|
||||
?: =(1 axe) `one
|
||||
?: ?=(%| cape.one) `[| ~]
|
||||
?. ?=(^ data.one) ~
|
||||
?- (cap axe)
|
||||
%2 $(data.one -.data.one, cape.one ?:(?=(^ cape.one) -.cape.one &), axe (mas axe))
|
||||
%3 $(data.one +.data.one, cape.one ?:(?=(^ cape.one) +.cape.one &), axe (mas axe))
|
||||
==
|
||||
:: make a pair
|
||||
++ knit
|
||||
|= two=sock
|
||||
^- sock
|
||||
:-
|
||||
?: ?&(?=(@ cape.one) ?=(@ cape.two))
|
||||
?: cape.one ?: cape.two & [cape.one cape.two]
|
||||
?. cape.two | [cape.one cape.two]
|
||||
[cape.one cape.two]
|
||||
[data.one data.two]
|
||||
:: intersect
|
||||
++ purr
|
||||
|= two=sock
|
||||
|- ^- sock
|
||||
?^ data.one
|
||||
?@ data.two ?>(?=(@ cape.two) [| ~])
|
||||
?^ cape.one
|
||||
?^ cape.two
|
||||
%- %~ knit so
|
||||
$(one [-.cape.one -.data.one], two [-.cape.two -.data.two])
|
||||
$(one [+.cape.one +.data.one], two [+.cape.two +.data.two])
|
||||
?. cape.two [| ~]
|
||||
%- %~ knit so
|
||||
$(one [-.cape.one -.data.one], data.two -.data.two)
|
||||
$(one [+.cape.one +.data.one], data.two +.data.two)
|
||||
?. cape.one [| ~]
|
||||
?^ cape.two
|
||||
%- %~ knit so
|
||||
$(data.one -.data.one, two [-.cape.two -.data.two])
|
||||
$(data.one +.data.one, two [+.cape.two +.data.two])
|
||||
?. cape.two [| ~]
|
||||
?: =(data.one data.two) one :: optimization?
|
||||
%- %~ knit so
|
||||
$(data.one -.data.one, data.two -.data.two)
|
||||
$(data.one +.data.one, data.two +.data.two)
|
||||
?> ?=(@ cape.one)
|
||||
?^ data.two [| ~]
|
||||
?> ?=(@ cape.two)
|
||||
?: =(data.one data.two) one [| ~]
|
||||
:: edit
|
||||
++ darn
|
||||
|= [axe=@ two=sock]
|
||||
^- (unit sock)
|
||||
?: =(0 axe) ~
|
||||
|- ^- (unit sock)
|
||||
?: =(1 axe) `two
|
||||
?@ data.one
|
||||
?> ?=(@ cape.one)
|
||||
?: cape.one ~
|
||||
=/ luck $(axe (mas axe))
|
||||
?~ luck ~
|
||||
?- (cap axe)
|
||||
%2 `[[cape.u.luck |] data.u.luck ~]
|
||||
%3 `[[| cape.u.luck] ~ data.u.luck]
|
||||
==
|
||||
?@ cape.one
|
||||
?- (cap axe)
|
||||
%2
|
||||
=/ luck $(axe (mas axe), data.one -.data.one)
|
||||
?~ luck ~
|
||||
`[[cape.u.luck cape.one] data.u.luck +.data.one]
|
||||
::
|
||||
%3
|
||||
=/ luck $(axe (mas axe), data.one +.data.one)
|
||||
?~ luck ~
|
||||
`[[cape.one cape.u.luck] -.data.one data.u.luck]
|
||||
==
|
||||
?- (cap axe)
|
||||
%2
|
||||
=/ luck $(axe (mas axe), cape.one -.cape.one, data.one -.data.one)
|
||||
?~ luck ~
|
||||
`[[cape.u.luck +.cape.one] data.u.luck +.data.one]
|
||||
::
|
||||
%3
|
||||
=/ luck $(axe (mas axe), cape.one +.cape.one, data.one +.data.one)
|
||||
?~ luck ~
|
||||
`[[-.cape.one cape.u.luck] -.data.one data.u.luck]
|
||||
==
|
||||
--
|
||||
++ sap
|
||||
|= know=sock
|
||||
?> ~(apt so know)
|
||||
know
|
||||
++ sop
|
||||
|= know=sock
|
||||
~& know
|
||||
?> ~(apt so know)
|
||||
know
|
||||
--
|
||||
|
||||
@ -1,94 +1,81 @@
|
||||
/- *sock
|
||||
/- noir
|
||||
|%
|
||||
+| %ska
|
||||
+$ barn [sub=sock for=*]
|
||||
+$ nomm :: SKA-analyzed nock
|
||||
$~ [%one **]
|
||||
$% [%par nomm nomm]
|
||||
[%zer @ ?] :: safety-tagged lookup
|
||||
[%one *]
|
||||
[%two nomm nomm sock (unit *) ?] :: subject knowledge and known formula, safety-tag on metaformula
|
||||
[%thr nomm]
|
||||
[%fou nomm ?] :: safety-tagged increment
|
||||
[%fiv nomm nomm]
|
||||
[%six nomm nomm nomm]
|
||||
[%sev nomm nomm]
|
||||
:: we omit 8, translating it to 7 + autocons
|
||||
:: we omit 9, translating it to 7 + 2
|
||||
[%ten [@ nomm] nomm ?] :: safety-tagged edit
|
||||
[%els @ nomm]
|
||||
[%eld [@ nomm] nomm ?] :: safety-tagged hint formula
|
||||
[%twe nomm nomm]
|
||||
==
|
||||
+$ farm [yard=(map barn [does=nomm says=boot]) wood=(list barn)]
|
||||
+| %lin
|
||||
+$ berm [sub=sock for=* ax=@ gen=@tas] :: local label
|
||||
+$ plow :: noun<->ssa map
|
||||
$% [%fork left=plow rite=plow safe=?] :: cons of two mappings
|
||||
[%tine @] :: use this SSA value at this axis
|
||||
[%disc ~] :: no uses here or below
|
||||
:: external label
|
||||
+$ bell [text=sock:noir form=*]
|
||||
:: internal label
|
||||
+$ bile [%bile axe=@ tis=@ thus=@tas bell]
|
||||
:: ssa shape of a noun
|
||||
+$ need
|
||||
$% [%this sass=@uvre]
|
||||
[%both left=need rite=need]
|
||||
[%none ~]
|
||||
==
|
||||
+$ line :: destination
|
||||
$% [%moat wher=berm what=plow] :: place result in SSA values specified by what, go wher
|
||||
[%rift troo=berm fals=berm] :: branch on result
|
||||
[%pond ~] :: tail position, return result in a register
|
||||
+$ next $>(%next goal)
|
||||
:: destination
|
||||
+$ goal
|
||||
$% [%pick zero=bile once=bile]
|
||||
[%done ~]
|
||||
[%next what=need then=bile]
|
||||
==
|
||||
+$ bran :: instructions in a block
|
||||
$% [%imm * @] :: Write a noun to an SSA value
|
||||
[%mov @ @] :: Copy an SSA value
|
||||
[%inc @ @] :: Define second SSA register as increment of first
|
||||
[%unc @ @] :: Define a second SSA register as increment of first, without checking atomicity
|
||||
[%con @ @ @] :: Construct a cell, first SSA head, second SSA tail, third SSA result
|
||||
[%hed @ @] :: Take the head of first SSA and place in second.
|
||||
:: Crash if first SSA not a cell
|
||||
[%hud @ @] :: Take the head of the first SSA, known to be a cell
|
||||
[%tal @ @] :: Take tail head of first SSA and place in second.
|
||||
:: Crash if first SSA not a cell
|
||||
[%tul @ @] :: Take the tail of the first SSA, known to be a cell
|
||||
:: instructions in a block
|
||||
+$ pole
|
||||
$% [%imm * @uvre] :: Write a noun to an SSA value
|
||||
[%mov @uvre @uvre] :: Copy an SSA value
|
||||
[%phi (list @uvre) @uvre] :: Choose whichever SSA value is defined
|
||||
[%inc @uvre @uvre] :: Define second SSA register as increment of first
|
||||
[%con @uvre @uvre @uvre] :: Construct a cell, first SSA head, second SSA tail, third SSA result
|
||||
[%hed @uvre @uvre] :: Take the head of first SSA and place in second.
|
||||
:: Undefined if first SSA not a cell
|
||||
[%tal @uvre @uvre] :: Take tail head of first SSA and place in second.
|
||||
:: Undefined if first SSA not a cell
|
||||
[%men @uvre] :: Push onto the mean stack
|
||||
[%man ~] :: Pop from the mean stack
|
||||
[%hit @uvre] :: Profiling hit counter
|
||||
[%slg @uvre] :: Debugging print
|
||||
[%mew @uvre @uvre @uvre @uvre] :: Cache write - cache key - subject - formula - result
|
||||
[%tim ~] :: Start timer
|
||||
[%tom ~] :: Stop timer
|
||||
[%mem ~] :: Print memory usage
|
||||
==
|
||||
:: These instructions end a block.
|
||||
:: A block ends either because we need to transfer control
|
||||
:: elsewhere (hop), we need to branch (clq, eqq, brn), we need a saved
|
||||
:: control point to return to (lnk, call, hnt, spy), or we are done and
|
||||
:: transfering control to another arm (jmp, lnt), our caller (don), or
|
||||
:: the crash handler (bom).
|
||||
::
|
||||
:: The bec and eye instructions are intermediate forms only, and are
|
||||
:: translated into cal and jmp respectively once enough information is
|
||||
:: available about their targets. They exist because when linearizing
|
||||
:: and registerizing (mutually) recursive arms, there will be some call
|
||||
:: targets for which we do not know subject use maps and thus cannot yet
|
||||
:: build calls to. Once all arms are registerized, we scan for bec and
|
||||
:: eye and replace them with jmp and call with registers appropriately
|
||||
:: split.
|
||||
+$ germ :: instructions ending a block
|
||||
$% [%clq @ berm berm] :: Branch left if the SSA value is a cell, right otherwise
|
||||
[%eqq @ @ berm berm] :: Branch left if SSA registers are equal, right otherwise
|
||||
[%brn @ berm berm] :: Branch left if SSA register is 0, right if 1
|
||||
[%hop berm] :: Go to berm unconditionally (local direct jump)
|
||||
[%lnk @ @ @ berm] :: Call formula in first SSA register with subject in second,
|
||||
:: result in third, return to berm
|
||||
[%cal barn (list @) @ berm] :: Call arm given by barn, subject in first SSA register,
|
||||
:: result in second, return to berm
|
||||
[%bec barn @ @ berm] :: Not quite a call: we need to know the subject registerization of an arm.
|
||||
:: see %eye
|
||||
[%lnt @ @] :: Jump to formula in first SSA register with subject in second
|
||||
[%jmp barn (list @)] :: Jump to the code at the label in tail position,
|
||||
:: with the subject in the SSA register
|
||||
[%eye barn @] :: Look before you jump: we need to know the subject registerization of an arm
|
||||
:: before we jump to it. Until then, here's a register with
|
||||
:: the whole subject
|
||||
[%spy @ @ @ berm] :: Scry with the ref/path pair in the first 2 SSA registers
|
||||
:: define the third as the result
|
||||
[%hnt @ berm] :: Treat the result in the SSA register as a hint and continue to the given label
|
||||
|
||||
[%don @] :: Finish the procedure, returning the value in the SSA
|
||||
[%bom ~] :: Crash
|
||||
+$ pool
|
||||
$% [%hed @uvre]
|
||||
[%tal @uvre]
|
||||
==
|
||||
+$ pool (list [axe=@ ssa=@ saf=?]) :: entry point subject uses: ordered subject/ssa/safety
|
||||
+$ lock [body=(list bran) bend=germ] :: basic block: instructions + a terminator or branch
|
||||
+$ lake (map berm lock) :: code table of basic blocks
|
||||
+$ rice [goes=lake uses=pool lump=@] :: entry information and code table for an arm
|
||||
+$ sack [does=rice says=boot] :: code table entry: basic blocks + SKA result for an arm
|
||||
+$ town [land=(map barn sack) lamb=@] :: code table
|
||||
:: instructions ending a block
|
||||
+$ site
|
||||
$% [%clq @uvre bile bile] :: Branch left if the SSA value is a cell, right otherwise
|
||||
[%eqq @uvre @uvre bile bile] :: Branch left if SSA registers are equal, right otherwise
|
||||
[%brn @uvre bile bile bile] :: Branch 1st - not loobean, 2nd - 0, 3rd - 1
|
||||
[%hop bile] :: Go to bile unconditionally (local direct jump)
|
||||
[%lnk @uvre @uvre @uvre bile] :: Call formula in first SSA register with subject in second,
|
||||
:: result in third, return to bile
|
||||
[%cal bell @uvre (list @uvre) @uvre bile] :: Call arm given by bell,
|
||||
:: subject/formula pair in register
|
||||
:: subject in SSA register list,
|
||||
:: result to register, return to bile
|
||||
[%lnt @uvre @uvre] :: Jump to formula in first SSA register with subject in second
|
||||
[%jmp bell @uvre (list @uvre)] :: Jump to the code at the label in tail position,
|
||||
:: subject/formula pair in SSA register,
|
||||
:: subject in register list
|
||||
[%spy @uvre @uvre @uvre bile] :: Scry with the ref/path pair in the first 2 SSA registers
|
||||
:: define the third as the result
|
||||
[%mer @uvre @uvre @uvre @uvre bile bile] :: Cache read: key - subject - formula - hit - miss
|
||||
[%don @uvre] :: Finish the procedure, returning the value in the SSA
|
||||
[%pun ~] :: Punt to tree-walking nock, with a saved mean stack, subject, and formula
|
||||
[%bom ~] :: Crash immediately without punting
|
||||
==
|
||||
:: basic block
|
||||
+$ blob [body=(list pole) bend=site]
|
||||
:: compilation unit
|
||||
+$ pile
|
||||
$: long=bile :: starting label for direct calls
|
||||
want=need :: input registers for direct calls
|
||||
wish=bile :: starting label for indirect calls
|
||||
sire=@uvre :: input register for indirect calls
|
||||
will=(map bile blob)
|
||||
sans=@uvre :: next SSA register
|
||||
==
|
||||
:: code table
|
||||
+$ hill (map bell pile)
|
||||
--
|
||||
|
||||
56
hoon/codegen/sur/noir.hoon
Normal file
56
hoon/codegen/sur/noir.hoon
Normal file
@ -0,0 +1,56 @@
|
||||
/- *sock
|
||||
|%
|
||||
:: in-progress call table entry
|
||||
::
|
||||
:: soot: subject knowledge
|
||||
:: sake: subject battery mask
|
||||
:: form: formula if known
|
||||
:: root: result knowledge
|
||||
:: rake: result battery mask
|
||||
:: sire: @hail for call to caller, if there is one
|
||||
+$ toot
|
||||
$: soot=sock sake=cape
|
||||
form=(unit *) norm=(unit nomm)
|
||||
root=sock rake=cape
|
||||
sire=(unit @hail)
|
||||
==
|
||||
:: cold state
|
||||
+$ cool
|
||||
$: core=(jug path sock) :: nested batteries by path
|
||||
batt=(jug ^ path) :: paths by outer batteries
|
||||
call=(jug [path @] [sock *]) :: arms to exact call label
|
||||
==
|
||||
:: hint table entry
|
||||
+$ hind
|
||||
$@ ~
|
||||
[%fast tire=(unit [cone=path bats=sock matt=(map @ [@hail *])])]
|
||||
:: call table entry
|
||||
+$ hone [soot=sock norm=food root=sock]
|
||||
:: Nomm (Nock--)
|
||||
::
|
||||
:: 9 is rewritten to 7+2
|
||||
:: 8 is rewritten to 7+autocons+0
|
||||
+$ nomm
|
||||
$% [%par left=nomm rite=nomm] :: autocons
|
||||
[%one moan=*] :: Nock 1
|
||||
[%two cost=nomm corn=nomm rail=@hail] :: Nock 2 - done
|
||||
[%the pell=nomm] :: Nock 3
|
||||
[%for mall=nomm] :: Nock 4
|
||||
[%ivy this=nomm that=nomm] :: Nock 5
|
||||
[%six what=nomm then=nomm else=nomm] :: Nock 6
|
||||
[%eve once=nomm then=nomm] :: Nock 7
|
||||
[%ten here=@ twig=nomm tree=nomm] :: Nock 10
|
||||
[%sip hint=@ then=nomm] :: Nock 11 (static)
|
||||
[%tip hint=@ vice=nomm then=nomm rail=@hail] :: Nock 11 (dynamic)
|
||||
[%elf rent=nomm walk=nomm] :: "Nock 12"
|
||||
[%not here=@] :: Nock 0
|
||||
==
|
||||
+$ toms
|
||||
$@ $?(%par %wot %the %for %ivy %six %eve %vee %elf)
|
||||
$% [%two rail=@hail]
|
||||
[%ten here=@]
|
||||
[%tip hint=@ rail=@hail]
|
||||
==
|
||||
+$ food
|
||||
[=nomm ices=(map @hail [=sock form=*]) loop=(set [=sock form=*])]
|
||||
--
|
||||
@ -1,14 +1,11 @@
|
||||
|%
|
||||
+$ sock
|
||||
$% [%know know=*] :: We know everything about this noun
|
||||
[%bets hed=sock tal=sock] :: This noun is a cell, with partial knowledge of its head and tail
|
||||
[%dice ~] :: This noun is an atom
|
||||
[%flip ~] :: This noun is an atom, specifically 0 or 1
|
||||
[%toss ~] :: We know nothing about this noun
|
||||
==
|
||||
+$ boot
|
||||
$% [%boom ~] :: The Nock will crash
|
||||
[%risk hope=sock] :: The Nock that produces this noun might crash
|
||||
[%safe sure=sock] :: The Nock that produces this noun will not crash
|
||||
==
|
||||
:: mask
|
||||
::
|
||||
:: describes which axes of a noun are known
|
||||
:: but does not include the noun
|
||||
+$ cape $@(? [cape cape])
|
||||
:: sock
|
||||
::
|
||||
:: describes knowledge of a noun
|
||||
+$ sock [=cape data=*]
|
||||
--
|
||||
|
||||
Loading…
Reference in New Issue
Block a user