mirror of
https://github.com/urbit/shrub.git
synced 2024-11-28 22:33:06 +03:00
ford-fusion: +get-cast compiles, initial tests pass
This commit is contained in:
Ted Blackman
parent
522a7fb933
commit
35c39bf076
@ -2,7 +2,8 @@
|
||||
::
|
||||
:::: /hoon/hello/gen
|
||||
::
|
||||
/? 310
|
||||
:: TODO: reinstate
|
||||
::/? 310
|
||||
::
|
||||
::::
|
||||
::
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 :*
|
||||
|
||||
Loading…
Reference in New Issue
Block a user