mirror of
https://github.com/urbit/ares.git
synced 2024-11-22 15:08:54 +03:00
destination-driven codegen spec compiles
This commit is contained in:
parent
132b732544
commit
0b741475a9
401
docs/spec/ska/lib/degen.hoon
Normal file
401
docs/spec/ska/lib/degen.hoon
Normal file
@ -0,0 +1,401 @@
|
||||
:: TODO: generate labels and jumps everywhere and stick them in the code
|
||||
:: table immediately, then linearize
|
||||
/- *gene
|
||||
/- *sock
|
||||
/+ ska
|
||||
=| prog=tinn
|
||||
=| buff=linn
|
||||
=| bust=(list linn)
|
||||
=* this .
|
||||
|%
|
||||
++ inst
|
||||
|= =dinn
|
||||
^- _this
|
||||
this(buff [dinn buff])
|
||||
++ gene
|
||||
|= bloc=labl
|
||||
^- [boot _this]
|
||||
=/ puff (~(get by prog) bloc)
|
||||
?. ?=(~ puff)
|
||||
[says.u.puff this]
|
||||
=. prog (~(put by prog) bloc [~ [%risk %gues ~]]) :: prevent recursive functions from infinite looping the compiler
|
||||
=. bust [buff bust]
|
||||
=. buff ~
|
||||
=+ faxe=1
|
||||
=+ fate=for.bloc
|
||||
=+ ject=sub.bloc
|
||||
=| heir=cost
|
||||
=| vale=dast
|
||||
=<
|
||||
=^ moot this
|
||||
|^
|
||||
^- [boot _this]
|
||||
~| 'vale must not be 5 or a subaxis of 5'
|
||||
?> (hast vale)
|
||||
?+ fate bomb
|
||||
[[* *] *]
|
||||
?: ?= [%bab *] heir
|
||||
bomb
|
||||
=/ tier [%dab (bear 3)]
|
||||
=^ shed this $(faxe (peg faxe 2), fate -.fate, heir tier, vale 4) :: we can't clobber subject
|
||||
=. this (inst [%sft ~])
|
||||
=^ stal this $(faxe (peg faxe 3), fate +.fate, heir [%dab here], vale (peg vale 3))
|
||||
=. this (inst [%mov 10 (peg vale 2)])
|
||||
=. this (inst [%mov 11 5]) :: pop without overwriting 4
|
||||
=. this tale
|
||||
:_ this
|
||||
(cobb:ska shed stal)
|
||||
::
|
||||
[%0 @]
|
||||
=. this (inst [%mov (peg 3 +.fate) vale])
|
||||
=. this bale
|
||||
:_ this
|
||||
(pull:ska +.fate ject)
|
||||
::
|
||||
[%1 *]
|
||||
=. this (inst [%imm +.fate vale])
|
||||
?: ?= [%bab *] heir
|
||||
?: =(0 +.fate)
|
||||
=. this (inst [%hop troo.heir])
|
||||
=. this tale
|
||||
:_ this
|
||||
[%safe %know +.fate]
|
||||
?: =(1 +.fate)
|
||||
=. this (inst [%hop fals.heir])
|
||||
=. this tale
|
||||
:_ this
|
||||
[%safe %know +.fate]
|
||||
bomb
|
||||
=. this tale
|
||||
:_ this
|
||||
[%safe %know +.fate]
|
||||
::
|
||||
[%2 * *]
|
||||
=/ shis this
|
||||
=/ tier [%dab (bear 7)]
|
||||
=. this hide
|
||||
=^ norm this $(faxe (peg faxe 6), fate +<.fate, heir tier, vale 4)
|
||||
?: ?= [%boom ~] norm
|
||||
bomb
|
||||
=? this ?=([%safe %know *] norm) =.(this shis hide)
|
||||
=^ news this $(faxe (peg faxe 7), fate +>.fate, heir [%dab here], vale 3)
|
||||
?: ?= [%boom ~] news
|
||||
bomb
|
||||
=/ sewn
|
||||
?- news
|
||||
[%safe *] sure.news
|
||||
[%risk *] hope.news
|
||||
==
|
||||
?: ?=([$?(%safe %risk) %know *] norm)
|
||||
=/ sabl
|
||||
?- norm
|
||||
[%safe *] [sewn know.sure.norm]
|
||||
[%risk *] [sewn know.hope.norm]
|
||||
==
|
||||
=^ toot this (gene sabl)
|
||||
?: ?=([%ret ~] heir)
|
||||
~| 'Value destination for tail call should always be 4'
|
||||
?> =(vale 4)
|
||||
=. this (inst [%jmp sabl])
|
||||
:_ this
|
||||
?: ?& ?=([%safe *] news) ?=([%safe *] norm) ==
|
||||
toot
|
||||
(dare:ska toot)
|
||||
=. this (inst [%cal sabl])
|
||||
=. this show
|
||||
=. this (inst [%mov 4 vale])
|
||||
=. this bran
|
||||
:_ this
|
||||
?: ?& ?=([%safe *] news) ?=([%safe *] norm) ==
|
||||
toot
|
||||
(dare:ska toot)
|
||||
?: ?=([%ret ~] heir)
|
||||
~| 'Value destination for tail call should always be 4'
|
||||
?> =(vale 4)
|
||||
=. this (inst [%lnt ~])
|
||||
:_ this
|
||||
[%risk %gues ~]
|
||||
=. this (inst [%lnk ~])
|
||||
=. this show
|
||||
=. this (inst [%mov 4 vale])
|
||||
=. this bran
|
||||
:_ this
|
||||
[%risk %gues ~]
|
||||
::
|
||||
[%3 *]
|
||||
:: TODO: statically jump to a branch if we know atom or cell
|
||||
=^ spec this $(faxe (peg 3 faxe), fate +.fate, heir [%dab here], vale 4)
|
||||
=. this (inst [%clq will wont])
|
||||
=. this does
|
||||
=. this dont
|
||||
:_ this
|
||||
(ques:ska spec)
|
||||
::
|
||||
[%4 *]
|
||||
=^ mota this $(faxe (peg 3 faxe), fate +.fate, heir [%dab here]) :: leave vale the same
|
||||
=. this (inst [%inc vale])
|
||||
=. this bale
|
||||
:_ this
|
||||
(pile:ska mota)
|
||||
::
|
||||
[%5 * *]
|
||||
:: TODO: statically jump to a branch if we know equal or
|
||||
:: disequal
|
||||
=/ tier (bear 7)
|
||||
=^ left this $(faxe (peg 6 faxe), fate +<.fate, heir [%dab tier], vale 8)
|
||||
=^ rite this $(faxe (peg 7 faxe), fate +>.fate, heir [%dab here], vale 9)
|
||||
=. this (inst [%eqq will wont])
|
||||
=. this does
|
||||
=. this dont
|
||||
:_ this
|
||||
(bopp:ska left rite)
|
||||
::
|
||||
[%6 * * *]
|
||||
=/ troo (bear 14)
|
||||
=/ fals (bear 15)
|
||||
=/ shis this
|
||||
=^ cond this $(faxe (peg 6 faxe), fate +<.fate, heir [%bab troo fals], vale 4)
|
||||
?: ?= [%safe %know *] cond
|
||||
?: =(0 know.sure.cond)
|
||||
=. this shis
|
||||
$(faxe (peg 14 faxe), fate +>-.fate) :: pass on heir and vale
|
||||
?: =(1 know.sure.cond)
|
||||
=. this shis
|
||||
$(faxe (peg 15 faxe), fate +>+.fate) :: pass on heir and vale
|
||||
bomb
|
||||
?: ?= [%risk %know *] cond
|
||||
?: =(0 know.hope.cond)
|
||||
=. this (inst [%her troo])
|
||||
=^ trus this $(faxe (peg 14 faxe), fate +>-.fate) :: pass on heir and vale
|
||||
:_ this
|
||||
(dare:ska trus)
|
||||
?: =(1 know.hope.cond)
|
||||
=. this (inst [%her fals])
|
||||
=^ lies this $(faxe (peg 15 faxe), fate +>+.fate)
|
||||
:_ this
|
||||
(dare:ska lies)
|
||||
bomb
|
||||
?: ?= [%safe %bets *] cond
|
||||
bomb
|
||||
?: ?= [%risk %bets *] cond
|
||||
bomb
|
||||
=. this (inst [%her troo])
|
||||
=^ trus this $(faxe (peg 14 faxe), fate +>-.fate) :: pass on heir and vale
|
||||
=. this (inst [%her fals])
|
||||
=^ lies this $(faxe (peg 15 faxe), fate +>+.fate) :: pass on heir and vale
|
||||
:_ this
|
||||
?: ?= [%safe %flip ~] cond
|
||||
(gnaw:ska trus lies)
|
||||
(dare:ska (gnaw:ska trus lies))
|
||||
::
|
||||
[%7 * *]
|
||||
=. this hide
|
||||
=^ news this $(faxe (peg 6 faxe), fate +<.fate, heir [%dab (bear 7)], vale 3) :: put result in subject
|
||||
?: ?= [%boom ~] news
|
||||
bomb
|
||||
=/ sewn
|
||||
?- news
|
||||
[%safe *] sure.news
|
||||
[%risk *] hope.news
|
||||
==
|
||||
?: ?= [%ret ~] heir
|
||||
=^ soot this $(faxe (peg 7 faxe), fate +>.fate, ject sewn)
|
||||
:_ this
|
||||
?: ?= [%safe *] news
|
||||
soot
|
||||
(dare:ska soot)
|
||||
:: this is what we must do for now to make sure the subject is
|
||||
:: cleaned up in a test expression.
|
||||
:: TODO: some way to inject the cleanup code at the start of
|
||||
:: the branches so we can still branch directly
|
||||
=^ soot this $(faxe (peg 7 faxe), fate +>.fate, heir [%dab here], vale 4, ject sewn)
|
||||
=. this show
|
||||
=. this (inst [%mov 4 vale])
|
||||
=. this bran
|
||||
:_ this
|
||||
?: ?= [%safe *] news
|
||||
soot
|
||||
(dare:ska soot)
|
||||
::
|
||||
[%8 * *]
|
||||
=^ news this $(faxe (peg 6 faxe), fate +<.fate, heir [%dab (bear 7)], vale 8) :: store in head of result
|
||||
?: ?= [%boom ~] news
|
||||
bomb
|
||||
=/ sewn
|
||||
?- news
|
||||
[%safe *] sure.news
|
||||
[%risk *] hope.news
|
||||
==
|
||||
=/ newp (knit:ska sewn ject)
|
||||
=. this (inst [%mov 3 9]) :: copy subject to tail of result
|
||||
=. this (inst [%mov 4 3]) :: copy cell back to subject
|
||||
?: ?= [%ret ~] heir
|
||||
=^ hoot this $(faxe (peg 7 faxe), fate +>.fate, ject newp)
|
||||
:_ this
|
||||
?: ?= [%safe *] news
|
||||
hoot
|
||||
(dare:ska hoot)
|
||||
=^ hoot this $(faxe (peg 7 faxe), fate +>.fate, ject newp, heir [%dab here], vale 4)
|
||||
=. this (inst [%mov 7 3]) :: put the subject back
|
||||
=. this (inst [%mov 4 vale]) :: put the result in the right place
|
||||
:_ this
|
||||
?: ?= [%safe *] news
|
||||
hoot
|
||||
(dare:ska hoot)
|
||||
::
|
||||
[%9 @ *]
|
||||
=. this hide
|
||||
=^ bore this $(faxe (peg 7 faxe), fate +>.fate, heir [%dab (bear 6)], vale 3)
|
||||
?: ?= [%boom ~] bore
|
||||
bomb
|
||||
=/ sore
|
||||
?- bore
|
||||
[%safe *] sure.bore
|
||||
[%risk *] hope.bore
|
||||
==
|
||||
=/ norm (pull:ska +<.fate sore)
|
||||
?: ?= [%boom ~] norm
|
||||
bomb
|
||||
=? this ?!(?=([%safe %know *] norm)) (inst [%mov (peg 3 +<.fate) 4]) :: look up axis
|
||||
?: ?=([$?(%safe %risk) %know *] norm)
|
||||
=/ sabl
|
||||
?- norm
|
||||
[%safe %know *] [sore know.sure.norm]
|
||||
[%risk %know *] [sore know.hope.norm]
|
||||
==
|
||||
=^ noot this (gene sabl)
|
||||
?: ?= [%ret ~] heir
|
||||
=. this (inst [%jmp sabl])
|
||||
:_ this
|
||||
?: ?&(?=([%safe *] bore) ?=([%safe *] norm))
|
||||
noot
|
||||
(dare:ska noot)
|
||||
=. this (inst [%cal sabl])
|
||||
=. this show
|
||||
=. this (inst [%mov 4 vale])
|
||||
=. this bran
|
||||
:_ this
|
||||
?: ?&(?=([%safe *] bore) ?=([%safe *] norm))
|
||||
noot
|
||||
(dare:ska noot)
|
||||
?: ?= [%ret ~] heir
|
||||
=. this (inst [%lnt ~])
|
||||
:_ this
|
||||
[%risk %gues ~]
|
||||
=. this (inst [%lnk ~])
|
||||
=. this show
|
||||
=. this (inst [%mov 4 vale])
|
||||
=. this bran
|
||||
:_ this
|
||||
[%risk %gues ~]
|
||||
::
|
||||
[%10 [@ *] *]
|
||||
=^ soot this $(faxe (peg 13 faxe), fate +<+.fate, heir [%dab (bear 7)], vale 4)
|
||||
=. this (inst [%sft ~])
|
||||
=^ toot this $(faxe (peg 7 faxe), fate +>.fate, heir [%dab here]) :: write tree to destination
|
||||
=. this (inst [%ust ~])
|
||||
=. this (inst [%mov 4 (peg vale +<-.fate)]) :: write patch to axis under destination
|
||||
:_ this
|
||||
(welt:ska +<-.fate soot toot)
|
||||
::
|
||||
[%11 @ *]
|
||||
$(faxe (peg 7 faxe), fate +>.fate)
|
||||
::
|
||||
[%11 [@ *] *]
|
||||
=^ hoot this $(faxe (peg 13 faxe), fate +<+.fate, heir [%dab (bear 7)], vale 4)
|
||||
?: ?= [%boom ~] hoot
|
||||
bomb
|
||||
=^ root this $(faxe (peg 7 faxe), fate +>.fate)
|
||||
:_ this
|
||||
?: ?= [%safe *] hoot
|
||||
root
|
||||
(dare:ska root)
|
||||
::
|
||||
[%12 * *]
|
||||
=^ root this $(faxe (peg 6 faxe), fate +<.fate, heir [%dab (bear 7)], vale 8)
|
||||
?: ?= [%boom ~] root
|
||||
bomb
|
||||
=^ soot this $(faxe (peg 7 faxe), fate +>.fate, heir [%dab here], vale 9)
|
||||
?: ?= [%boom ~] soot
|
||||
bomb
|
||||
=. this (inst [%spy ~])
|
||||
=. this (inst [%mov 4 vale])
|
||||
:_ this
|
||||
[%risk %gues ~]
|
||||
==
|
||||
:: hide away a subject for later (clobbers 4)
|
||||
++ hide
|
||||
=. this (inst [%mov 3 4])
|
||||
(inst [%sft ~]) :: subject is now in 10
|
||||
:: put back a subject that was hidden away (does not clobber 4)
|
||||
++ show
|
||||
=. this (inst [%mov 10 3]) :: put back the subject
|
||||
=. this (inst [%mov 4 10]) :: put the result where it will get shifted back into result space
|
||||
(inst [%ust ~])
|
||||
++ bran
|
||||
?: ?= [%bab *] heir
|
||||
(inst [%brn troo.heir fals.heir])
|
||||
this
|
||||
++ tale
|
||||
?: ?= [%ret ~] heir
|
||||
~| 'Must have data destination 4 when control destination is %ret'
|
||||
?> =(4 vale)
|
||||
(inst [%don ~])
|
||||
this
|
||||
++ bale
|
||||
=. this bran
|
||||
tale
|
||||
++ does
|
||||
=. this (inst [%her will])
|
||||
=. this (inst [%imm 0 vale])
|
||||
?- heir
|
||||
[%dab *] (inst [%hop wher.heir])
|
||||
[%bab *] (inst [%hop troo.heir])
|
||||
[%ret ~] (inst [%don ~])
|
||||
==
|
||||
++ dont
|
||||
=. this (inst [%her wont])
|
||||
=. this (inst [%imm 1 vale])
|
||||
?- heir
|
||||
[%dab *] (inst [%hop wher.heir])
|
||||
[%bab *] (inst [%hop fals.heir])
|
||||
[%ret ~] (inst [%don ~])
|
||||
==
|
||||
:: assert correctness of a dast: must not be 5 or a subaxis of 5
|
||||
++ hast
|
||||
|= wast=dast
|
||||
^- ?
|
||||
?. (lth wast 5)
|
||||
?. =(wast 5)
|
||||
$(wast (mas wast))
|
||||
%.n
|
||||
%.y
|
||||
--
|
||||
(done moot)
|
||||
|%
|
||||
++ done
|
||||
|= says=boot
|
||||
^- [boot _this]
|
||||
:- says
|
||||
~| 'We pushed onto bust so it should be nonempty' ?> ?= [* *] bust
|
||||
this(prog (~(put by prog) bloc [(flop buff) says]), buff -.bust, bust +.bust)
|
||||
++ bomb
|
||||
^- [boot _this]
|
||||
=. buff ~[[%bom ~]]
|
||||
:_ this
|
||||
[%boom ~]
|
||||
++ bear
|
||||
|= weir=@
|
||||
^- dabl
|
||||
[sub.bloc for.bloc (peg faxe weir) 0]
|
||||
++ here
|
||||
^- dabl
|
||||
[sub.bloc for.bloc faxe 1]
|
||||
++ will
|
||||
^- dabl
|
||||
[sub.bloc for.bloc faxe 2]
|
||||
++ wont
|
||||
^- dabl
|
||||
[sub.bloc for.bloc faxe 3]
|
||||
--
|
||||
--
|
@ -1,3 +1,6 @@
|
||||
:: TODO:
|
||||
:: ?= in wide form
|
||||
:: fix ?- and ?+
|
||||
/- *sock
|
||||
/- *gene
|
||||
/+ ska
|
||||
@ -75,12 +78,8 @@
|
||||
boom
|
||||
=/ nows
|
||||
?- news
|
||||
::
|
||||
[%safe *]
|
||||
sure.news
|
||||
::
|
||||
[%risk *]
|
||||
risk.news
|
||||
[%safe *] sure.news
|
||||
[%risk *] risk.news
|
||||
==
|
||||
=/ shis this
|
||||
=. this (inst [%put 2])
|
||||
@ -93,7 +92,7 @@
|
||||
=. this shis
|
||||
=. this (inst [%sub ~])
|
||||
=/ nabl [nows know.sure.newf]
|
||||
=^ res this (fics nabl)
|
||||
=^ res this (fics nabl)
|
||||
=. this (inst [%cal nabl])
|
||||
=. this (inst [%reo 1])
|
||||
=. this (inst [%pop ~])
|
||||
@ -184,7 +183,7 @@
|
||||
hope.news
|
||||
==
|
||||
=. this (inst [%sub ~])
|
||||
=^ res $(for.bloc +>.for.bloc, sub.bloc nows, mod %step)
|
||||
=^ res this $(for.bloc +>.for.bloc, sub.bloc nows, mod %step)
|
||||
=. this (inst [%reo 0])
|
||||
=. this (inst [%pop ~])
|
||||
?: ?= [%safe *] news
|
||||
@ -654,7 +653,7 @@
|
||||
hope.news
|
||||
==
|
||||
=. this (inst [%sub ~])
|
||||
=^ res $(for.bloc +>.for.bloc, sub.bloc nows)
|
||||
=^ res this $(for.bloc +>.for.bloc, sub.bloc nows)
|
||||
?: ?= [%safe *] news
|
||||
[res this]
|
||||
[(dare res) this]
|
||||
@ -680,19 +679,15 @@
|
||||
::
|
||||
[%9 @ *]
|
||||
=^ newc this $(for.bloc +>.for.bloc, mod %step)
|
||||
?: ?= [%boom ~] newc
|
||||
?: ?=([%boom ~] newc)
|
||||
bomb
|
||||
=/ nowc
|
||||
?- newc
|
||||
::
|
||||
[%safe *]
|
||||
sure.newc
|
||||
::
|
||||
[%risk *]
|
||||
hope.newc
|
||||
[%safe *] sure.newc
|
||||
[%risk *] hope.newc
|
||||
==
|
||||
=. this (inst [%sub ~])
|
||||
=. newf (pull +<.for.bloc nowc)
|
||||
=/ newf (pull +<.for.bloc nowc)
|
||||
?: ?= [%boom ~] newf
|
||||
bomb
|
||||
=/ shis this
|
||||
@ -745,7 +740,194 @@
|
||||
==
|
||||
::
|
||||
%tail
|
||||
~| 'TODO: implement tail mode' !!
|
||||
?+ for.bloc bomb
|
||||
::
|
||||
[[* *] *]
|
||||
=. this (inst [%puh 1])
|
||||
=^ hed this $(for.bloc -.for.bloc, mod %save)
|
||||
=. this (inst [%put 0])
|
||||
=^ tal this $(for.bloc +.for.bloc, mod %step)
|
||||
=. this (inst [%cel 0])
|
||||
=. this (inst [%pop ~])
|
||||
(done (cobb hed tal))
|
||||
::
|
||||
[%0 @]
|
||||
=. (inst [%axe +.for.bloc])
|
||||
(done (pull +.for.bloc sub.bloc))
|
||||
::
|
||||
[%1 *]
|
||||
=. (inst [%con +.for.bloc])
|
||||
(done (%safe %know +.for.bloc))
|
||||
::
|
||||
[%2 *]
|
||||
=^ news this $(for.bloc +<.for.bloc, mod %save)
|
||||
?: ?= [%boom ~] news
|
||||
bomb
|
||||
=/ nows
|
||||
?- news
|
||||
::
|
||||
[%safe *]
|
||||
sure.news
|
||||
::
|
||||
[%risk *]
|
||||
hope.news
|
||||
==
|
||||
=/ shis this
|
||||
=. this (inst [%puh 1])
|
||||
=. this (inst [%put 0])
|
||||
=^ newf this $(for.bloc +>.for.bloc, mod %step)
|
||||
=. this (inst [%cel 0])
|
||||
=. this (inst [%pop ~])
|
||||
=. this (inst [%noc ~])
|
||||
?: ?= [%boom ~] newf
|
||||
bomb
|
||||
?: ?= [%safe %know *] newf
|
||||
=. this shis
|
||||
=. this (inst [%sub ~])
|
||||
=/ nabl [nows know.sure.newf]
|
||||
=^ res this (fics nabl)
|
||||
=. this (inst [%jmp nabl])
|
||||
?: ?= [%safe *] news
|
||||
(done res)
|
||||
(done (dare res))
|
||||
?: ?= [%risk %know *] newf
|
||||
=/ nabl [nows know.hope.newf]
|
||||
=^ res this (fics nabl)
|
||||
=. this (inst [%jmp nabl])
|
||||
(done (dare res))
|
||||
=. this (inst [%lnt ~])
|
||||
(done [%risk %gues ~])
|
||||
::
|
||||
[%3 *]
|
||||
=^ non this $(for.bloc +.for.bloc, mod %step)
|
||||
=. this (inst [%clq ~])
|
||||
(done (ques:ska non))
|
||||
::
|
||||
[%4 *]
|
||||
=^ num this $(for.bloc +.for.bloc, mod %step)
|
||||
=. this (inst [%inc ~])
|
||||
(done (pile:ska non))
|
||||
::
|
||||
[%5 * *]
|
||||
=. this (inst [%puh 1])
|
||||
=^ nox this $(for.bloc +<.for.bloc, mod %save)
|
||||
=. this (inst [%put 0])
|
||||
=^ noy this $(for.bloc +<.for.bloc, mod %step)
|
||||
=. this (inst [%eqq 0])
|
||||
=. this (inst [%pop ~])
|
||||
(done (bopp:ska nox noy))
|
||||
::
|
||||
[%6 * * *]
|
||||
=/ shis this
|
||||
=^ tes this $(for.bloc +<.for.bloc, mod %save)
|
||||
?: ?= [%boom ~] tes
|
||||
bomb
|
||||
?: ?= [%safe %know 0]
|
||||
=. this shis
|
||||
=^ res this $(for.bloc +>-.for.bloc)
|
||||
(done res)
|
||||
?: ?= [%safe %know 1]
|
||||
=. this shis
|
||||
=^ res this $(for.bloc +>+.for.bloc)
|
||||
(done res)
|
||||
?: ?= [%risk %know 0]
|
||||
=^ res this $(for.bloc +>-.for.bloc)
|
||||
(done (dare res))
|
||||
?: ?= [%risk %know 1]
|
||||
=^ res this $(for.bloc +>+.for.bloc)
|
||||
(done (dare res))
|
||||
?: ?| ?= [%safe %know *] tes
|
||||
?= [%safe %bets *] tes
|
||||
?= [%risk %know *] tes
|
||||
?= [%risk %bets *] tes
|
||||
==
|
||||
bomb
|
||||
=^ gib this gibl
|
||||
=. this (inst [%br1 gib])
|
||||
=^ roo this $(for.bloc +>-.for.bloc)
|
||||
=. this (inst [%brh gib])
|
||||
=^ ral this $(for.bloc +>+.for.bloc)
|
||||
?: ?= [%safe %flip ~] tes
|
||||
(done (gnaw:ska roo ral))
|
||||
(done (dare:ska (gnaw:ska roo ral))
|
||||
::
|
||||
[%7 * *]
|
||||
=^ news this $(for.bloc +<.for.bloc, mod %step)
|
||||
?: ?= [%boom ~] news
|
||||
bomb
|
||||
=/ nows
|
||||
?- news
|
||||
::
|
||||
[%safe *]
|
||||
sure.news
|
||||
::
|
||||
[%risk *]
|
||||
hope.news
|
||||
==
|
||||
=. this (inst [%sub ~])
|
||||
=^ res this $(for.bloc +>.for.bloc, sub.bloc nows)
|
||||
?: ?= [%safe *] news
|
||||
(done res)
|
||||
(done (dare:ska res))
|
||||
::
|
||||
[%8 * *]
|
||||
=^ newh this $(for.bloc +<.for.bloc, mod %save)
|
||||
?: ?= [%boom ~] newh
|
||||
bomb
|
||||
=/ nowh
|
||||
?- newh
|
||||
::
|
||||
[%safe *]
|
||||
sure.newh
|
||||
::
|
||||
[%risk *]
|
||||
hope.newh
|
||||
==
|
||||
=. this (inst [%ext ~])
|
||||
=^ res $(for.bloc +>.for.bloc, sub.bloc (knit nows sub.bloc))
|
||||
?: ?= [%safe *] newh
|
||||
(done res)
|
||||
(done (dare:ska res))
|
||||
::
|
||||
[%9 @ *]
|
||||
=^ newc this $(for.bloc +>.for.bloc, mod %step)
|
||||
?: ?= [%boom ~] newc
|
||||
bomb
|
||||
=/ nowc
|
||||
?- newc
|
||||
::
|
||||
[%safe *]
|
||||
sure.newc
|
||||
::
|
||||
[%risk *]
|
||||
hope.newc
|
||||
==
|
||||
=. this (inst [%sub ~])
|
||||
=/ newf (pull +<.for.bloc nowc)
|
||||
?: ?= [%boom ~] newf
|
||||
bomb
|
||||
=/ shis this
|
||||
=. this (inst [%axe +<.for.bloc])
|
||||
?: ?= [%safe %know *] newf
|
||||
=. this shis
|
||||
=/ nabl [nowc know.sure.newf]
|
||||
=^ res this (fics nabl)
|
||||
=. this (inst [%jmp nabl])
|
||||
?: ?= [%safe *] newc
|
||||
(done res)
|
||||
(done (dare res))
|
||||
?: ?= [%risk %know *] newf
|
||||
=/ nabl [nowc know.sure.newf]
|
||||
=^ res this (fics nabl)
|
||||
=. this (inst [%jmp nabl])
|
||||
(done (dare res))
|
||||
=. this (inst [%lnt ~])
|
||||
(done [%risk %gues ~])
|
||||
::
|
||||
[%10 [@ *] *]
|
||||
=. this (inst [%puh 1])
|
||||
=^ wole this $(for.bloc +>.for.bloc, mod %save)
|
||||
|
||||
==
|
||||
++ done
|
||||
|= says=boot
|
||||
@ -764,7 +946,7 @@
|
||||
=. this crop
|
||||
[res this]
|
||||
u.vet
|
||||
++ boom
|
||||
++ bomb
|
||||
?: ?= mod %tail
|
||||
(done [%boom ~])
|
||||
:- [%boom ~]
|
||||
|
213
docs/spec/ska/lib/run.hoon
Normal file
213
docs/spec/ska/lib/run.hoon
Normal file
@ -0,0 +1,213 @@
|
||||
/- *sock
|
||||
/- *gene
|
||||
|%
|
||||
++ run
|
||||
|= [prog=tabl tart=labl ject=*]
|
||||
^- (unit *)
|
||||
=/ uuff (~(get by prog) tart)
|
||||
?~ uuff
|
||||
~
|
||||
=/ buff does.u.uuff
|
||||
=| resu=*
|
||||
=| stac=(list (list *))
|
||||
|^ ?~ buff
|
||||
~
|
||||
=/ inst i.buff
|
||||
=. buff t.buff
|
||||
?- inst
|
||||
::
|
||||
[%con *]
|
||||
$(resu +.inst)
|
||||
::
|
||||
[%axe *]
|
||||
=/ r (axes +.inst)
|
||||
?~ r
|
||||
~
|
||||
$(resu u.r)
|
||||
::
|
||||
[%cel @]
|
||||
=/ r (both (segt +.inst (some resu)))
|
||||
?~ r
|
||||
~
|
||||
$(resu u.r)
|
||||
::
|
||||
[%clq @]
|
||||
$(resu .?(resu))
|
||||
::
|
||||
[%inc ~]
|
||||
$(res .+(resu))
|
||||
::
|
||||
[eqq @]
|
||||
=/ r (mate (segt +.inst) (some resu))
|
||||
?~ r
|
||||
~
|
||||
$(resu u.r)
|
||||
::
|
||||
[%br1 *]
|
||||
?: ?= %0 resu
|
||||
$
|
||||
?: ?= %1 resu
|
||||
$(buff (julp +.inst))
|
||||
~
|
||||
::
|
||||
[%bru *]
|
||||
$(buff (julp +.inst))
|
||||
::
|
||||
[%brh *]
|
||||
$
|
||||
::
|
||||
[%sub ~]
|
||||
$(ject resu)
|
||||
::
|
||||
[%ext ~]
|
||||
$(ject [resu ject])
|
||||
::
|
||||
[%dxt ~]
|
||||
?: ?= ject [* *]
|
||||
$(ject +.ject)
|
||||
~
|
||||
::
|
||||
[%noc ~]
|
||||
?: ?= resu [* *]
|
||||
$(ject -.resu, resu +.resu)
|
||||
~
|
||||
::
|
||||
[%lnk ~]
|
||||
~| 'TODO: run lnk'
|
||||
::
|
||||
[%cal *]
|
||||
=/ stuc (sput 0 t.buff)
|
||||
?~ stuc
|
||||
~
|
||||
=. stac u.stuc
|
||||
=/ nuuf (~(get by prog) +.inst)
|
||||
?~ nuuf
|
||||
~
|
||||
$(buff does.u.nuuf)
|
||||
::
|
||||
[%lnt ~]
|
||||
~| 'TODO: run lnt'
|
||||
::
|
||||
[%jmp *]
|
||||
=/ nuuf (~(get by prog) +.inst)
|
||||
?~ nuuf
|
||||
~
|
||||
$(buff does.u.nuuf)
|
||||
::
|
||||
[%edt *]
|
||||
=/ edut (edit +.inst resu ject)
|
||||
?~ edut
|
||||
~
|
||||
$(resu u.edut)
|
||||
::
|
||||
[%spy ~]
|
||||
~| 'TODO: run spy'
|
||||
::
|
||||
[%puh @]
|
||||
$(stac [(reap +.inst ~) stac])
|
||||
::
|
||||
[%put @]
|
||||
=/ stuc (sput +.inst resu)
|
||||
?~ stuc
|
||||
~
|
||||
$(stac u.stuc)
|
||||
::
|
||||
[%get @]
|
||||
=/ guts (segt +.inst)
|
||||
?~ guts
|
||||
~
|
||||
$(resu u.guts)
|
||||
::
|
||||
[%sav @]
|
||||
=/ stuc (sput +.inst ject)
|
||||
?~ stuc
|
||||
~
|
||||
$(stac u.stuc)
|
||||
::
|
||||
[%reo @]
|
||||
=/ guts (segt +.inst)
|
||||
?~ guts
|
||||
~
|
||||
$(ject u.guts)
|
||||
::
|
||||
[%don ~]
|
||||
?~ stac
|
||||
(some resu)
|
||||
=/ guts (segt 0)
|
||||
?~ guts
|
||||
~
|
||||
$(buff u.guts)
|
||||
::
|
||||
[%bom ~]
|
||||
~
|
||||
==
|
||||
:: get an axis from the subject
|
||||
++ axes
|
||||
|= ax=@
|
||||
^- (unit *)
|
||||
?: ?= %0 ax
|
||||
~
|
||||
|-
|
||||
^- (unit *)
|
||||
?: ?= %1 ax
|
||||
(some ject)
|
||||
?. ?= [* *] ject
|
||||
~
|
||||
?- (cap ax)
|
||||
::
|
||||
%2
|
||||
$(ax (mas ax), ject -.ject)
|
||||
::
|
||||
%3
|
||||
$(ax (mas ax), ject +.ject)
|
||||
==
|
||||
:: get the value of a slot in the stack frame
|
||||
++ segt
|
||||
|= slot=@
|
||||
^- (unit *)
|
||||
?~ stac
|
||||
~
|
||||
=/ fra (slag slot i.stac)
|
||||
?~ fra
|
||||
~
|
||||
i.fra
|
||||
:: put a value into the frame
|
||||
++ sput
|
||||
|= [slot=@ cont=*]
|
||||
^- (unit _stac)
|
||||
?~ stac
|
||||
~
|
||||
?. (gth (lent i.stac) slot)
|
||||
~
|
||||
=. i.stac (snap i.stac slot cont)
|
||||
(some stac)
|
||||
++ edit
|
||||
|= [ax=@ pat=* tre=*]
|
||||
^- (unit *)
|
||||
?: ?= %0 ax
|
||||
~
|
||||
|-
|
||||
^- (unit *)
|
||||
?: ?= %1 ax
|
||||
(some pat)
|
||||
?. ?= [* *] tre
|
||||
~
|
||||
?- (cap ax)
|
||||
::
|
||||
%2
|
||||
:- $(ax (mas ax), tre -.tre) +.tre
|
||||
::
|
||||
%3
|
||||
:- -.tre $(ax (mas ax), tre +.tre)
|
||||
==
|
||||
:: jump to a local label brh
|
||||
++ julp
|
||||
|= mabl=labl
|
||||
^- _buff
|
||||
?~ buff
|
||||
~
|
||||
?: .= i.buff [%brh mabl]
|
||||
t.buff
|
||||
$(buff t.buff)
|
||||
--
|
||||
--
|
@ -7,7 +7,7 @@
|
||||
?: .= axe 0
|
||||
[%boom ~]
|
||||
|-
|
||||
?: (= axe 1)
|
||||
?: =(axe 1)
|
||||
[%safe sock]
|
||||
?- sock
|
||||
::
|
||||
@ -45,7 +45,7 @@
|
||||
:: Test if sock is atom or cell, or unknown
|
||||
++ fits
|
||||
|= =sock
|
||||
^- sock
|
||||
^- ^sock
|
||||
?- sock
|
||||
::
|
||||
[%know @]
|
||||
@ -70,8 +70,8 @@
|
||||
++ pear
|
||||
|= [a=sock b=sock]
|
||||
^- sock
|
||||
?: ?& ?= [%know *] a ?= [%know *] b
|
||||
?: .= know.a know.b
|
||||
?: ?&(?=([%know *] a) ?=([%know *] b))
|
||||
?: =(know.a know.b)
|
||||
[%know 0]
|
||||
[%know 1]
|
||||
[%flip ~]
|
||||
@ -118,30 +118,30 @@
|
||||
++ cobb
|
||||
|= [hed=boot tal=boot]
|
||||
^- boot
|
||||
?: ?= [%boom ~] a
|
||||
?: ?= [%boom ~] hed
|
||||
[%boom ~]
|
||||
?: ?= [%boom ~] b
|
||||
?: ?= [%boom ~] tal
|
||||
[%boom ~]
|
||||
?- a
|
||||
?- hed
|
||||
::
|
||||
[%safe *]
|
||||
?- b
|
||||
?- tal
|
||||
::
|
||||
[%safe *]
|
||||
[%safe (knit sure.a sure.b)]
|
||||
[%safe (knit sure.hed sure.tal)]
|
||||
::
|
||||
[%risk *]
|
||||
[%risk (knit sure.a hope.b)]
|
||||
[%risk (knit sure.hed hope.tal)]
|
||||
==
|
||||
::
|
||||
[%risk *]
|
||||
?- b
|
||||
?- tal
|
||||
::
|
||||
[%safe *]
|
||||
[%risk (knit hope.a sure.b)]
|
||||
[%risk (knit hope.hed sure.tal)]
|
||||
::
|
||||
[%risk *]
|
||||
[%risk (knit hope.a hope.b)]
|
||||
[%risk (knit hope.hed hope.tal)]
|
||||
==
|
||||
==
|
||||
:: patch a sock
|
||||
@ -191,6 +191,7 @@
|
||||
:: Stitch a boot into another boot
|
||||
++ welt
|
||||
|= [axe=@ pach=boot wole=boot]
|
||||
^- boot
|
||||
?: ?= [%boom ~] pach
|
||||
[%boom ~]
|
||||
?: ?= [%boom ~] wole
|
||||
@ -241,21 +242,21 @@
|
||||
:: Produce the intersection of two socks
|
||||
++ mous
|
||||
|= [a=sock b=sock]
|
||||
?: ?& ?= [%know *] a ?= [%know *] b
|
||||
?: .= know.a know.b
|
||||
?: ?&(?=([%know *] a) ?=([%know *] b))
|
||||
?: =(know.a know.b)
|
||||
a
|
||||
$(a (fray a), b (fray b))
|
||||
?: ?= [%know *] a
|
||||
?: ?=([%know *] a)
|
||||
$(a (fray a))
|
||||
?: ?= [%know *] b
|
||||
?: ?=([%know *] b)
|
||||
$(b (fray b))
|
||||
?: ?& ?= [%bets *] a ?= [%bets *] 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 ~] a) ?|(?=([%dice ~] b) ?=([%flip ~] b)))
|
||||
[%dice ~]
|
||||
?: ?& ?= [%dice ~] b ?= [%flip ~] a
|
||||
?: ?&(?=([%dice ~] b) ?=([%flip ~] a))
|
||||
[%dice ~]
|
||||
?: ?& ?= [%flip ~] a ?= [%flip ~] b
|
||||
?: ?&(?=([%flip ~] a) ?=([%flip ~] b))
|
||||
[%flip ~]
|
||||
[%gues ~]
|
||||
:: Produce the intersection of two boots
|
||||
@ -282,15 +283,17 @@
|
||||
?: ?= [%risk *] b
|
||||
[%risk (mous hope.a hope.b)]
|
||||
[%risk hope.a]
|
||||
?: ?= [%safe *] b
|
||||
?: ?= [%safe *] b
|
||||
[%risk sure.b]
|
||||
?: ?= [%risk *] 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 @]
|
||||
@ -376,7 +379,11 @@
|
||||
::
|
||||
[%2 * *]
|
||||
=/ subn $(form +<.form)
|
||||
?: ?=([%boom ~] subn)
|
||||
[%boom ~]
|
||||
=/ forn $(form +>.form)
|
||||
?: ?=([%boom ~] forn)
|
||||
[%boom ~]
|
||||
?: ?= [%safe %dice ~] forn
|
||||
[%boom ~]
|
||||
?: ?= [%safe %flip ~] forn
|
||||
@ -394,17 +401,17 @@
|
||||
$(subj sure.subn, form know.sure.forn)
|
||||
::
|
||||
[%risk *]
|
||||
(risk $(subj risk.subn, form know.sure.forn))
|
||||
(dare $(subj hope.subn, form know.sure.forn))
|
||||
==
|
||||
::
|
||||
[%risk %know *]
|
||||
?- subn
|
||||
::
|
||||
[%safe *]
|
||||
(risk $(subj sure.subn, form know.hope.forn))
|
||||
(dare $(subj sure.subn, form know.hope.forn))
|
||||
::
|
||||
[%risk *]
|
||||
(risk $(subj hope.subn, form know.hope.forn))
|
||||
(dare $(subj hope.subn, form know.hope.forn))
|
||||
==
|
||||
==
|
||||
::
|
||||
@ -424,10 +431,10 @@
|
||||
[%safe *]
|
||||
?+ sure.cond [%boom ~]
|
||||
::
|
||||
[%know 0]
|
||||
[%know %0]
|
||||
$(form +>-.form)
|
||||
::
|
||||
[%know 1]
|
||||
[%know %1]
|
||||
$(form +>+.form)
|
||||
::
|
||||
[%flip ~]
|
||||
@ -443,10 +450,10 @@
|
||||
[%risk *]
|
||||
?+ hope.cond [%boom ~]
|
||||
::
|
||||
[%know 0]
|
||||
[%know %0]
|
||||
(dare $(form +>-.form))
|
||||
::
|
||||
[%know 1]
|
||||
[%know %1]
|
||||
(dare $(form +>+.form))
|
||||
::
|
||||
[%flip ~]
|
||||
@ -476,10 +483,10 @@
|
||||
?+ news [%boom ~]
|
||||
::
|
||||
[%safe *]
|
||||
$(subj [sure.news subj], form +>.form)
|
||||
$(subj (knit sure.news subj), form +>.form)
|
||||
::
|
||||
[%risk *]
|
||||
$(dare $(subj [hope.news subj], form +>.form))
|
||||
(dare $(subj (knit hope.news subj), form +>.form))
|
||||
==
|
||||
::
|
||||
[%9 @ *]
|
||||
@ -487,13 +494,13 @@
|
||||
?+ news [%boom ~]
|
||||
::
|
||||
[%safe *]
|
||||
=/ newf (axe +<.form news)
|
||||
=/ newf (pull +<.form sure.news)
|
||||
?+ newf [%boom ~]
|
||||
::
|
||||
[%safe %know *]
|
||||
$(subj sure.news, form know.sure.newf)
|
||||
::
|
||||
[%risk %know *)
|
||||
[%risk %know *]
|
||||
(dare $(subj sure.news, form know.hope.newf))
|
||||
::
|
||||
[%safe *]
|
||||
@ -504,14 +511,14 @@
|
||||
==
|
||||
::
|
||||
[%risk *]
|
||||
=/ newf (axe +<.form news)
|
||||
=/ newf (pull +<.form hope.news)
|
||||
?+ newf [%boom ~]
|
||||
::
|
||||
[%safe %know *]
|
||||
(dare $(subj hope.news, form know.sure.newf))
|
||||
::
|
||||
[%risk %know *]
|
||||
(dare %(subj hope.news, form know.hope.newf))
|
||||
(dare $(subj hope.news, form know.hope.newf))
|
||||
::
|
||||
[%safe *]
|
||||
[%risk %gues ~]
|
||||
@ -522,7 +529,7 @@
|
||||
==
|
||||
::
|
||||
[%10 [@ *] *]
|
||||
(welt $(form +>.form) $(form ->.form))
|
||||
(welt +<-.form $(form +<+.form) $(form +>.form))
|
||||
::
|
||||
[%11 @ *]
|
||||
$(form +>.form)
|
||||
|
@ -1,12 +1,14 @@
|
||||
/- *sock
|
||||
|%
|
||||
+| %comm
|
||||
+$ labl [sub=sock for=*]
|
||||
+| %lock
|
||||
+$ mode
|
||||
$? %save :: Must not clobber subject, non-tail
|
||||
%step :: May clobber subject, non-tail
|
||||
%butt :: Tail, but do not write to table when done
|
||||
%tail :: Tail, write to table when done
|
||||
==
|
||||
+$ labl [sub=sock for=*]
|
||||
+$ gabl @
|
||||
+$ lick
|
||||
$% [%con *] :: constant
|
||||
@ -17,7 +19,7 @@
|
||||
[%eqq @] :: Test if slot is equal to result
|
||||
[%br1 gabl] :: Jump to generated label if result is 1
|
||||
[%bru gabl] :: Jump to generated label unconditionally
|
||||
[%brh gabl] :: Generated label
|
||||
[%brh gabl] :: Generated label here
|
||||
[%sub ~] :: Set subject to result
|
||||
[%ext ~] :: Cons result onto subject
|
||||
[%dxt ~] :: Set subject to tail of subject (restore after ext)
|
||||
@ -40,4 +42,40 @@
|
||||
+$ lock (list lick)
|
||||
+$ link [does=lock says=boot]
|
||||
+$ tabl (map labl link)
|
||||
+| %dege
|
||||
+$ dabl [sub=sock for=* ax=@ gen=@]
|
||||
+$ cost :: control destination (jump dest)
|
||||
$% [%dab wher=dabl] :: go here unconditionally
|
||||
[%bab troo=dabl fals=dabl] :: branch on result
|
||||
[%ret ~] :: tail position
|
||||
==
|
||||
+$ dast $~(4 @) :: data destination (value dest)
|
||||
+$ dinn
|
||||
$% [%imm * @] :: Write a noun to an axis
|
||||
[%mov @ @] :: Copy an axis to another axis (destination must not nest under source!)
|
||||
[%clq dabl dabl] :: Branch left if axis 4 is a cell, right otherwise
|
||||
[%inc @] :: Increment the atom at the axis and write it back to the axis
|
||||
[%eqq dabl dabl] :: Branch left if axes 8 and 9 are structurally equal, right otherwise
|
||||
[%brn dabl dabl] :: Branch left if axis 4 is atom 0, right if atom 1, crash otherwise
|
||||
[%hop dabl] :: Go to dabl unconditionally (local direct jump)
|
||||
[%her dabl] :: Label explicitly in code, as branch or jump target
|
||||
[%lnk ~] :: Push a frame with a return pointer, eval the code at the axis 4
|
||||
:: Places result at axis 4
|
||||
[%cal labl] :: Push a frame with a return pointer, call the code at labl
|
||||
:: Places result at axis 4
|
||||
[%lnt ~] :: Eval the code at axis 4 in tail position
|
||||
[%jmp labl] :: Jump to the code at the label in tail position
|
||||
[%spy ~] :: Scry with the ref/path pair at axis 4, write back to axis 4
|
||||
[%sft ~] :: Moral equivalent of `mov 2 5; imm 0 4;` without the anti-nesting constraint
|
||||
:: Shifts the result into scratch and sets axis 4
|
||||
:: to 0.
|
||||
[%ust ~] :: Equivalent to `mov 5 2`
|
||||
:: Undoes sft: moves head of scratch back to
|
||||
:: result and sets scratch to tail of scratch
|
||||
[%don ~] :: Finish the procedure, returning the value at axis 4
|
||||
[%bom ~] :: Crash
|
||||
==
|
||||
+$ linn (list dinn)
|
||||
+$ tine [does=linn says=boot]
|
||||
+$ tinn (map labl tine)
|
||||
--
|
||||
|
@ -6,10 +6,8 @@
|
||||
[%flip ~]
|
||||
[%gues ~]
|
||||
==
|
||||
+$ stok
|
||||
$: sock *
|
||||
+$ boot
|
||||
$? [%safe sure=sock]
|
||||
$% [%safe sure=sock]
|
||||
[%risk hope=sock]
|
||||
[%boom ~]
|
||||
==
|
||||
|
Loading…
Reference in New Issue
Block a user