mirror of
https://github.com/urbit/shrub.git
synced 2024-11-27 18:34:48 +03:00
neo: add tests for layer1/2
This commit is contained in:
parent
b4e2d9974e
commit
8b2566fdd7
@ -2,10 +2,13 @@
|
||||
/+ lib=neo-two
|
||||
/+ default-agent
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
+$ card $+(card card:agent:gall)
|
||||
+$ state-0
|
||||
$: one=loam:dirt:neo
|
||||
two=farm:neo
|
||||
$: =loam:dirt:neo
|
||||
=farm:neo
|
||||
=town:neo
|
||||
=city:neo
|
||||
=halt:neo
|
||||
dev=_|
|
||||
==
|
||||
++ mute
|
||||
@ -18,14 +21,15 @@
|
||||
=| state-0
|
||||
=* state -
|
||||
=<
|
||||
!.
|
||||
!:
|
||||
^- agent:gall
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
run ~(. +> [bowl ~])
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
++ on-init
|
||||
^- (quip card _this)
|
||||
`!>(state)
|
||||
`this
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= vax=vase
|
||||
@ -54,7 +58,7 @@
|
||||
|= [=wire syn=sign-arvo]
|
||||
^- (quip card _this)
|
||||
=^ cards state
|
||||
abet:(on-arvo:run wire sign)
|
||||
abet:(on-arvo:run wire syn)
|
||||
[cards this]
|
||||
++ on-fail on-fail:def
|
||||
++ on-peek on-peek:run
|
||||
@ -78,6 +82,19 @@
|
||||
~[n/~ %sys]
|
||||
:: |do: effect creation
|
||||
+| %do
|
||||
++ do-watch
|
||||
|= [=wire =dock =path]
|
||||
(pass wire %agent dock watch/path)
|
||||
++ do-watch-her
|
||||
|= [=wire her=ship =path]
|
||||
(do-watch wire [her dap.bowl] path)
|
||||
++ do-leave
|
||||
|= [=wire =dock]
|
||||
(pass wire %agent dock leave/~)
|
||||
++ do-leave-her
|
||||
|= [=wire her=ship]
|
||||
(do-leave wire her dap.bowl)
|
||||
::
|
||||
++ do-poke
|
||||
|= [=wire =dock =cage]
|
||||
(pass wire %agent dock poke/cage)
|
||||
@ -89,26 +106,26 @@
|
||||
(do-poke wire [her dap.bowl] cage)
|
||||
++ do-poke-self
|
||||
|= [=wire =cage]
|
||||
(do-poke-our wire [our dap]:bowl cage)
|
||||
(do-poke-our wire dap:bowl cage)
|
||||
++ do-move
|
||||
|= =move:neo
|
||||
=/ dst=name:neo (de-pith:name:neo p.q.move)
|
||||
=/ src=name:neo (de-pith:name:neo p.move)
|
||||
?> =(ship.src our.bowl)
|
||||
=/ =wire /deal/(pout p.move)
|
||||
=/ =wire deal/(pout p.move)
|
||||
?: =(our.bowl ship.dst)
|
||||
(do-poke-self wire neo-move+!>(move))
|
||||
(do-poke-her wire neo-raw-poke+!>((move:soften move)))
|
||||
(do-poke-her wire ship.dst neo-raw-poke+!>((move:soften move)))
|
||||
++ do-ack
|
||||
|= =ack:neo
|
||||
^+ (list card)
|
||||
^- (list card)
|
||||
?: =(p.p.ack sys-pith)
|
||||
%. ~
|
||||
?~ err
|
||||
%. *(list card)
|
||||
?~ q.ack
|
||||
same
|
||||
(slog leaf/"nack on sys" err)
|
||||
(slog leaf/"nack on sys" u.q.ack)
|
||||
=/ src=name:neo (de-pith:name:neo p.p.ack)
|
||||
=/ =wire /nack/(pout p.p.ack)
|
||||
=/ =wire nack/(pout p.p.ack)
|
||||
(do-poke-her wire ship.src neo-ack+!>(ack))^~
|
||||
:: ?: =(p.flow
|
||||
:: |on: event handlers
|
||||
@ -118,7 +135,8 @@
|
||||
^+ run
|
||||
?+ mark ~|(bad-poke-mark/mark !!)
|
||||
%neo-move =;(f (f !<(_+<.f vase)) on-move)
|
||||
%neo-raw-move (on-move (hard
|
||||
%neo-raw-poke (on-move (poke:harden !<(raw-poke:neo vase)))
|
||||
%neo-dirt-card (on-dirt-card !<(=card:dirt:neo vase))
|
||||
==
|
||||
++ on-move
|
||||
|= =move:neo
|
||||
@ -126,13 +144,21 @@
|
||||
=/ src=name:neo (de-pith:name:neo p.move)
|
||||
?> =(src.bowl ship.src)
|
||||
abet:(arvo move)
|
||||
::
|
||||
++ on-dirt-card
|
||||
|= =card:dirt:neo
|
||||
^+ run
|
||||
=^ gifts=(list gift:dirt:neo) loam
|
||||
(~(call plow:lib loam) card)
|
||||
=. farm (~(take till:lib farm) gifts)
|
||||
run
|
||||
++ on-watch
|
||||
|= =(pole knot)
|
||||
^+ run
|
||||
~| bad-watch-path/pole
|
||||
?> ?=([%sync rest=*] pole)
|
||||
=/ =pith:neo (pave:neo rest.pole)
|
||||
=/ paxs=(list poth:neo) (de:drive:neo pith)
|
||||
=/ paxs=(list road:neo) (de:drive:neo pith)
|
||||
?> ?=([^ ^ ~] paxs)
|
||||
?+ i.paxs !!
|
||||
[car=@ [%ud since=@] ~] !! :: XX: TODO:
|
||||
@ -140,29 +166,130 @@
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^+ run
|
||||
=/ =puth:neo (pave:neo wire)
|
||||
?+ puth +:(on-agent:def wire sign)
|
||||
[%deal rest=*] (on-deal-sign rest.puth sign)
|
||||
=/ =road:neo (pave:neo wire)
|
||||
?+ road +:(on-agent:def wire sign)
|
||||
[%deal rest=*] (on-deal-sign rest.road sign)
|
||||
[%sync rest=*] (on-sync-sign rest.road sign)
|
||||
==
|
||||
++ on-deal-sign
|
||||
|= [=puth:neo =sign:agent:gall]
|
||||
|= [=road:neo =sign:agent:gall]
|
||||
^+ run
|
||||
?> ?=(%poke-ack -.sign)
|
||||
run
|
||||
:: run
|
||||
!! :: XX: deliver nack
|
||||
::
|
||||
++ on-sync-sign
|
||||
|= [=road:neo =sign:agent:gall]
|
||||
^+ run
|
||||
!!
|
||||
|
||||
++ on-arvo
|
||||
|= [=wire syn=sign-arvo]
|
||||
^+ run
|
||||
=. run +:(on-agent:def wire sign)
|
||||
=. run +:(on-arvo:def wire syn)
|
||||
run
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
=/ =pith:neo (pave:neo path)
|
||||
[~ ~]
|
||||
?> ?=(^ path)
|
||||
=/ car i.path
|
||||
|^
|
||||
=/ =road:neo (pave:neo t.path)
|
||||
?+ road [~ ~]
|
||||
[%loam [%ud cas=@] rest=*] (sing (~(scry plow:lib loam) [cas rest]:road))
|
||||
==
|
||||
::
|
||||
++ raise
|
||||
|* a=mold
|
||||
(lift (lift a))
|
||||
::
|
||||
++ sing
|
||||
%- raise
|
||||
|= =poem:neo
|
||||
neo-poem+!>(poem)
|
||||
::
|
||||
++ tell
|
||||
%- raise
|
||||
|= =myth:neo
|
||||
neo-myth+!>(myth)
|
||||
--
|
||||
:: |jungle: shurb manipulations
|
||||
+| %jungle
|
||||
++ rare
|
||||
=/ =town:neo town
|
||||
|%
|
||||
++ abet run(town town)
|
||||
++ rare .
|
||||
++ scry ~
|
||||
++ wire
|
||||
|= =pith:neo `^wire`rare/(pout pith)
|
||||
++ care
|
||||
|= mart=(set hunt:neo)
|
||||
%+ roll ~(tap in mart)
|
||||
|= [=hunt:neo =care:neo]
|
||||
?: ?=(?(%z %c) care.hunt) %z
|
||||
?. =(?(%y %b) care.hunt) %y
|
||||
care.hunt
|
||||
++ peer-path
|
||||
|= [=pith:neo =mall:neo]
|
||||
%- pout
|
||||
(welp #/sync (en:drive:neo #/[(care mart.mall)]/[ud/0] pith ~))
|
||||
++ peer
|
||||
|= [=pith:neo =mall:neo]
|
||||
=/ =name:neo (de-pith:name:neo pith)
|
||||
=/ =wire sync/(pout pith)
|
||||
(do-watch-her wire ship.name (peer-path pith mall))
|
||||
++ resign
|
||||
|= =pith:neo
|
||||
^- (unit pith:neo)
|
||||
=/ ton (~(dip of:neo town) pith)
|
||||
=| yoof=(list [pith:neo town:neo])
|
||||
=| here=pith:neo
|
||||
=/ kids=(list [pith:neo town:neo])
|
||||
(turn ~(tap by kid.ton) |=([=iota =town:neo] [~[iota] town]))
|
||||
|-
|
||||
?~ kids
|
||||
?: =(~ yoof)
|
||||
~
|
||||
$(kids yoof, yoof ~)
|
||||
=/ [pit=pith:neo tin=town:neo] i.kids
|
||||
=. yoof
|
||||
%+ welp yoof
|
||||
%+ turn ~(tap by kid.tin)
|
||||
|= [iot=iota =town:neo]
|
||||
^- [pith:neo town:neo]
|
||||
[(welp pit ~[iot]) town]
|
||||
?~ fil.tin
|
||||
$(kids t.kids)
|
||||
`(welp pith pit)
|
||||
++ leave
|
||||
|= =pith:neo
|
||||
=/ =wire sync/(pout pith)
|
||||
=/ =name:neo (de-pith:name:neo pith)
|
||||
=. run (emit (do-leave-her wire ship.name))
|
||||
rare
|
||||
::
|
||||
++ gone
|
||||
|= [=pith:neo sub=hunt:neo]
|
||||
^+ rare
|
||||
=/ ton (~(dip of:neo town) pith)
|
||||
?~ fil.ton
|
||||
~& %gone-no-sub
|
||||
rare
|
||||
=. mart.u.fil.ton (~(del in mart.u.fil.ton) sub)
|
||||
?~ del.u.fil.ton
|
||||
rare
|
||||
=/ =deli:neo u.del.u.fil.ton
|
||||
?~ sig=(resign pith)
|
||||
~& last-standing-ending-sub/pith
|
||||
(leave pith)
|
||||
!!
|
||||
--
|
||||
++ rent
|
||||
|_ =city:neo
|
||||
++ scry ~
|
||||
--
|
||||
|
||||
:: +stop: helper for blocking semantics
|
||||
++ stop
|
||||
|%
|
||||
@ -178,13 +305,13 @@
|
||||
=. clog.halt (~(put by clog.halt) flow q)
|
||||
=/ prey=(list hunt:neo) ~(tap in prey)
|
||||
|- ^+ run
|
||||
?~ block
|
||||
?~ prey
|
||||
run
|
||||
=/ =hunt:neo i.block
|
||||
=/ =hunt:neo i.prey
|
||||
=. by-tour.halt (~(put by by-tour.halt) hunt flow)
|
||||
=. by-flow.halt (~(put ju by-flow.halt) flow hunt)
|
||||
=. run (grab-tour tour)
|
||||
$(block t.block)
|
||||
=. run run :: (grab-tour tour)
|
||||
$(prey t.prey)
|
||||
++ is-congested
|
||||
|= =move:neo
|
||||
=/ =flow:neo [p p.q]:move
|
||||
@ -208,7 +335,7 @@
|
||||
=. by-flow.halt (~(del ju by-flow.halt) u.fow tour)
|
||||
=/ prey=(set hunt:neo)
|
||||
(~(get ju by-flow.halt) u.fow)
|
||||
?. =(~ tours)
|
||||
?. =(~ prey)
|
||||
run
|
||||
=/ q (~(got by clog.halt) u.fow)
|
||||
|-
|
||||
@ -216,7 +343,7 @@
|
||||
=. clog.halt (~(del by clog.halt) u.fow)
|
||||
run
|
||||
=^ nex=move:neo q ~(get to q)
|
||||
=. run (poke-move nex)
|
||||
=. run (emit (do-move nex))
|
||||
$
|
||||
--
|
||||
::
|
||||
@ -236,270 +363,273 @@
|
||||
gifts=(list [pith:neo gift:neo]) :: return values
|
||||
==
|
||||
|= =move:neo
|
||||
=/ src=name:neo (de-pith:name:neo p.move)
|
||||
=/ init=[src=name:neo dst=name:neo]
|
||||
[src (de-pith:name:neo p.q.move)]
|
||||
=/ init-move move
|
||||
=/ src=name:neo src.init
|
||||
=/ here pith.dst.init
|
||||
?> =(our.bowl ship.dst.init)
|
||||
=<
|
||||
?. (is-congested:stop move)
|
||||
(apply move)
|
||||
=. run (add:stop move)
|
||||
arvo
|
||||
|%
|
||||
++ abet
|
||||
^+ run
|
||||
?: =([~ ~] block)
|
||||
=. run (emit (do-ack [p q]:init-move err.block))
|
||||
=. cards (welp cards (turn up do-move))
|
||||
(dial changes)
|
||||
:: %+ turn ~(tap by change)
|
||||
:: |=([=pith:neo =mode:neo] ^+(+< [[p/our.bowl pith] mode]))
|
||||
:: run
|
||||
~& >>> %reverting
|
||||
~& >>> init
|
||||
=. state old :: XX: is apex only state that is touched?
|
||||
?. =(~ get.block)
|
||||
(fresh:stop get.block init-move)
|
||||
?> ?=(^ err.block)
|
||||
:: %- (slog u.err.block)
|
||||
?: ?=([%poke %rely *] q.q.move)
|
||||
~& >>> rely-nack/[src dst]:init
|
||||
run
|
||||
(emit (do-nack [p q]:init-move err.block))
|
||||
::
|
||||
++ arvo .
|
||||
++ emit |=(=move:neo arvo(down [move down]))
|
||||
++ give
|
||||
^+ arvo
|
||||
?~ gifts
|
||||
arvo
|
||||
=/ [=pith:neo =gift:neo] i.gifts
|
||||
=> .(gifts `(list [pith:neo gift:neo])`gifts)
|
||||
=. gifts
|
||||
?> ?=(^ gifts)
|
||||
t.gifts
|
||||
=. here pith
|
||||
=/ =pail:neo
|
||||
gift/!>(gift)
|
||||
=^ cards=(list card:neo) arvo
|
||||
`arvo :: (soft-site |.(si-abet:(si-poke:site pail)))
|
||||
(ingest cards)
|
||||
++ trace-card
|
||||
|= =move:neo
|
||||
^- tank
|
||||
:- %leaf
|
||||
"{(en-tape:pith:neo p.move)} -> {(en-tape:pith:neo p.q.move)}: {<-.q.q.move>}"
|
||||
++ trace
|
||||
|= =tang
|
||||
?. verb same
|
||||
%. tang
|
||||
%* . slog
|
||||
pri 2
|
||||
==
|
||||
++ inside (cury is-parent init)
|
||||
++ echo arvo :: TODO walk done
|
||||
++ finalize
|
||||
^+ arvo
|
||||
=. gifts
|
||||
=- ~(tap by -)
|
||||
^- (map pith:neo gift:neo)
|
||||
%+ roll ~(tap by change)
|
||||
|= [[=pith:neo =mode:neo] out=(map pith:neo gift:neo)]
|
||||
?~ par=(parent:of-top pith)
|
||||
out
|
||||
=/ parent (~(gut by out) u.par *gift:neo)
|
||||
=. parent (~(put by parent) (sub:pith:neo pith u.par) mode)
|
||||
(~(put by out) u.par parent)
|
||||
=. changes (~(uni by changes) change)
|
||||
=. change *(map pith:neo mode:neo)
|
||||
?~ gifts
|
||||
arvo
|
||||
give
|
||||
:: $(gifts t.gifts)
|
||||
|
||||
++ work
|
||||
^+ arvo
|
||||
|- ^+ arvo
|
||||
?^ err.block
|
||||
arvo
|
||||
?~ down
|
||||
finalize
|
||||
=/ nex=move:neo i.down
|
||||
=/ new-arvo (apply:arvo(down t.down) nex) :: XX: weird compiler?
|
||||
$(arvo new-arvo, done (snoc done nex))
|
||||
++ poke
|
||||
|= =pail:neo
|
||||
^+ arvo
|
||||
=/ =room:neo (got:of-top here)
|
||||
?: &(=(%rely p.pail) ~(is-plot husk code.room))
|
||||
=. change (~(put by change) here %dif)
|
||||
work
|
||||
|
||||
=^ cards=(list card:neo) arvo
|
||||
`arvo :: (soft-site |.(si-abet:(si-poke:site pail)))
|
||||
(ingest cards)
|
||||
:: XX: a hack
|
||||
::
|
||||
:: this is implicity recursive, and all external dependencies of
|
||||
:: the children need to be woken up. this also breaks referential
|
||||
:: transparency
|
||||
++ tomb
|
||||
|= *
|
||||
=. apex (del:of-top here)
|
||||
=. change (~(put by change) here %del)
|
||||
work
|
||||
::
|
||||
++ apply
|
||||
|= =move:neo
|
||||
^+ arvo
|
||||
?. =(~ err.block)
|
||||
:: skip if we have errored
|
||||
arvo
|
||||
~| apply/[p.move p.q.move]
|
||||
=. src (de-pith:name:neo p.move)
|
||||
=/ =name:neo (de-pith:name:neo p.q.move)
|
||||
=. here +:p.q.move
|
||||
%- (trace leaf/"{<-.q.q.move>} {(spud (pout here))}" ~)
|
||||
?- -.q.q.move
|
||||
%make (make +.q.q:move)
|
||||
%poke (poke +.q.q:move)
|
||||
%tomb (tomb +.q.q:move)
|
||||
%link !!
|
||||
==
|
||||
::
|
||||
++ ingest
|
||||
|= caz=(list card:neo)
|
||||
^+ arvo
|
||||
=/ =pith [p/our.bowl here]
|
||||
=. up
|
||||
%+ welp up
|
||||
%+ murn caz
|
||||
|= =card:neo
|
||||
^- (unit move:neo)
|
||||
?: (is-parent pith p.card)
|
||||
~
|
||||
`[pith card]
|
||||
|
||||
=. down
|
||||
%- welp
|
||||
:_ down
|
||||
%+ murn caz
|
||||
|= =card:neo
|
||||
^- (unit move:neo)
|
||||
?. (is-parent pith p.card)
|
||||
~
|
||||
`[pith card]
|
||||
work
|
||||
::
|
||||
++ listen-conf
|
||||
|= [=conf:neo =deps:neo]
|
||||
^+ arvo
|
||||
=/ conf ~(tap by conf)
|
||||
|-
|
||||
?~ conf
|
||||
arvo
|
||||
=/ [=term dep=pith:neo] i.conf
|
||||
?> ?=([[%p @] *] dep)
|
||||
=/ d=(unit [req=? =quay:neo]) (~(get by deps) term)
|
||||
?~ d
|
||||
$(conf t.conf)
|
||||
=/ [req=? =quay:neo] u.d
|
||||
=/ =tour:neo [(get-care:quay:neo quay) dep]
|
||||
=/ =pith:neo [p/our.bowl here]
|
||||
?: =(our.bowl +.i.dep)
|
||||
=/ =tone:neo [%rely term pith]
|
||||
=. sound (~(put ju sound) [care.tour t.dep] tone)
|
||||
$(conf t.conf)
|
||||
::
|
||||
=/ =riot:neo (~(got by foreign) tour)
|
||||
=/ =rave:neo [term pith]
|
||||
=. deps.riot (~(put in deps.riot) rave)
|
||||
=. foreign (~(put by foreign) tour riot)
|
||||
$(conf t.conf)
|
||||
::
|
||||
++ validate-kids
|
||||
^- ?
|
||||
?: =(1 1)
|
||||
&
|
||||
?~ par-pith=(parent:of-top here)
|
||||
& :: XX: review
|
||||
=/ parent=room:neo (got:of-top u.par-pith)
|
||||
=/ parent-firm=firm:neo ~(firm husk code.parent)
|
||||
=/ sfix (sub:pith:neo here u.par-pith)
|
||||
?~ mat=(find:peon:neo sfix ~(key by kids:parent-firm))
|
||||
~& >>> %kids-no-match
|
||||
&
|
||||
& :: XX: enforce conformance
|
||||
++ make-plot
|
||||
|= [src=stud:neo =conf:neo]
|
||||
=/ =plot:neo (need ~(plot husk src))
|
||||
=/ =deps:neo deps:plot
|
||||
=^ bad=(set term) get.block
|
||||
(check-conf conf deps:plot)
|
||||
?. =(~ get.block)
|
||||
arvo
|
||||
=. arvo (listen-conf conf deps:plot)
|
||||
=/ =soil:neo
|
||||
[[[1 1] ~] ~]
|
||||
=/ =room:neo
|
||||
[src state:plot conf soil/soil]
|
||||
=. apex (put:of-top here room)
|
||||
work
|
||||
::
|
||||
++ make
|
||||
|= [src=stud:neo init=(unit vase) =conf:neo]
|
||||
?: ~(is-plot husk src)
|
||||
~| %cant-make-plot-w-init
|
||||
?> ?=(~ init)
|
||||
(make-plot src conf)
|
||||
=/ =firm:neo ~(firm husk src)
|
||||
:: =. run (~(start husk src) our.bowl pith)
|
||||
=/ old (get:of-top here)
|
||||
=/ =form:neo form:firm
|
||||
=/ =icon:neo
|
||||
?~ old
|
||||
[[1 1] *vase ~ ~]
|
||||
?> ?=(%icon -.seat.u.old)
|
||||
[ever.icon.seat.u.old *vase ~ ~]
|
||||
=? init ?=(^ old)
|
||||
~| bad-install-over/here
|
||||
?> =(state:firm state.u.old)
|
||||
?: =(~ init)
|
||||
?. ?=(%icon -.seat.u.old)
|
||||
init
|
||||
`state.icon.seat.u.old
|
||||
init
|
||||
=/ =deps:neo deps:firm
|
||||
=^ bad=(set term) get.block
|
||||
(check-conf conf deps:firm)
|
||||
?. validate-kids
|
||||
!!
|
||||
?. =(~ bad)
|
||||
~| missing-dependecies/~(tap in bad)
|
||||
!!
|
||||
?. =(~ get.block)
|
||||
~& get/get.block
|
||||
arvo
|
||||
=. arvo (listen-conf conf deps:firm)
|
||||
=/ =room:neo [src state:firm conf icon/icon]
|
||||
=. apex (put:of-top here room)
|
||||
=^ cards=(list card:neo) arvo
|
||||
`arvo :: (soft-site |.(si-abet:(si-init:site init)))
|
||||
(ingest cards)
|
||||
|
||||
++ soft-site
|
||||
|= tap=(trap (quip card:neo _arvo))
|
||||
^- (quip card:neo _arvo)
|
||||
=/ res=(each (quip card:neo _arvo) tang)
|
||||
(mule tap)
|
||||
?: ?=(%& -.res)
|
||||
p.res
|
||||
=. err.block `p.res
|
||||
`arvo
|
||||
++ abet run
|
||||
--
|
||||
::=/ src=name:neo (de-pith:name:neo p.move)
|
||||
::=/ init=[src=name:neo dst=name:neo]
|
||||
:: [src (de-pith:name:neo p.q.move)]
|
||||
::=/ init-move move
|
||||
::=/ src=name:neo src.init
|
||||
::=/ here pith.dst.init
|
||||
::?> =(our.bowl ship.dst.init)
|
||||
::=<
|
||||
::?. (is-congested:stop move)
|
||||
:: (apply move)
|
||||
::=. run (add:stop move)
|
||||
::arvo
|
||||
::|%
|
||||
::++ abet
|
||||
:: ^+ run
|
||||
:: ?: =([~ ~] block)
|
||||
:: =. run (emit (do-ack [p q]:init-move err.block))
|
||||
:: =. cards (welp cards (turn up do-move))
|
||||
:: (dial changes)
|
||||
:: :: %+ turn ~(tap by change)
|
||||
:: :: |=([=pith:neo =mode:neo] ^+(+< [[p/our.bowl pith] mode]))
|
||||
:: :: run
|
||||
:: ~& >>> %reverting
|
||||
:: ~& >>> init
|
||||
:: =. state old :: XX: is apex only state that is touched?
|
||||
:: ?. =(~ get.block)
|
||||
:: (fresh:stop get.block init-move)
|
||||
:: ?> ?=(^ err.block)
|
||||
:: :: %- (slog u.err.block)
|
||||
:: ?: ?=([%poke %rely *] q.q.move)
|
||||
:: ~& >>> rely-nack/[src dst]:init
|
||||
:: run
|
||||
:: (emit (do-nack [p q]:init-move err.block))
|
||||
::::
|
||||
::++ arvo .
|
||||
::++ emit |=(=move:neo arvo(down [move down]))
|
||||
::++ give
|
||||
:: ^+ arvo
|
||||
:: ?~ gifts
|
||||
:: arvo
|
||||
:: =/ [=pith:neo =gift:neo] i.gifts
|
||||
:: => .(gifts `(list [pith:neo gift:neo])`gifts)
|
||||
:: =. gifts
|
||||
:: ?> ?=(^ gifts)
|
||||
:: t.gifts
|
||||
:: =. here pith
|
||||
:: =/ =pail:neo
|
||||
:: gift/!>(gift)
|
||||
:: =^ cards=(list card:neo) arvo
|
||||
:: `arvo :: (soft-site |.(si-abet:(si-poke:site pail)))
|
||||
:: (ingest cards)
|
||||
::++ trace-card
|
||||
:: |= =move:neo
|
||||
:: ^- tank
|
||||
:: :- %leaf
|
||||
:: "{(en-tape:pith:neo p.move)} -> {(en-tape:pith:neo p.q.move)}: {<-.q.q.move>}"
|
||||
::++ trace
|
||||
:: |= =tang
|
||||
:: ?. verb same
|
||||
:: %. tang
|
||||
:: %* . slog
|
||||
:: pri 2
|
||||
:: ==
|
||||
::++ inside (cury is-parent init)
|
||||
::++ echo arvo :: TODO walk done
|
||||
::++ finalize
|
||||
:: ^+ arvo
|
||||
:: =. gifts
|
||||
:: =- ~(tap by -)
|
||||
:: ^- (map pith:neo gift:neo)
|
||||
:: %+ roll ~(tap by change)
|
||||
:: |= [[=pith:neo =mode:neo] out=(map pith:neo gift:neo)]
|
||||
:: ?~ par=(parent:of-top pith)
|
||||
:: out
|
||||
:: =/ parent (~(gut by out) u.par *gift:neo)
|
||||
:: =. parent (~(put by parent) (sub:pith:neo pith u.par) mode)
|
||||
:: (~(put by out) u.par parent)
|
||||
:: =. changes (~(uni by changes) change)
|
||||
:: =. change *(map pith:neo mode:neo)
|
||||
:: ?~ gifts
|
||||
:: arvo
|
||||
:: give
|
||||
:: :: $(gifts t.gifts)
|
||||
::
|
||||
::++ work
|
||||
:: ^+ arvo
|
||||
:: |- ^+ arvo
|
||||
:: ?^ err.block
|
||||
:: arvo
|
||||
:: ?~ down
|
||||
:: finalize
|
||||
:: =/ nex=move:neo i.down
|
||||
:: =/ new-arvo (apply:arvo(down t.down) nex) :: XX: weird compiler?
|
||||
:: $(arvo new-arvo, done (snoc done nex))
|
||||
::++ poke
|
||||
:: |= =pail:neo
|
||||
:: ^+ arvo
|
||||
:: =/ =room:neo (got:of-top here)
|
||||
:: ?: &(=(%rely p.pail) ~(is-plot husk code.room))
|
||||
:: =. change (~(put by change) here %dif)
|
||||
:: work
|
||||
::
|
||||
:: =^ cards=(list card:neo) arvo
|
||||
:: `arvo :: (soft-site |.(si-abet:(si-poke:site pail)))
|
||||
:: (ingest cards)
|
||||
:::: XX: a hack
|
||||
::::
|
||||
:::: this is implicity recursive, and all external dependencies of
|
||||
:::: the children need to be woken up. this also breaks referential
|
||||
:::: transparency
|
||||
::++ tomb
|
||||
:: |= *
|
||||
:: =. apex (del:of-top here)
|
||||
:: =. change (~(put by change) here %del)
|
||||
:: work
|
||||
::::
|
||||
::++ apply
|
||||
:: |= =move:neo
|
||||
:: ^+ arvo
|
||||
:: ?. =(~ err.block)
|
||||
:: :: skip if we have errored
|
||||
:: arvo
|
||||
:: ~| apply/[p.move p.q.move]
|
||||
:: =. src (de-pith:name:neo p.move)
|
||||
:: =/ =name:neo (de-pith:name:neo p.q.move)
|
||||
:: =. here +:p.q.move
|
||||
:: %- (trace leaf/"{<-.q.q.move>} {(spud (pout here))}" ~)
|
||||
:: ?- -.q.q.move
|
||||
:: %make (make +.q.q:move)
|
||||
:: %poke (poke +.q.q:move)
|
||||
:: %tomb (tomb +.q.q:move)
|
||||
:: %link !!
|
||||
:: ==
|
||||
::::
|
||||
::++ ingest
|
||||
:: |= caz=(list card:neo)
|
||||
:: ^+ arvo
|
||||
:: =/ =pith [p/our.bowl here]
|
||||
:: =. up
|
||||
:: %+ welp up
|
||||
:: %+ murn caz
|
||||
:: |= =card:neo
|
||||
:: ^- (unit move:neo)
|
||||
:: ?: (is-parent pith p.card)
|
||||
:: ~
|
||||
:: `[pith card]
|
||||
|
||||
:: =. down
|
||||
:: %- welp
|
||||
:: :_ down
|
||||
:: %+ murn caz
|
||||
:: |= =card:neo
|
||||
:: ^- (unit move:neo)
|
||||
:: ?. (is-parent pith p.card)
|
||||
:: ~
|
||||
:: `[pith card]
|
||||
:: work
|
||||
::::
|
||||
::++ listen-conf
|
||||
:: |= [=conf:neo =deps:neo]
|
||||
:: ^+ arvo
|
||||
:: =/ conf ~(tap by conf)
|
||||
:: |-
|
||||
:: ?~ conf
|
||||
:: arvo
|
||||
:: =/ [=term dep=pith:neo] i.conf
|
||||
:: ?> ?=([[%p @] *] dep)
|
||||
:: =/ d=(unit [req=? =quay:neo]) (~(get by deps) term)
|
||||
:: ?~ d
|
||||
:: $(conf t.conf)
|
||||
:: =/ [req=? =quay:neo] u.d
|
||||
:: =/ =tour:neo [(get-care:quay:neo quay) dep]
|
||||
:: =/ =pith:neo [p/our.bowl here]
|
||||
:: ?: =(our.bowl +.i.dep)
|
||||
:: =/ =tone:neo [%rely term pith]
|
||||
:: =. sound (~(put ju sound) [care.tour t.dep] tone)
|
||||
:: $(conf t.conf)
|
||||
:: ::
|
||||
:: =/ =riot:neo (~(got by foreign) tour)
|
||||
:: =/ =rave:neo [term pith]
|
||||
:: =. deps.riot (~(put in deps.riot) rave)
|
||||
:: =. foreign (~(put by foreign) tour riot)
|
||||
:: $(conf t.conf)
|
||||
::::
|
||||
::++ validate-kids
|
||||
:: ^- ?
|
||||
:: ?: =(1 1)
|
||||
:: &
|
||||
:: ?~ par-pith=(parent:of-top here)
|
||||
:: & :: XX: review
|
||||
:: =/ parent=room:neo (got:of-top u.par-pith)
|
||||
:: =/ parent-firm=firm:neo ~(firm husk code.parent)
|
||||
:: =/ sfix (sub:pith:neo here u.par-pith)
|
||||
:: ?~ mat=(find:peon:neo sfix ~(key by kids:parent-firm))
|
||||
:: ~& >>> %kids-no-match
|
||||
:: &
|
||||
:: & :: XX: enforce conformance
|
||||
::++ make-plot
|
||||
:: |= [src=stud:neo =conf:neo]
|
||||
:: =/ =plot:neo (need ~(plot husk src))
|
||||
:: =/ =deps:neo deps:plot
|
||||
:: =^ bad=(set term) get.block
|
||||
:: (check-conf conf deps:plot)
|
||||
:: ?. =(~ get.block)
|
||||
:: arvo
|
||||
:: =. arvo (listen-conf conf deps:plot)
|
||||
:: =/ =soil:neo
|
||||
:: [[[1 1] ~] ~]
|
||||
:: =/ =room:neo
|
||||
:: [src state:plot conf soil/soil]
|
||||
:: =. apex (put:of-top here room)
|
||||
:: work
|
||||
::::
|
||||
::++ make
|
||||
:: |= [src=stud:neo init=(unit vase) =conf:neo]
|
||||
:: ?: ~(is-plot husk src)
|
||||
:: ~| %cant-make-plot-w-init
|
||||
:: ?> ?=(~ init)
|
||||
:: (make-plot src conf)
|
||||
:: =/ =firm:neo ~(firm husk src)
|
||||
:: :: =. run (~(start husk src) our.bowl pith)
|
||||
:: =/ old (get:of-top here)
|
||||
:: =/ =form:neo form:firm
|
||||
:: =/ =icon:neo
|
||||
:: ?~ old
|
||||
:: [[1 1] *vase ~ ~]
|
||||
:: ?> ?=(%icon -.seat.u.old)
|
||||
:: [ever.icon.seat.u.old *vase ~ ~]
|
||||
:: =? init ?=(^ old)
|
||||
:: ~| bad-install-over/here
|
||||
:: ?> =(state:firm state.u.old)
|
||||
:: ?: =(~ init)
|
||||
:: ?. ?=(%icon -.seat.u.old)
|
||||
:: init
|
||||
:: `state.icon.seat.u.old
|
||||
:: init
|
||||
:: =/ =deps:neo deps:firm
|
||||
:: =^ bad=(set term) get.block
|
||||
:: (check-conf conf deps:firm)
|
||||
:: ?. validate-kids
|
||||
:: !!
|
||||
:: ?. =(~ bad)
|
||||
:: ~| missing-dependecies/~(tap in bad)
|
||||
:: !!
|
||||
:: ?. =(~ get.block)
|
||||
:: ~& get/get.block
|
||||
:: arvo
|
||||
:: =. arvo (listen-conf conf deps:firm)
|
||||
:: =/ =room:neo [src state:firm conf icon/icon]
|
||||
:: =. apex (put:of-top here room)
|
||||
:: =^ cards=(list card:neo) arvo
|
||||
:: `arvo :: (soft-site |.(si-abet:(si-init:site init)))
|
||||
:: (ingest cards)
|
||||
|
||||
::++ soft-site
|
||||
:: |= tap=(trap (quip card:neo _arvo))
|
||||
:: ^- (quip card:neo _arvo)
|
||||
:: =/ res=(each (quip card:neo _arvo) tang)
|
||||
:: (mule tap)
|
||||
:: ?: ?=(%& -.res)
|
||||
:: p.res
|
||||
:: =. err.block `p.res
|
||||
:: `arvo
|
||||
::--
|
||||
:: |util: utilties
|
||||
+| %util
|
||||
++ soften
|
||||
|
@ -82,7 +82,9 @@
|
||||
++ grow
|
||||
|= [=pail:neo =oath:neo]
|
||||
^- (quip case:neo loam:dirt:neo)
|
||||
~& a/loam
|
||||
=. loam +:cull
|
||||
~& b/loam
|
||||
=. fil.loam
|
||||
=/ =tale:neo [+(case) oath]
|
||||
^- (unit soil:dirt:neo)
|
||||
@ -91,6 +93,7 @@
|
||||
?~ fil.loam
|
||||
*past:neo
|
||||
bone.u.fil.loam
|
||||
~& c/loam
|
||||
[~[+(case)] loam]
|
||||
++ cull
|
||||
^- (quip case:neo loam:dirt:neo)
|
||||
@ -190,9 +193,12 @@
|
||||
farm(kid (~(put by kid.farm) i.pith $(farm kid, pith t.pith)))
|
||||
::
|
||||
++ take
|
||||
|= =gift:dirt:neo
|
||||
|= gis=(list gift:dirt:neo)
|
||||
^- farm:neo
|
||||
(eternal [p q]:gift)
|
||||
?~ gis
|
||||
farm
|
||||
$(farm (eternal [p q]:i.gis), gis t.gis)
|
||||
::
|
||||
++ look
|
||||
|= [from=pith:neo =once:neo grab=pith:neo]
|
||||
^- (unit (unit ever:neo))
|
||||
|
@ -20,6 +20,7 @@
|
||||
:: $care: Perspective on a path
|
||||
::
|
||||
+$ care
|
||||
$~ %x
|
||||
$? %x :: single node
|
||||
%y :: single node and immediate children
|
||||
%z :: single node and all descendants
|
||||
@ -1125,9 +1126,6 @@
|
||||
++ req request:http
|
||||
+$ res client-response:^iris
|
||||
--
|
||||
::
|
||||
:: $road: fully qualified path
|
||||
+$ road [=name =once grab=pith]
|
||||
:: * A `$bolt` is a `[=stud =once]`
|
||||
::
|
||||
:: $peer: Subscription
|
||||
@ -1167,6 +1165,23 @@
|
||||
$% [%sync p=hunt]
|
||||
[%stop p=hunt]
|
||||
==
|
||||
:: $town: foreign
|
||||
+$ town (axal mall)
|
||||
+$ deli
|
||||
$: last=ever
|
||||
~
|
||||
==
|
||||
+$ mall
|
||||
$: mart=(set hunt) :: subscriberes
|
||||
del=(unit deli) :: if responsible, subscription info
|
||||
~
|
||||
==
|
||||
:: $city: local
|
||||
+$ city (axal ward)
|
||||
+$ ward
|
||||
$: =skin
|
||||
=conf
|
||||
==
|
||||
++ pave
|
||||
|= p=path
|
||||
^- pith
|
||||
@ -1337,7 +1352,7 @@
|
||||
--
|
||||
--
|
||||
::
|
||||
++ poth (pole iota)
|
||||
++ road (pole iota)
|
||||
::
|
||||
++ pith
|
||||
|^ $+(pith ^pith)
|
||||
|
@ -1,27 +1,26 @@
|
||||
/- neo
|
||||
/+ *test-agent
|
||||
/= neo-agent /app/neo
|
||||
/= chat-shrub /lib/chat
|
||||
/= neo-agent /app/neo-two
|
||||
|%
|
||||
++ scry-handler
|
||||
|= =(pole knot)
|
||||
^- (unit vase)
|
||||
=^ view=@t pole
|
||||
?> ?=([@ *] pole)
|
||||
[-.pole +.pole]
|
||||
=. pole (slag 3 pole)
|
||||
~& pole
|
||||
`!>(!>(chat-shrub))
|
||||
~
|
||||
+$ card card:agent:gall
|
||||
++ make-chat
|
||||
|= [our=ship =pith]
|
||||
^- note:neo
|
||||
:- `^pith`[p/our pith]
|
||||
[%make %chat ~ ~]
|
||||
++ test-neo
|
||||
++ make-grow
|
||||
|= [=pith:neo =pail:neo]
|
||||
^- card:dirt:neo
|
||||
[pith %grow pail *oath:neo]
|
||||
++ make-cull
|
||||
|= =pith:neo
|
||||
^- card:dirt:neo
|
||||
[pith %cull ~]
|
||||
::
|
||||
++ test-dirt-card
|
||||
%- eval-mare
|
||||
=/ m (mare ,~)
|
||||
^- form:m
|
||||
=/ =pith:neo #/foo
|
||||
;< caz=(list card) bind:m
|
||||
(do-init %neo neo-agent)
|
||||
;< ~ bind:m
|
||||
@ -30,6 +29,12 @@
|
||||
(set-scry-gate scry-handler)
|
||||
;< =bowl bind:m get-bowl
|
||||
;< caz=(list card) bind:m
|
||||
(do-poke %noun !>((make-chat our.bowl #/foo)))
|
||||
(do-poke %neo-dirt-card !>((make-grow pith atom+!>(1))))
|
||||
;< caz=(list card) bind:m
|
||||
(do-poke %neo-dirt-card !>((make-grow pith atom+!>(2))))
|
||||
;< caz=(list card) bind:m
|
||||
(do-poke %neo-dirt-card !>((make-grow pith atom+!>(3))))
|
||||
;< vax=vase bind:m get-save
|
||||
%- (slog (sell vax) ~)
|
||||
(pure:m ~)
|
||||
--
|
||||
|
Loading…
Reference in New Issue
Block a user