wicrum-wicrun/sss
1
1
Fork 0
mirror of https://github.com/wicrum-wicrun/sss.git synced 2024-09-11 18:37:26 +03:00
Code Issues Packages Projects Releases Wiki Activity

Generate marks for each lake

Browse Source
This commit is contained in:
~wicrum-wicrun 2023-02-01 14:06:17 +01:00
parent 5e417470d1
commit 6df1954723
9 changed files with 185 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
urbit/app/simple.hoon
View File

@ -1,42 +1,30 @@
/- sum, log
/+ verb, dbug, *sss
::
=>
|%
++ sum
|%
+$ rock @ud
+$ wave @ud
++ wash add
--
++ log
|%
+$ rock (list cord)
+$ wave cord
++ wash
|= [rok=rock wav=wave]
^+ rok
[wav rok]
--
--
::
%- agent:dbug
%+ verb &
::
=/ in-log (mk-subs log ,[%foo %bar ~])
=/ in-sum (mk-subs sum ,[%baz ~])
=/ out-log (mk-pubs log ,[%foo %bar ~])
=/ in-log (mk-subs log ,[%log @ ~])
=/ in-sum (mk-subs sum ,[%sum *])
=/ out-log (mk-pubs log ?([%log *] [%other-log ~]))
=/ out-sum (mk-pubs sum ,[%sum %foo ~])
::
|_ =bowl:gall
+* this .
da-in-log =/ da (da log ,[%foo %bar ~])
~(. da in-log bowl -:!>(*result:da) -:!>(from:da))
da-in-sum =/ da (da sum ,[%baz ~])
~(. da in-sum bowl -:!>(*result:da) -:!>(from:da))
du-out-log =/ du (du log ,[%foo %bar ~])
da-in-log =/ da (da log ,[%log @ ~])
~(. da in-log bowl -:!>(*result:da) -:!>(*from:da))
::
da-in-sum =/ da (da sum ,[%sum *])
~(. da in-sum bowl -:!>(*result:da) -:!>(*from:da))
::
du-out-log =/ du (du log ?([%log *] [%other-log ~]))
~(. du out-log bowl -:!>(*result:du))
::
du-out-sum =/ du (du sum ,[%sum %foo ~])
~(. du out-sum bowl -:!>(*result:du))
::
++ on-init `this
++ on-save !>([in-log in-sum out-log])
++ on-save !>([in-log in-sum out-log out-sum])
++ on-load _`this
:: |= =vase
:: =/ old !<([=_in-log =_in-sum =_out-log] vase)
@ -45,25 +33,38 @@
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall _this)
~& > "sub-map is: {<read:da-in-log>}"
~& > "pub-map is: {<read:du-out-log>}"
?+ mark !!
~& >> "in-log was: {<read:da-in-log>}"
~& >> "out-log was: {<read:du-out-log>}"
~& >> "in-sum was: {<read:da-in-sum>}"
~& >> "out-sum was: {<read:du-out-sum>}"
?- mark
%noun `this
%add
`this(out-log (give:du-out-log [%foo %bar ~] !<(cord vase)))
=. out-sum (give:du-out-sum !<([[%sum %foo ~] @ud] vase))
~& > "out-sum is: {<read:du-out-sum>}"
`this
::
%log
=. out-log (give:du-out-log !<([?([%log *] [%other-log ~]) cord] vase))
~& > "out-log is: {<read:du-out-log>}"
`this
::
%surf
%surf-log
:_ this
~[(surf:da-in-log !<(@p vase) %simple [%foo %bar ~])]
~[(surf:da-in-log !<(@p (slot 2 vase)) %simple !<([%log @ ~] (slot 3 vase)))]
::
%surf-sum
:_ this
~[(surf:da-in-sum !<(@p (slot 2 vase)) %simple !<([%sum *] (slot 3 vase)))]
::
%sss-on-rock
?- msg=!<($%(from:da-in-log from:da-in-sum) vase)
[[%foo %bar ~] *]
?- msg=!<($%(from:da-in-log from:da-in-sum) (fled vase))
[[%log * ~] *]
~& "last message from {<from.msg>} on {<src.msg>} is {<,.-.rock.msg>}"
?< =(-.rock.msg 'crash')
`this
::
[[%baz ~] *]
[[%sum *] *]
?. =(rock.msg 42) `this
~& "sum from {<from.msg>} on {<src.msg>} is 42" ::NOTE src.msg not src.bowl!
`this
@ -71,18 +72,21 @@
::
%sss-to-pub
:_ this
?- msg=!<(into:du-out-log vase)
[[%foo %bar ~] *] ~[(apply:du-out-log msg)]
?- msg=!<($%(into:du-out-log into:du-out-sum) (fled vase))
[[%sum %foo ~] *] ~[(apply:du-out-sum msg)]
* ~[(apply:du-out-log msg)]
==
::
%sss-to-sub
?- msg=!<($%(into:da-in-log into:da-in-sum) vase)
[[%foo %bar ~] *]
*
?- msg=!<($%(into:da-in-log into:da-in-sum) (fled vase))
[[%log * ~] *]
=^ cards in-log (apply:da-in-log msg)
~& > "in-log is: {<read:da-in-log>}"
[cards this]
::
[[%baz ~] *]
[[%sum *] *]
=^ cards in-sum (apply:da-in-sum msg)
~& > "in-sum is: {<read:da-in-sum>}"
[cards this]
==
==
@ -90,25 +94,27 @@
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall _this)
?- wire :: `this
[~ %sss %on-rock @ @ @ %foo %bar ~]
`this(in-log (chit:da-in-log |3:wire sign))
?> ?=(%poke-ack -.sign)
?~ p.sign `this
%- (slog u.p.sign)
?+ wire `this
[~ %sss %on-rock @ @ @ %log @ ~]
=. in-log (chit:da-in-log |3:wire sign)
~& > "in-log is: {<read:da-in-log>}"
`this
::
[~ %sss %on-rock @ @ @ %baz ~]
`this(in-sum (chit:da-in-sum |3:wire sign))
::
*
?> ?=(%poke-ack -.sign)
?~ p.sign `this
((slog u.p.sign) `this)
[~ %sss %on-rock @ @ @ %sum *]
=. in-sum (chit:da-in-sum |3:wire sign)
~& > "in-sum is: {<read:da-in-sum>}"
`this
==
++ on-arvo
|= [=wire sign=sign-arvo]
^- (quip card:agent:gall _this)
:_ this
?+ wire ~
[~ %sss %behn @ @ %foo %bar ~] (behn:da-in-log |3:wire)
[~ %sss %behn @ @ %baz ~] (behn:da-in-sum |3:wire)
[~ %sss %behn @ @ %log @ ~] (behn:da-in-log |3:wire)
[~ %sss %behn @ @ %sum *] (behn:da-in-sum |3:wire)
==
::
++ on-peek _~

134
urbit/lib/sss.hoon
View File

@ -1,34 +1,50 @@
/- *sss
::
|%
++ mk-subs
|* [=(lake) paths=mold]
*(map [ship dude paths] (flow lake))
::
++ mk-pubs
|* [=(lake) paths=mold]
*(map paths (tide lake))
::
+$ rule [rocks=_1 waves=_5]
+$ aeon @ud
++ tide
++ mk-subs |* [=(lake) paths=mold] -:+6:(da lake paths)
++ mk-pubs |* [=(lake) paths=mold] -:+6:(du lake paths)
++ mk-mar
|* =(lake)
$: rok=((mop aeon rock:lake) gte)
wav=((mop aeon wave:lake) lte)
rul=rule
==
++ flow
|* =(lake)
$: =aeon
rok=[=aeon fail=_| =rock:lake]
wav=((mop aeon wave:lake) lte)
==
|_ =(response:poke lake *)
++ grow
|%
++ noun response
--
++ grab
|%
++ noun (response:poke lake *)
--
++ grad %noun
--
++ lake-mark
|= =mark
^+ mark
?> =('sss-' (end [3 3] mark))
(cut 3 [4 (met 3 mark)] mark)
::
++ zoom |= =path `^path`$/sss/path
++ fled :: Like +sped but head is a path.
|= vax=vase
^- vase
:_ q.vax
%- ~(play ut p.vax)
=- [%wtgr [%wtts - [%& 2]~] [%$ 1]]
=/ pax ~| %need-path ;;(path -.q.vax)
|- ^- spec
?~ pax [%base %null]
[%bccl ~[[%leaf %ta -.pax] $(pax +.pax)]]
::
++ zoom |= =noun ~| %path-none $/sss/;;(path noun)
++ da
|* [=(lake) paths=mold]
|_ [sub=_(mk-subs lake paths) =bowl:gall result-type=type on-rock-type=type]
=>
|%
+$ flow
$: =aeon
rok=[=aeon fail=_| =rock:lake]
wav=((mop aeon wave:lake) lte)
==
--
|_ [sub=(map [ship dude paths] flow) =bowl:gall result-type=type on-rock-type=type]
+* wav ((on aeon wave:lake) lte)
+$ from (on-rock:poke lake paths)
+$ into (response:poke lake paths)
@ -46,44 +62,39 @@
(pine %wave ship dude path)
::
++ read
^- (map [ship dude paths] [? rock:lake])
;; (map [ship dude path] [fail=? rock:lake])
%- ~(run by sub)
|= =(flow lake)
|= =flow
[fail rock]:rok.flow
::
++ chit
|= [[aeon=@ ship=@ dude=@ path=paths] =sign:agent:gall]
|= [[aeon=term ship=term dude=term path=paths] =sign:agent:gall]
^+ sub
?> ?=(%poke-ack -.sign)
?~ p.sign sub
%+ ~(jab by sub) [(slav %p ship) dude path]
|= =(flow lake)
|= =flow
?. =(aeon.rok.flow (slav %ud aeon)) flow
flow(fail.rok &)
::
++ behn
|= [ship=term =dude path=paths]
^- (list card:agent:gall)
~[(pine %wave (slav %p ship) dude path)]
=> .(ship (slav %p ship))
?. (~(has by sub) ship dude path) ~
~[(pine %wave ship dude path)]
::
++ apply
|= res=(response:poke lake paths)
~& > received-response/res
=- ~& >> [new-sub/-> cards/-<] -
?@ payload.res
(pine-response res)
(scry-response res)
::
++ timer
|= [ship=@ dude=@ path=paths]
^- card:agent:gall
[%pass (zoom behn/ship^dude^path) %arvo %b %wait (add ~s10 now.bowl)]
::
++ pine-response
|= res=[path=paths from=dude =aeon =what]
^- (quip card:agent:gall _sub)
=* current [src.bowl from.res path.res]
=/ =(flow lake) (~(gut by sub) current *(flow lake))
=/ =flow (~(gut by sub) current *flow)
:_ (~(put by sub) current flow(aeon (max aeon.flow aeon.res)))
?- what.res
%rock
@ -96,7 +107,9 @@
::
%wave
=/ cards=(list card:agent:gall)
~[(timer (scot %p src.bowl) from.res path.res)]
:~ :* %pass (zoom behn/(scot %p src.bowl)^from.res^path.res)
%arvo %b %wait (add ~s10 now.bowl)
== ==
=? cards (gth aeon.res +(aeon.flow)) [(pine %rock current) cards]
=? cards (gth aeon.res aeon.rok.flow)
%+ weld cards
@ -119,7 +132,7 @@
==
^- (quip card:agent:gall _sub)
=* current [src.bowl dude path]
=/ =(flow lake) (~(gut by sub) current *(flow lake))
=/ =flow (~(gut by sub) current *flow)
?. (lth aeon.rok.flow aeon)
%. `sub
(slog leaf/"ignoring stale {<what>} at aeon {<aeon>}" ~)
@ -154,7 +167,16 @@
--
++ du
|* [=(lake) paths=mold]
|_ [pub=_(mk-pubs lake paths) =bowl:gall result-type=type]
=>
|%
+$ rule [rocks=_1 waves=_5]
+$ tide
$: rok=((mop aeon rock:lake) gte)
wav=((mop aeon wave:lake) lte)
rul=rule
==
--
|_ [pub=(map paths tide) =bowl:gall result-type=type]
+* rok ((on aeon rock:lake) gte)
wav ((on aeon wave:lake) lte)
::
@ -163,8 +185,9 @@
++ give
|= [path=paths =wave:lake]
^+ pub
?~ ;;((soft ^path) path) ~| %need-path !!
%+ ~(put by pub) path
=/ =(tide lake) (~(gut by pub) path *(tide lake))
=/ =tide (~(gut by pub) path *tide)
=/ next=aeon
.+ %+ max
(fall (bind (pry:rok rok.tide) head) 0)
@ -179,12 +202,13 @@
%+ roll (tab:wav wav.tide `aeon.last waves.rul.tide)
|= [[aeon =wave:lake] =_rock.last]
(wash:lake rock wave)
tide(wav (lot:wav wav.tide (bind (ram:rok rok.tide) head) ~))
~| %rock-none
tide(wav (lot:wav wav.tide (bind (ram:rok rok.tide) |=([r=@ *] (dec r))) ~))
::
++ read
^- (map paths rock:lake)
;; (map path rock:lake)
%- ~(run by pub)
|= =(tide lake)
|= =tide
=< rock
=/ snap=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok)
%+ roll (tap:wav (lot:wav wav.tide `aeon.snap ~))
@ -196,7 +220,7 @@
|= path=paths
^+ pub
%+ ~(put by pub) path
=/ =(tide lake) (~(gut by pub) path *(tide lake))
=/ =tide (~(gut by pub) path *tide)
=^ last rok.tide (pop:rok rok.tide)
=^ next wav.tide
%^ (dip:wav ,[aeon rock:lake])
@ -210,31 +234,29 @@
++ apply
|= req=(request:poke paths)
^- card:agent:gall
~& > received-request/req
=- ~& >> cards/- -
=/ =(tide lake) (~(gut by pub) path.req *(tide lake))
=* mark (cat 3 %sss- name:lake)
=/ =tide (~(gut by pub) path.req *tide)
?- type.req
%scry
:* %pass (zoom response/scry/(scot %p src.bowl)^from.req^(scot %ud aeon.req)^path.req)
%agent [src.bowl from.req]
%poke %sss-to-sub :- result-type ^- result
%poke mark result-type ^- result
:* path.req dap.bowl aeon.req
?- what.req
%wave wave/(got:wav wav.tide aeon.req)
%rock
?: =(aeon.req 0) rock/*rock:lake
rock/(got:rok rok.tide aeon.req)
?- what.req
%wave wave/(got:wav wav.tide aeon.req)
%rock ?: =(aeon.req 0) rock/*rock:lake
rock/(got:rok rok.tide aeon.req)
== == ==
::
%pine
=/ =aeon
?- what.req
%rock key:(fall (pry:rok rok.tide) *[=key =val]:rok)
%wave key:(fall (ram:wav wav.tide) *[=key =val]:wav)
%rock key:(fall (pry:rok rok.tide) *[=key val]:rok)
%wave key:(fall (ram:wav wav.tide) *[=key val]:wav)
==
:* %pass (zoom response/pine/(scot %p src.bowl)^from.req^path.req)
%agent [src.bowl from.req]
%poke %sss-to-sub :- result-type ^- result
%poke mark result-type ^- result
[path.req dap.bowl aeon what.req]
==
==

15
urbit/mar/sss/log.hoon Normal file
View File

@ -0,0 +1,15 @@
/- log
/+ *sss
(mk-mar log)
:: |_ =(response:poke)
:: ++ grow
:: |%
:: ++ noun response
:: --
:: ++ grab
:: |%
:: ++ noun (response:poke)
:: --
:: ++ grad %noun
:: --

12
urbit/mar/sss/response.hoon
View File

@ -1,12 +0,0 @@
/- *sss
|_ =(response:poke)
++ grow
|%
++ noun response
--
++ grab
|%
++ noun (response:poke)
--
++ grad %noun
--

15
urbit/mar/sss/sum.hoon Normal file
View File

@ -0,0 +1,15 @@
/- sum
/+ *sss
(mk-mar sum)
:: |_ =(response:poke)
:: ++ grow
:: |%
:: ++ noun response
:: --
:: ++ grab
:: |%
:: ++ noun (response:poke)
:: --
:: ++ grad %noun
:: --

0
urbit/mar/sss/request.hoon → urbit/mar/sss/to-pub.hoon
View File

8
urbit/sur/log.hoon Normal file
View File

@ -0,0 +1,8 @@
|%
++ name %log
+$ rock (list cord)
+$ wave cord
++ wash
|= [=rock =wave]
[wave rock]
--

3
urbit/sur/sss.hoon
View File

@ -3,11 +3,12 @@
|$ [rock wave]
$_ ^?
|%
++ name *term
+$ rock ^rock
+$ wave ^wave
++ wash |~ [rock wave] *rock
--
:: +$ aeon @ud
+$ aeon @ud
+$ dude dude:agent:gall
+$ what ?(%rock %wave)
++ poke

6
urbit/sur/sum.hoon Normal file
View File

@ -0,0 +1,6 @@
|%
++ name %sum
+$ rock @ud
+$ wave @ud
++ wash add
--