From 35c39bf0764b228b4c41d841a2287fef11ea2dfc Mon Sep 17 00:00:00 2001 From: Ted Blackman Date: Thu, 16 Apr 2020 08:45:48 -0400 Subject: [PATCH] ford-fusion: +get-cast compiles, initial tests pass --- pkg/arvo/gen/hello.hoon | 3 +- pkg/arvo/sys/vane/clay.hoon | 72 +++++++++++++++++++++++++++++-- pkg/arvo/tests/sys/vane/clay.hoon | 52 +++++++++++++++++++++- 3 files changed, 120 insertions(+), 7 deletions(-) diff --git a/pkg/arvo/gen/hello.hoon b/pkg/arvo/gen/hello.hoon index 41a2c1cf8..49d320833 100644 --- a/pkg/arvo/gen/hello.hoon +++ b/pkg/arvo/gen/hello.hoon @@ -2,7 +2,8 @@ :: :::: /hoon/hello/gen :: -/? 310 +:: TODO: reinstate +::/? 310 :: :::: :: diff --git a/pkg/arvo/sys/vane/clay.hoon b/pkg/arvo/sys/vane/clay.hoon index 179a7f28f..fff45bcd3 100644 --- a/pkg/arvo/sys/vane/clay.hoon +++ b/pkg/arvo/sys/vane/clay.hoon @@ -2726,6 +2726,7 @@ ++ get-value |= =path ^- [(unit cage) state] + ~| %error-validating-path^path ?^ cage=(~(get by baked.nub) path) [cage nub] ?^ change=(~(get by changes) path) @@ -2744,17 +2745,18 @@ ++ get-mark |= mak=mark ^- [dais state] + ~| %error-building-mark^mak ?^ got=(~(get by marks.cache.nub) mak) =? stack.nub ?=(^ stack.nub) stack.nub(i (~(uni in i.stack.nub) dez.u.got)) [res.u.got nub] =. stack.nub [~ stack.nub] - =^ cor=vase nub (build-fit /mar/[mak]) =; res=[=dais nub=state] =. nub nub.res =^ top stack.nub pop-stack =. marks.cache.nub (~(put by marks.cache.nub) mak [dais.res top]) [dais.res nub] + =^ cor=vase nub (build-fit /mar/[mak]) =/ gad=vase (slap cor %limb %grad) ?@ q.gad =+ !<(mok=mark gad) @@ -2829,11 +2831,58 @@ ^+ sam [p:bunt noun] -- + :: +get-cast: produce a $tube mark conversion gate from .a to .b :: ++ get-cast |= [a=mark b=mark] ^- [tube state] - !! + ~| error-building-cast+[a b] + ?^ got=(~(get by casts.cache.nub) [a b]) + =? stack.nub ?=(^ stack.nub) + stack.nub(i (~(uni in i.stack.nub) dez.u.got)) + [res.u.got nub] + =. stack.nub [~ stack.nub] + =; res=[=tube nub=state] + =. nub nub.res + =^ top stack.nub pop-stack + =. casts.cache.nub (~(put by casts.cache.nub) [a b] [tube.res top]) + [tube.res nub] + :: try +grow + :: + =^ old=vase nub (build-fit /mar/[a]) + =/ row (mule |.((slap old (ream (cat 3 b ':grow'))))) + ?: ?=(%& -.row) + :_ nub + ^- tube + |= sam=vase + ^- vase + %+ slap + (with-faces old+old sam+sam ~) + (ream (cat 3 b ':~(grow old sam)')) + :: try direct +grab + :: + =^ new=vase nub (build-fit /mar/[b]) + =/ rab (mule |.((slap new (ream (cat 3 a ':grab'))))) + ?: &(?=(%& -.rab) ?=(^ q.p.rab)) + :_(nub |=(sam=vase (slam p.rab sam))) + :: try +jump + :: + =/ jum (mule |.((slap old (ream (cat 3 b ':jump'))))) + ?: ?=(%& -.jum) + (compose-casts a !<(mark p.jum) b) + :: try indirect +grab + :: + ?: ?=(%& -.rab) + (compose-casts a !<(mark p.rab) b) + ~|(no-cast-from+[a b] !!) + :: + ++ compose-casts + |= [x=mark y=mark z=mark] + ^- [tube state] + =^ uno=tube nub (get-cast x y) + =^ dos=tube nub (get-cast y z) + :_(nub |=(sam=vase (dos (uno sam)))) + :: ++ lobe-to-page |= =lobe ^- [page state] @@ -2847,10 +2896,17 @@ =^ =cage nub (run-pact parent-page diff) [[p q.q]:cage nub] == + :: ++ validate-path |= [=path =page] ^- [cage state] - !! + ?. =((head (flop path)) p.page) + !! :: TODO cast + ?: =(%hoon p.page) + :_(nub [%hoon -:!>(*@t) q.page]) + =^ =dais nub (get-mark p.page) + :_(nub [p.page (vale:dais q.page)]) + :: ++ cast-path |= [=path =mark] ^- [cage state] @@ -2861,6 +2917,7 @@ !! ++ build-file |= =path + ~| %error-building^path ^- [vase state] ?^ got=(~(get by vases.cache.nub) path) =? stack.nub ?=(^ stack.nub) @@ -2899,6 +2956,14 @@ ++ mont-rule %+ ifix [gay gay] %+ cook |=(mont +<) +::TODO: reinstate +:: ;~ pfix +:: :: parse optional /? and ignore +:: :: +:: ;~ pose +:: (cold ~ ;~(plug net wut gap dem)) +:: (easy ~) +:: == ;~ plug %+ cook |=((list (list taut)) (zing +<)) %+ more gap @@ -4587,7 +4652,6 @@ ruf=raft :: revision tree == :: |= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation -^? :: opaque core |% :: ++ call :: handle request |= $: hen=duct diff --git a/pkg/arvo/tests/sys/vane/clay.hoon b/pkg/arvo/tests/sys/vane/clay.hoon index 1ffe32653..95c7c91b4 100644 --- a/pkg/arvo/tests/sys/vane/clay.hoon +++ b/pkg/arvo/tests/sys/vane/clay.hoon @@ -1,14 +1,62 @@ -/+ *test, test-ford-external +/+ *test, test-ford-external, clay-raw=clay :: -/= clay-raw /: /===/sys/vane/clay /!noun/ +/= hello-gen /: /===/gen/hello /hoon/ +::/= clay-raw /: /===/sys/vane/clay /!noun/ :: !: =, format :: =/ test-pit=vase !>(..zuse) =/ clay-gate (clay-raw test-pit) +=/ fusion fusion:clay-gate :: |% +++ test-get-fit ^- tang + =/ =ankh:clay + :- fil=~ + %- ~(gas by *(map @tas ankh:clay)) + :~ :+ %mar fil=~ + %- ~(gas by *(map @tas ankh:clay)) + :~ :+ %foo fil=~ + %- ~(gas by *(map @tas ankh:clay)) + :~ :+ %bar fil=~ + %- ~(gas by *(map @tas ankh:clay)) + :~ :+ %hoon fil=`[*lobe:clay hoon+!>('baz')] dir=~ + == == == == + %+ expect-eq + !> `(unit path)`[~ /mar/foo/bar/hoon] + !> (~(get-fit an:fusion ankh) /mar/foo-bar) +:: +++ test-parse-pile ^- tang + %+ expect-eq + !> ^- pile:fusion + :- [~ ~ ~] + tssg+[%dbug [/sur/foo/hoon [[1 1] [1 2]]] [%cnts ~[[%.y 1]] ~]]~ + !> (parse-pile:(ford):fusion /sur/foo/hoon ".") +:: +++ test-hello-gen ^- tang + =/ =ankh:clay + :- fil=~ + %- ~(gas by *(map @tas ankh:clay)) + :~ :+ %gen fil=~ + %- ~(gas by *(map @tas ankh:clay)) + :~ :+ %hello fil=~ + %- ~(gas by *(map @tas ankh:clay)) + :~ :+ %hoon fil=`[*lobe:clay hoon+!>(hello-gen)] dir=~ + == == == + =/ ford + %: ford:fusion + ankh + deletes=~ + changes=(my [/gen/hello/hoon &+hoon+hello-gen]~) + file-store=~ + *ford-cache:fusion + == + =/ res=vase -:(build-file:ford /gen/hello/hoon) + %+ expect-eq + !> noun+'hello, bob' + (slap res (ream '(+ [*^ [%bob ~] ~])')) +:: ++ test-info ^- tang =^ results0 clay-gate %- clay-call :*