neo: remove arvo special casing

This commit is contained in:
Liam Fitzgerald 2024-03-20 13:05:02 -04:00
parent 2950d0a9d8
commit 16cfd7d8d5
24 changed files with 93 additions and 398 deletions

View File

@ -163,8 +163,8 @@
=/ =name:neo [our.bowl #/src/reef]
=+ .^(neo-vase=vase %ca (welp clay-beak /sur/neo/hoon))
=/ reef=vase (slop !>(..zuse) neo-vase(p [%face %neo p.neo-vase]))
=/ =note:neo [(en-pith:name:neo name) %make (clay-lib %ford-reef) `!>(reef) ~]
(on-note note)
=/ =card:neo [(en-pith:name:neo name) %make (clay-lib %ford-reef) `!>(reef) ~]
(on-card card)
++ sync-room
|= [=stud:neo =name:neo]
^+ run
@ -188,7 +188,7 @@
=/ =wire forward/(en-path:name:neo name)
=/ =dock [ship.name dap.bowl]
=- (emit %pass wire %agent dock %poke -)
noun+!>(`note:neo`[(en-pith:name:neo name) %poke pok])
noun+!>(`card:neo`[(en-pith:name:neo name) %poke pok])
++ print-dbug
|= veb=?
|^ ^+ same
@ -301,24 +301,22 @@
?: ?=(%out -.q.vase)
=+ ;;(=out:neo +.q.vase)
(do-out out)
=+ ;;(=note:neo q.vase)
=/ =name:neo (de-pith:name:neo p.note)
=+ ;;(=card:neo q.vase)
=/ =name:neo (de-pith:name:neo p.card)
?. =(our.bowl ship.name)
?> ?=(%poke -.q.note)
(forward-poke name val.q.note)
(on-note note)
++ on-note
|= =note:neo
=/ =name:neo (de-pith:name:neo p.note)
?> =(our.bowl ship.name)
abet:(apply:(abed:arvo our-sys-pith pith.name) note)
?> ?=(%poke -.q.card)
(forward-poke name val.q.card)
(on-card card)
++ on-card
|= =card:neo
(on-move our-sys-pith card)
::
++ on-move
|= =move:neo
?> ?=(%neo -.q.move)
=/ =name:neo (de-pith:name:neo p.q.move)
~& move/name
?> =(our.bowl ship.name)
abet:(apply:(abed:arvo p.move pith.name) +.q.move)
abet:(apply:(abed:arvo p.move pith.name) move)
::
++ watch
|= =(pole knot)
@ -455,7 +453,7 @@
++ do-make
|= [=pith:neo lib=term sta=(unit vase) =conf:neo]
=/ =name:neo (de-pith:name:neo pith)
=. run (on-note pith %make (clay-lib lib) sta conf)
=. run (on-card pith %make (clay-lib lib) sta conf)
?: =(lib %sym)
run
=/ rom (got:of-top pith.name)
@ -697,7 +695,6 @@
::
++ give-nack
|= [src=pith err=tang]
%- (slog leaf/(en-tape:pith:neo src) err)
=/ nam=name:neo (de-pith:name:neo src)
?: =(1 1) !!
?. =(our.bowl ship.nam)
@ -763,7 +760,7 @@
++ arvo
=+ verb=&
|_ $: [src=pith init=pith here=pith]
[done=(list note:neo) down=(list note:neo) up=(list move:neo) change=(set pith)]
[done=(list move:neo) down=(list move:neo) up=(list move:neo) change=(set pith)]
[old=state-0 err=(unit tang)]
==
++ abet
@ -787,27 +784,18 @@
^- card
:+ %pass local/(pout p.move)
^- note:agent:gall
?: ?=(%arvo -.q.move)
q.move
=/ =note:neo +.q.move
=/ her=ship
~| p.note
?> ?=([[%p @p] *] p.note)
+.i.p.note
~| p.move
?> ?=([[%p @p] *] p.q.move)
+.i.p.q.move
[%agent [her dap.bowl] %poke neo-move+!>(move)]
++ arvo .
++ emit |=(=note:neo arvo(down [note down]))
++ emit |=(=move:neo arvo(down [move down]))
++ trace-card
|= =move:neo
^- tank
:- %leaf
%+ welp
"{(en-tape:pith:neo p.move)} -> "
?- -.q.move
%arvo "arvo {<-.+.q.move>}"
%neo
"{(en-tape:pith:neo p.q.move)}: {<-.q.q.move>}"
==
"{(en-tape:pith:neo p.move)} -> {(en-tape:pith:neo p.q.move)}: {<-.q.q.move>}"
++ trace
|= =tang
?. verb same
@ -824,7 +812,7 @@
arvo
?~ down
arvo
=/ nex=note:neo i.down
=/ nex=move:neo i.down
=/ new-arvo (apply:arvo(down t.down) nex) :: XX: weird compiler?
$(arvo new-arvo, done (snoc done nex))
++ take-neo
@ -846,18 +834,18 @@
(soft-site |.(si-abet:(si-poke:site val)))
::
++ apply
|= note=note:neo
|= =move:neo
^+ arvo
?. =(~ err)
arvo
=/ =name:neo (de-pith:name:neo p.note)
=. src here
=. here pith.name
%- (trace leaf/"{<-.q.note>} {(spud (pout here))}" ~)
=. src p.move
=/ =name:neo (de-pith:name:neo p.q.move)
=. here pith.name
%- (trace leaf/"{<-.q.q.move>} {(spud (pout here))}" ~)
=^ caz=(list card:neo) arvo
?+ -.q.note !!
%make (make +.q:note)
%poke (poke +.q:note)
?+ -.q.q.move !!
%make (make +.q.q:move)
%poke (poke +.q.q:move)
%link !!
:: :- ~
::=. run (link [p from.q src.q]:note)
@ -873,9 +861,7 @@
%+ murn caz
|= =card:neo
^- (unit move:neo)
?: ?=(%arvo -.card)
`[pith card]
=/ inside +.card
:: =/ inside +.card
=/ =name:neo (de-pith:name:neo p.card)
?. =(our.bowl ship.name)
`[pith card]
@ -888,19 +874,19 @@
:_ down
%+ murn caz
|= =card:neo
^- (unit note:neo)
?: ?=(%arvo -.card) ~
^- (unit move:neo)
=/ =name:neo (de-pith:name:neo p.card)
?. =(our.bowl ship.name)
~
?. (is-parent pith pith.name)
~
`[p q]:card
`[pith card]
work
::
++ make
|= [src=code:neo init=(unit vase) =conf:neo]
=/ =firm:neo ~(firm husk src)
~& here
:: =. run (~(start husk src) our.bowl pith)
=/ =form:neo form:firm
=/ =span:neo [src firm]
@ -1311,8 +1297,8 @@
?- -.res
%done
=/ =pith:neo (en-pith:name:neo get:cwd:peel)
=/ =note:neo [pith %poke q.q.value.res]
=. run (on-note note)
=/ =card:neo [pith %poke q.q.value.res]
=. run (on-card card)
=; ef=shoe-effect:shoe
=. run (shoe-ef ef)
hike

View File

@ -1,93 +0,0 @@
/- neo
/+ message
=* card card:neo
=>
|%
++ msg-loc
|= =bowl:neo
^- path
/(scot %p our.bowl)/base/(scot %da now.bowl)/lib/message/hoon
--
^- firm:neo
|%
:: $state: state for chat container
:: .who: set of ships allowed to poke
:: .title: human-readable title of chat
::
+$ state [%0 who=(set ship) title=@t]
:: $poke: update for chat container
::
:: %title:
:: %add: add .ship to .who in $state
:: %del: remove .ship from .who in $state
::
+$ poke
$% [%title title=@t] :: update
[%add =ship]
[%del =ship]
[%msg msg=state:message]
[%dbug ~]
==
++ kids
=< apex
|%
++ apex
%- ~(gas by *kids:neo)
:~ messages
==
++ messages
:- ~[&/%messages |/%da]
[state:message poke:message]
--
++ deps
=< apex
|%
++ apex
%- ~(gas by *deps:neo)
:~ open/open
==
++ open
[| ,? ,?]
--
++ form
^- form:neo
|_ [=bowl:neo case=@ud state-vase=vase *]
+* sta !<(state state-vase)
++ call
|= [old-state=vase act=*]
=+ ;;(=poke act)
?: ?=(%dbug -.poke)
~& dbug/bowl
*(list card)
?. ?=(%msg -.poke)
*(list card)
[%neo (welp were.bowl ~[da/now.bowl]) %make %message `!>(msg.poke) ~]^~
++ reduce
|= pok=*
^- vase
=+ ;;(=poke pok)
=/ sta sta
?. ;;(? +:(~(gut by deps.bowl) %open [*pith &]))
~&(dropping-poke/poke !>(sta))
?> |(=(our src):bowl (~(has in who.sta) src.bowl))
=- !>(-)
^- state
?- -.poke
%title !! :: sta(title title.poke)
%add sta(who (~(put in who.sta) ship.poke))
%del sta(who (~(del in who.sta) ship.poke))
?(%dbug %msg) sta
==
++ init
|= old=(unit vase)
!>(*state)
++ born *(list card:neo)
++ echo
|= [=pith val=*]
*(list card:neo)
++ take
|= =sign:neo
*(list card:neo)
--
--

View File

@ -1,2 +0,0 @@
/+ room-builder
((room-builder ,?) |)

View File

@ -1,28 +0,0 @@
/- neo
^- firm:neo
|%
+$ poke ?
+$ state ?
++ deps *deps:neo
++ kids *kids:neo
++ form
^- form:neo
|_ [=bowl:neo raw-sta=* *]
++ call
|= ^ *(list card:neo)
++ reduce
|= raw-val=*
=+ ;;(val=? raw-val)
val
++ take
|= =sign:neo
*(list card:neo)
++ born *(list card:neo)
++ init
|= old=(unit *)
&
++ echo
|= [=pith val=*]
*(list card:neo)
--
--

View File

@ -37,9 +37,9 @@
face/face
==
++ sut
[& ,[cache=(unit vase) *] ,*]
[& %x ,[cache=(unit vase) *] ,*]
++ face
[& ,@tas ,*]
[& %x ,@tas ,*]
--
++ form
^- form:neo
@ -60,7 +60,7 @@
!>(*^state)
++ born
=- ~[-]
[%neo were.bowl %poke %dep ~]
[were.bowl %poke %dep ~]
++ echo
|= [=pith val=*]
*(list card:neo)
@ -70,6 +70,6 @@
?. ?=([%neo %conf %val @] sign)
!!
=- ~[-]
[%neo were.bowl %poke %dep ~]
[were.bowl %poke %dep ~]
--
--

View File

@ -1,78 +0,0 @@
/- neo
=>
|%
++ card card:neo
++ get-face
|= =bowl:neo
^- @tas
!<(@tas q:(~(got by deps.bowl) %face))
++ get-sut
|= =bowl:neo
^- (unit (pair pith vase))
=/ sut (~(got by deps.bowl) %sut)
=+ !<([cac=(unit vase) *] q.sut)
?~ cac
~
`[p.sut u.cac]
++ build
|= =bowl:neo
^- (unit vase)
?~ sut=(get-sut bowl)
~
=/ pit=vase !>(p=p.u.sut)
=/ cor=vase q.u.sut(p [%face %q p.q.u.sut])
=/ res=vase (slop pit cor)
`res(p [%face (get-face bowl) p.res])
--
^- firm:neo
|%
+$ state [cache=(unit vase) ~]
+$ poke
$% [%dep ~]
==
++ kids ~
++ deps
=< apex
|%
++ apex
%- ~(gas by *deps:neo)
:~ sut/sut
face/face
==
++ sut
[& ,[cache=(unit vase) *] ,*]
++ face
[& ,@tas ,*]
--
++ form
^- form:neo
|_ [=bowl:neo case=@ud state-vase=vase *]
+* sta !<(state state-vase)
++ call
|= [old-state=vase act=*]
*(list card)
++ reduce
|= pok=*
^- vase
=+ ;;(=poke pok)
=/ sta sta
=. cache.sta (build bowl)
!>(sta)
++ init
|= vax=(unit vase)
!>(*state)
++ born
=- ~[-]
[%neo were.bowl %poke %dep ~]
++ echo
|= [=pith val=*]
*(list card:neo)
++ take
|= =sign:neo
^- (list card:neo)
?. ?=([%neo %conf %val @] sign)
!!
=- ~[-]
[%neo were.bowl %poke %dep ~]
--
--

View File

@ -23,7 +23,7 @@
:~ src/src
==
++ src
[& ,[cache=(unit vase) *] ,*]
[%& %x ,[cache=(unit vase) *] ,*]
--
++ form
^- form:neo
@ -44,7 +44,7 @@
!>(*^state)
++ born
=- ~[-]
[%neo were.bowl %poke %dep ~]
[were.bowl %poke %dep ~]
++ echo
|= [=pith val=*]
*(list card:neo)
@ -54,6 +54,6 @@
?. ?=([%neo %conf %val @] sign)
!!
=- ~[-]
[%neo were.bowl %poke %dep ~]
[were.bowl %poke %dep ~]
--
--

View File

@ -36,7 +36,7 @@
b/sut
==
++ sut
[& ,[cache=(unit vase) *] ,*]
[& %x ,[cache=(unit vase) *] ,*]
--
++ form
^- form:neo
@ -57,7 +57,7 @@
!>(*^state)
++ born
=- ~[-]
[%neo were.bowl %poke %dep ~]
[were.bowl %poke %dep ~]
++ echo
|= [=pith val=*]
*(list card:neo)
@ -67,6 +67,6 @@
?. ?=([%neo %conf %val @] sign)
!!
=- ~[-]
[%neo were.bowl %poke %dep ~]
[were.bowl %poke %dep ~]
--
--

View File

View File

@ -39,7 +39,7 @@
:~ sut/sut
==
++ sut
[& ,[cache=(unit vase) *] ,*]
[& %x ,[cache=(unit vase) *] ,*]
--
++ form
^- form:neo
@ -64,7 +64,7 @@
!>(`^state`[~ hoon])
++ born
=- ~[-]
[%neo were.bowl %poke %dep ~]
[were.bowl %poke %dep ~]
++ echo
|= [=pith val=*]
*(list card:neo)
@ -74,6 +74,6 @@
?. ?=([%neo %conf %val @] sign)
!!
=- ~[-]
[%neo were.bowl %poke %dep ~]
[were.bowl %poke %dep ~]
--
--

View File

@ -16,6 +16,11 @@
::
:: %make
:: ^- firm:neo
=>
|%
++ behn
(pave //sys/behn)
--
|%
+$ state [count=@ud last=@da freq=@dr]
+$ poke
@ -27,38 +32,45 @@
++ deps *deps:neo
++ form
^- form:neo
|_ [=bowl:neo untyp-sta=* *]
+* sta ;;(state untyp-sta)
|_ [=bowl:neo case=@ud state-vase=vase *]
+* sta !<(state state-vase)
++ call
|= [ole=* act=*]
|= [ole=vase act=*]
^- (list card:neo)
=/ old-state ;;(state ole)
=/ old-state !<(state ole)
=/ sta sta
?: =(freq.old-state freq.sta)
~
:~ [%arvo %b %rest (add [last freq]:old-state)]
[%arvo %b %wait (add now.bowl freq.sta)]
=/ behn=pith
(pave //vane/behn)
=/ wait=req:behn:neo
[%rest (add [last freq]:old-state)]
=/ rest=req:behn:neo
[%wait (add now.bowl freq.sta)]
:~ [behn %poke rest]
[behn %poke wait]
==
++ reduce
|= act=*
^- *
^- vase
=+ ;;(=poke act)
=/ sta sta
!> ^- state
?- -.poke
%freq sta(freq freq.poke)
%last sta(last last.poke)
==
++ init
|= old=(unit *)
|= old=(unit vase)
?> ?=(^ old)
=+ ;;(sta=state u.old)
sta
=+ !<(sta=state u.old)
u.old
++ echo
|= [=pith val=*]
*(list card:neo)
++ born
=/ sta sta
[%arvo %b %wait (add now.bowl freq.sta)]^~
[behn %poke %wait (add now.bowl freq.sta)]^~
::
++ take
|= =sign:neo
@ -66,8 +78,8 @@
~& now/now.bowl
?. ?=([%arvo %behn %wake *] sign)
~
:~ [%neo were.bowl %poke %last now.bowl]
[%arvo %b %wait (add now.bowl freq.sta)]
:~ [were.bowl %poke %last now.bowl]
[behn %poke %wait (add now.bowl freq.sta)]
==
--
--

View File

@ -1,29 +0,0 @@
/- neo
|* =mold
|= start=mold
^- firm:neo
|%
++ poke mold
++ state mold
++ deps *deps:neo
++ form
|_ [=bowl:neo raw-sta=* *]
++ call
|= ^ *(list card:neo)
++ reduce
|= raw-val=*
=+ ;;(val=mold raw-val)
val
++ take
|= =sign:neo
*(list card:neo)
++ born *(list card:neo)
++ init
|= old=(unit *)
start
++ echo
|= [=pith val=*]
*(list card)
--
--

View File

@ -1,3 +0,0 @@
/= clay /sys/vane/clay
/* hoon-txt %hoon /lib/chat/hoon
(parse-pile:ford:clay /~zod/base/1/lib/chat/hoon (trip hoon-txt))

View File

@ -1,74 +0,0 @@
/- neo
=>
|%
++ card card:neo
++ get-face
|= =bowl:neo
^- @tas
!<(@tas q:(~(got by deps.bowl) %face))
++ get-sut
|= =bowl:neo
^- (unit vase)
=+ !<([cac=(unit vase) *] q:(~(got by deps.bowl) %sut))
cac
++ build
|= =bowl:neo
^- (unit vase)
?~ sut=(get-sut bowl)
~
`u.sut(p [%face (get-face bowl) p.u.sut])
+$ state [cache=(unit vase) ~]
+$ poke
$% [%dep ~]
==
--
^- firm:neo
|%
+$ poke ^poke
+$ state ^state
++ kids ~
++ deps
=< apex
|%
++ apex
%- ~(gas by *deps:neo)
:~ sut/sut
face/face
==
++ sut
[& ,[cache=(unit vase) *] ,*]
++ face
[& ,@tas ,*]
--
++ form
^- form:neo
|_ [=bowl:neo case=@ud state-vase=vase *]
+* sta !<(^state state-vase)
++ call
|= [old-state=vase act=*]
*(list card)
++ reduce
|= pok=*
^- vase
=+ ;;(=^poke pok)
=/ sta sta
=. cache.sta (build bowl)
!>(sta)
++ init
|= vax=(unit vase)
!>(*^state)
++ born
=- ~[-]
[%neo were.bowl %poke %dep ~]
++ echo
|= [=pith val=*]
*(list card:neo)
++ take
|= =sign:neo
^- (list card:neo)
?. ?=([%neo %conf %val @] sign)
!!
=- ~[-]
[%neo were.bowl %poke %dep ~]
--
--

View File

@ -34,7 +34,7 @@
:~ open/open
==
++ open
[required=| %bool %sig]
[required=| %x %bool %sig]
--
++ form
^- form:neo
@ -49,10 +49,9 @@
?. ?=(%msg -.poke)
*(list card)
=- ~[-]
^- card
:- %neo
^- note:neo
^- card:neo
:- (welp were.bowl ~[da/now.bowl])
^- note:neo
[%make stud/%message `!>(msg.poke) ~]
++ reduce
|= pok=* :: XX: vaseify

View File

@ -34,7 +34,7 @@
:~ open/open
==
++ open
[required=| %bool %sig]
[required=| %x %bool %sig]
--
++ form
^- form:neo
@ -49,10 +49,9 @@
?. ?=(%msg -.poke)
*(list card)
=- ~[-]
^- card
:- %neo
^- note:neo
^- card:neo
:- (welp were.bowl ~[da/now.bowl])
^- note:neo
[%make stud/%message `!>(msg.poke) ~]
++ reduce
|= pok=* :: XX: vaseify

View File

@ -0,0 +1 @@
~

View File

@ -16,6 +16,12 @@
::
::
|%
++ behn
|%
+$ req $>(?(%rest %wait) task:^behn)
+$ res $>(%wake gift:^behn)
--
:: Total version
+$ ever [node=@ud tree=@ud]
:: $once: reference to version
@ -362,11 +368,7 @@
+$ dita (each iota aura)
+$ pish (list dita)
+$ conf (map term pith)
+$ card
$+ card-neo
$% [%arvo note-arvo]
[%neo note]
==
+$ card (pair pith note)
+$ request
[src=pith dest=pith val=*]
+$ response
@ -397,7 +399,6 @@
:: +$ cage (pair stud vase)
::
+$ note
%+ pair pith
$% [%make =code init=(unit vase) =conf] :: todo: configuration values, init cannot be ^ if installing over
[%poke val=*]
[%tomb =case]
@ -528,8 +529,12 @@
deps=(map term (pair pith vase))
kids=(map pith vase)
==
+$ fief
[required=? =port]
+$ quay
$% [%x =port]
[%z =dock]
==
+$ fief [required=? =quay]
+$ dock [=port =kids]
+$ port :: TODO: how to specify behaviour
[state=* diff=*] :: state, diff actually $stud
+$ deps (map term fief)