destination-driven codegen spec compiles

This commit is contained in:
Edward Amsden 2022-09-14 18:51:52 -05:00
parent 132b732544
commit 0b741475a9
No known key found for this signature in database
GPG Key ID: 548EDF608CA956F6
6 changed files with 900 additions and 61 deletions

View 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]
--
--

View File

@ -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
View 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)
--
--

View File

@ -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)

View File

@ -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)
--

View File

@ -6,10 +6,8 @@
[%flip ~]
[%gues ~]
==
+$ stok
$: sock *
+$ boot
$? [%safe sure=sock]
$% [%safe sure=sock]
[%risk hope=sock]
[%boom ~]
==