mirror of
https://github.com/urbit/ares.git
synced 2024-11-22 15:08:54 +03:00
ska spec: make degen.hoon less degenerate
This commit is contained in:
Edward Amsden
parent
0b741475a9
commit
4264b7fb40
@ -6,8 +6,8 @@
|
|||||||
=| prog=tinn
|
=| prog=tinn
|
||||||
=| buff=linn
|
=| buff=linn
|
||||||
=| bust=(list linn)
|
=| bust=(list linn)
|
||||||
=* this .
|
|
||||||
|%
|
|%
|
||||||
|
++ this .
|
||||||
++ inst
|
++ inst
|
||||||
|= =dinn
|
|= =dinn
|
||||||
^- _this
|
^- _this
|
||||||
@ -28,257 +28,90 @@
|
|||||||
=| vale=dast
|
=| vale=dast
|
||||||
=<
|
=<
|
||||||
=^ moot this
|
=^ moot this
|
||||||
|^
|
|-
|
||||||
^- [boot _this]
|
^- [boot _this]
|
||||||
~| 'vale must not be 5 or a subaxis of 5'
|
~| 'vale must not be 5 or a subaxis of 5'
|
||||||
?> (hast vale)
|
?> (hast vale)
|
||||||
?+ fate bomb
|
?+ fate bomb
|
||||||
[[* *] *]
|
[[* *] *]
|
||||||
?: ?= [%bab *] heir
|
?: ?= [%bab *] heir
|
||||||
bomb
|
bomb
|
||||||
=/ tier [%dab (bear 3)]
|
=/ tier [%dab (bear 3)]
|
||||||
=^ shed this $(faxe (peg faxe 2), fate -.fate, heir tier, vale 4) :: we can't clobber subject
|
=^ shed this $(faxe (peg faxe 2), fate -.fate, heir tier, vale 4) :: we can't clobber subject
|
||||||
=. this (inst [%sft ~])
|
=. this (inst [%sft ~])
|
||||||
=^ stal this $(faxe (peg faxe 3), fate +.fate, heir [%dab here], vale (peg vale 3))
|
=^ 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 10 (peg vale 2)])
|
||||||
=. this (inst [%mov 11 5]) :: pop without overwriting 4
|
=. this (inst [%mov 11 5]) :: pop without overwriting 4
|
||||||
=. this tale
|
=. this tale
|
||||||
:_ this
|
:_ this
|
||||||
(cobb:ska shed stal)
|
(cobb:ska shed stal)
|
||||||
::
|
::
|
||||||
[%0 @]
|
[%0 @]
|
||||||
=. this (inst [%mov (peg 3 +.fate) vale])
|
=. this (inst [%mov (peg 3 +.fate) vale])
|
||||||
=. this bale
|
=. this bale
|
||||||
:_ this
|
:_ this
|
||||||
(pull:ska +.fate ject)
|
(pull:ska +.fate ject)
|
||||||
::
|
::
|
||||||
[%1 *]
|
[%1 *]
|
||||||
=. this (inst [%imm +.fate vale])
|
=. this (inst [%imm +.fate vale])
|
||||||
?: ?= [%bab *] heir
|
?: ?= [%bab *] heir
|
||||||
?: =(0 +.fate)
|
?: =(0 +.fate)
|
||||||
=. this (inst [%hop troo.heir])
|
=. this (inst [%hop troo.heir])
|
||||||
=. this tale
|
=. this tale
|
||||||
:_ this
|
:_ this
|
||||||
[%safe %know +.fate]
|
[%safe %know +.fate]
|
||||||
?: =(1 +.fate)
|
?: =(1 +.fate)
|
||||||
=. this (inst [%hop fals.heir])
|
=. this (inst [%hop fals.heir])
|
||||||
=. this tale
|
=. this tale
|
||||||
:_ this
|
:_ this
|
||||||
[%safe %know +.fate]
|
[%safe %know +.fate]
|
||||||
bomb
|
bomb
|
||||||
=. this tale
|
=. this tale
|
||||||
:_ this
|
:_ this
|
||||||
[%safe %know +.fate]
|
[%safe %know +.fate]
|
||||||
::
|
::
|
||||||
[%2 * *]
|
[%2 * *]
|
||||||
=/ shis this
|
=/ shis this
|
||||||
=/ tier [%dab (bear 7)]
|
=/ tier [%dab (bear 7)]
|
||||||
=. this hide
|
=. this hide
|
||||||
=^ norm this $(faxe (peg faxe 6), fate +<.fate, heir tier, vale 4)
|
=^ norm this $(faxe (peg faxe 6), fate +<.fate, heir tier, vale 4)
|
||||||
?: ?= [%boom ~] norm
|
?: ?= [%boom ~] norm
|
||||||
bomb
|
bomb
|
||||||
=? this ?=([%safe %know *] norm) =.(this shis hide)
|
=? this ?=([%safe %know *] norm) =.(this shis hide)
|
||||||
=^ news this $(faxe (peg faxe 7), fate +>.fate, heir [%dab here], vale 3)
|
=^ news this $(faxe (peg faxe 7), fate +>.fate, heir [%dab here], vale 3)
|
||||||
?: ?= [%boom ~] news
|
?: ?= [%boom ~] news
|
||||||
bomb
|
bomb
|
||||||
=/ sewn
|
=/ sewn
|
||||||
?- news
|
?- news
|
||||||
[%safe *] sure.news
|
[%safe *] sure.news
|
||||||
[%risk *] hope.news
|
[%risk *] hope.news
|
||||||
|
==
|
||||||
|
?: ?=([$?(%safe %risk) %know *] norm)
|
||||||
|
=/ sabl
|
||||||
|
?- norm
|
||||||
|
[%safe *] [sewn know.sure.norm]
|
||||||
|
[%risk *] [sewn know.hope.norm]
|
||||||
==
|
==
|
||||||
?: ?=([$?(%safe %risk) %know *] norm)
|
=^ toot this (gene sabl)
|
||||||
=/ sabl
|
?: ?=([%ret ~] heir)
|
||||||
?- norm
|
~| 'Value destination for tail call should always be 4'
|
||||||
[%safe *] [sewn know.sure.norm]
|
?> =(vale 4)
|
||||||
[%risk *] [sewn know.hope.norm]
|
=. this (inst [%jmp sabl])
|
||||||
==
|
|
||||||
=^ 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
|
:_ this
|
||||||
?: ?& ?=([%safe *] news) ?=([%safe *] norm) ==
|
?: ?& ?=([%safe *] news) ?=([%safe *] norm) ==
|
||||||
toot
|
toot
|
||||||
(dare:ska 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 (inst [%cal sabl])
|
||||||
=. this show
|
=. this show
|
||||||
=. this (inst [%mov 4 vale])
|
=. this (inst [%mov 4 vale])
|
||||||
=. this bran
|
=. this bran
|
||||||
:_ this
|
:_ this
|
||||||
?: ?&(?=([%safe *] bore) ?=([%safe *] norm))
|
?: ?& ?=([%safe *] news) ?=([%safe *] norm) ==
|
||||||
noot
|
toot
|
||||||
(dare:ska noot)
|
(dare:ska toot)
|
||||||
?: ?= [%ret ~] heir
|
?: ?=([%ret ~] heir)
|
||||||
|
~| 'Value destination for tail call should always be 4'
|
||||||
|
?> =(vale 4)
|
||||||
=. this (inst [%lnt ~])
|
=. this (inst [%lnt ~])
|
||||||
:_ this
|
:_ this
|
||||||
[%risk %gues ~]
|
[%risk %gues ~]
|
||||||
@ -288,100 +121,214 @@
|
|||||||
=. this bran
|
=. this bran
|
||||||
:_ this
|
:_ this
|
||||||
[%risk %gues ~]
|
[%risk %gues ~]
|
||||||
::
|
::
|
||||||
[%10 [@ *] *]
|
[%3 *]
|
||||||
=^ soot this $(faxe (peg 13 faxe), fate +<+.fate, heir [%dab (bear 7)], vale 4)
|
:: TODO: statically jump to a branch if we know atom or cell
|
||||||
=. this (inst [%sft ~])
|
=^ spec this $(faxe (peg 3 faxe), fate +.fate, heir [%dab here], vale 4)
|
||||||
=^ toot this $(faxe (peg 7 faxe), fate +>.fate, heir [%dab here]) :: write tree to destination
|
=. this (inst [%clq will wont])
|
||||||
=. this (inst [%ust ~])
|
=. this does
|
||||||
=. this (inst [%mov 4 (peg vale +<-.fate)]) :: write patch to axis under destination
|
=. this dont
|
||||||
:_ this
|
:_ this
|
||||||
(welt:ska +<-.fate soot toot)
|
(ques:ska spec)
|
||||||
::
|
::
|
||||||
[%11 @ *]
|
[%4 *]
|
||||||
$(faxe (peg 7 faxe), fate +>.fate)
|
=^ mota this $(faxe (peg 3 faxe), fate +.fate, heir [%dab here]) :: leave vale the same
|
||||||
::
|
=. this (inst [%inc vale])
|
||||||
[%11 [@ *] *]
|
=. this bale
|
||||||
=^ hoot this $(faxe (peg 13 faxe), fate +<+.fate, heir [%dab (bear 7)], vale 4)
|
:_ this
|
||||||
?: ?= [%boom ~] hoot
|
(pile:ska mota)
|
||||||
bomb
|
::
|
||||||
=^ root this $(faxe (peg 7 faxe), fate +>.fate)
|
[%5 * *]
|
||||||
:_ this
|
:: TODO: statically jump to a branch if we know equal or
|
||||||
?: ?= [%safe *] hoot
|
:: disequal
|
||||||
root
|
=/ tier (bear 7)
|
||||||
(dare:ska root)
|
=^ 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)
|
||||||
[%12 * *]
|
=. this (inst [%eqq will wont])
|
||||||
=^ root this $(faxe (peg 6 faxe), fate +<.fate, heir [%dab (bear 7)], vale 8)
|
=. this does
|
||||||
?: ?= [%boom ~] root
|
=. this dont
|
||||||
bomb
|
:_ this
|
||||||
=^ soot this $(faxe (peg 7 faxe), fate +>.fate, heir [%dab here], vale 9)
|
(bopp:ska left rite)
|
||||||
?: ?= [%boom ~] soot
|
::
|
||||||
bomb
|
[%6 * * *]
|
||||||
=. this (inst [%spy ~])
|
=/ troo (bear 14)
|
||||||
=. this (inst [%mov 4 vale])
|
=/ fals (bear 15)
|
||||||
:_ this
|
=/ shis this
|
||||||
[%risk %gues ~]
|
=^ cond this $(faxe (peg 6 faxe), fate +<.fate, heir [%bab troo fals], vale 4)
|
||||||
==
|
?: ?= [%safe %know *] cond
|
||||||
:: hide away a subject for later (clobbers 4)
|
?: =(0 know.sure.cond)
|
||||||
++ hide
|
=. this shis
|
||||||
=. this (inst [%mov 3 4])
|
$(faxe (peg 14 faxe), fate +>-.fate) :: pass on heir and vale
|
||||||
(inst [%sft ~]) :: subject is now in 10
|
?: =(1 know.sure.cond)
|
||||||
:: put back a subject that was hidden away (does not clobber 4)
|
=. this shis
|
||||||
++ show
|
$(faxe (peg 15 faxe), fate +>+.fate) :: pass on heir and vale
|
||||||
=. this (inst [%mov 10 3]) :: put back the subject
|
bomb
|
||||||
=. this (inst [%mov 4 10]) :: put the result where it will get shifted back into result space
|
?: ?= [%risk %know *] cond
|
||||||
(inst [%ust ~])
|
?: =(0 know.hope.cond)
|
||||||
++ bran
|
=. this (inst [%her troo])
|
||||||
?: ?= [%bab *] heir
|
=^ trus this $(faxe (peg 14 faxe), fate +>-.fate) :: pass on heir and vale
|
||||||
(inst [%brn troo.heir fals.heir])
|
:_ this
|
||||||
this
|
(dare:ska trus)
|
||||||
++ tale
|
?: =(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
|
?: ?= [%ret ~] heir
|
||||||
~| 'Must have data destination 4 when control destination is %ret'
|
=^ soot this $(faxe (peg 7 faxe), fate +>.fate, ject sewn)
|
||||||
?> =(4 vale)
|
:_ this
|
||||||
(inst [%don ~])
|
?: ?= [%safe *] news
|
||||||
this
|
soot
|
||||||
++ bale
|
(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 bran
|
||||||
tale
|
:_ this
|
||||||
++ does
|
?: ?= [%safe *] news
|
||||||
=. this (inst [%her will])
|
soot
|
||||||
=. this (inst [%imm 0 vale])
|
(dare:ska soot)
|
||||||
?- heir
|
::
|
||||||
[%dab *] (inst [%hop wher.heir])
|
[%8 * *]
|
||||||
[%bab *] (inst [%hop troo.heir])
|
=^ news this $(faxe (peg 6 faxe), fate +<.fate, heir [%dab (bear 7)], vale 8) :: store in head of result
|
||||||
[%ret ~] (inst [%don ~])
|
?: ?= [%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
|
||||||
==
|
==
|
||||||
++ dont
|
=/ norm (pull:ska +<.fate sore)
|
||||||
=. this (inst [%her wont])
|
?: ?= [%boom ~] norm
|
||||||
=. this (inst [%imm 1 vale])
|
bomb
|
||||||
?- heir
|
=? this ?!(?=([%safe %know *] norm)) (inst [%mov (peg 3 +<.fate) 4]) :: look up axis
|
||||||
[%dab *] (inst [%hop wher.heir])
|
?: ?=([$?(%safe %risk) %know *] norm)
|
||||||
[%bab *] (inst [%hop fals.heir])
|
=/ sabl
|
||||||
[%ret ~] (inst [%don ~])
|
?- norm
|
||||||
==
|
[%safe %know *] [sore know.sure.norm]
|
||||||
:: assert correctness of a dast: must not be 5 or a subaxis of 5
|
[%risk %know *] [sore know.hope.norm]
|
||||||
++ hast
|
==
|
||||||
|= wast=dast
|
=^ noot this (gene sabl)
|
||||||
^- ?
|
?: ?= [%ret ~] heir
|
||||||
?. (lth wast 5)
|
=. this (inst [%jmp sabl])
|
||||||
?. =(wast 5)
|
:_ this
|
||||||
$(wast (mas wast))
|
?: ?&(?=([%safe *] bore) ?=([%safe *] norm))
|
||||||
%.n
|
noot
|
||||||
%.y
|
(dare:ska noot)
|
||||||
--
|
=. this (inst [%cal sabl])
|
||||||
(done moot)
|
=. 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 ~]
|
||||||
|
==
|
||||||
|
:_ this(prog (~(put by prog) bloc [(flop buff) moot]), buff -.bust, bust +.bust)
|
||||||
|
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
|
++ bomb
|
||||||
^- [boot _this]
|
^- [boot _this]
|
||||||
=. buff ~[[%bom ~]]
|
=. this (inst [%bom ~])
|
||||||
:_ this
|
:_ this
|
||||||
[%boom ~]
|
[%boom ~]
|
||||||
++ bear
|
++ bear
|
||||||
@ -397,5 +344,52 @@
|
|||||||
++ wont
|
++ wont
|
||||||
^- dabl
|
^- dabl
|
||||||
[sub.bloc for.bloc faxe 3]
|
[sub.bloc for.bloc faxe 3]
|
||||||
|
:: 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
|
||||||
--
|
--
|
||||||
--
|
--
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user