ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-19 21:02:01 +03:00
Code Issues Packages Projects Releases Wiki Activity

Add draft code

Browse Source
This commit is contained in:
~wicrum-wicrun 2023-02-01 17:05:18 +01:00
parent 0626780d7e
commit 23d43bd5f4
3 changed files with 338 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

289
pkg/base-dev/lib/sss.hoon Normal file
View File

@ -0,0 +1,289 @@
/- *sss
::
|%
++ mk-subs |* [=(lake) paths=mold] -:+6:(da lake paths)
++ mk-pubs |* [=(lake) paths=mold] -:+6:(du lake paths)
++ mk-mar
|* =(lake)
|_ =(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)
::
++ 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]
=>
|%
+$ 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)
+$ result (request:poke paths)
++ pine
|= [=what =ship =dude path=paths]
^- card:agent:gall
:* %pass (zoom request/pine/ship^dude^what^path)
%agent [ship dude]
%poke %sss-to-pub :- result-type ^- result
[path dap.bowl %pine what]
==
++ surf
|= [=ship =dude path=paths]
(pine %wave ship dude path)
::
++ read
;; (map [ship dude path] [fail=? rock:lake])
%- ~(run by sub)
|= =flow
[fail rock]:rok.flow
::
++ chit
|= [[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
?. =(aeon.rok.flow (slav %ud aeon)) flow
flow(fail.rok &)
::
++ behn
|= [ship=term =dude path=paths]
^- (list card:agent:gall)
=> .(ship (slav %p ship))
?. (~(has by sub) ship dude path) ~
~[(pine %wave ship dude path)]
::
++ apply
|= res=(response:poke lake paths)
?~ ;;((soft path) path.res) ~| %need-path !!
?@ payload.res
(pine-response res)
(scry-response res)
::
++ pine-response
|= res=[path=paths from=dude =aeon =what]
^- (quip card:agent:gall _sub)
=* current [src.bowl from.res path.res]
=/ =flow (~(gut by sub) current *flow)
:_ (~(put by sub) current flow(aeon (max aeon.flow aeon.res)))
?- what.res
%rock
?. |((lth aeon.rok.flow aeon.res) =(aeon.res 0)) ~
:~ :* %pass (zoom request/scry/(scot %p src.bowl)^from.res^what.res^(scot %ud aeon.res)^path.res)
%agent [src.bowl from.res]
%poke %sss-to-pub :- result-type ^- result
[path.res dap.bowl %scry %rock aeon.res]
== ==
::
%wave
=/ cards=(list card:agent:gall)
:~ :* %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
%+ turn (gulf +(aeon.rok.flow) aeon.res)
|= =aeon
^- card:agent:gall
:* %pass (zoom request/scry/(scot %p src.bowl)^from.res^what.res^(scot %ud aeon)^path.res)
%agent [src.bowl from.res]
%poke %sss-to-pub :- result-type ^- result
[path.res dap.bowl %scry %wave aeon]
==
cards
==
::
++ scry-response
|= $: path=paths
=dude
=aeon
$%([what=%rock =rock:lake] [what=%wave =wave:lake])
==
^- (quip card:agent:gall _sub)
=* current [src.bowl dude path]
=/ =flow (~(gut by sub) current *flow)
?. (lth aeon.rok.flow aeon)
%. `sub
(slog leaf/"ignoring stale {<what>} at aeon {<aeon>}" ~)
|^
?- what
%rock
=. wav.flow (lot:wav wav.flow `aeon ~)
=. rok.flow [aeon | rock]
=. aeon.flow (max aeon aeon.flow)
(swim ~)
::
%wave
?: =(aeon +(aeon.rok.flow))
=. rok.flow [aeon | (wash:lake rock.rok.flow wave)]
(swim `wave)
`(~(put by sub) current flow(wav (put:wav wav.flow aeon wave)))
==
++ swim
|= wave=(unit wave:lake)
^- (quip card:agent:gall _sub)
=^ wave wav.flow (del:wav wav.flow +(aeon.rok.flow))
?^ wave
=. rok.flow [+(aeon.rok.flow) | (wash:lake rock.rok.flow u.wave)]
(swim wave)
:_ (~(put by sub) current flow)
:~ :* %pass (zoom on-rock/(scot %ud aeon.rok.flow)^(scot %p src.bowl)^dude^path)
%agent [our dap]:bowl
%poke %sss-on-rock :- on-rock-type ^- from
[path src.bowl dude rock.rok.flow ^wave]
== ==
--
--
++ du
|* [=(lake) paths=mold]
=>
|%
+$ 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)
::
+$ into (request:poke paths)
+$ result (response:poke lake paths)
++ rule
|= [path=paths =^rule]
^+ pub
%+ ~(jab by pub) path
|= =tide
(petrify tide(rul rule))
::
++ wipe
|= path=paths
^+ pub
%+ ~(jab by pub) path
|= =tide
%* . (petrify tide(rul [0 0]))
rul rul.tide
==
++ give
|= [path=paths =wave:lake]
^+ pub
?~ ;;((soft ^path) path) ~| %need-path !!
%+ ~(put by pub) path
=/ =tide (~(gut by pub) path *tide)
=/ next=aeon
.+ %+ max
(fall (bind (pry:rok rok.tide) head) 0)
(fall (bind (ram:wav wav.tide) head) 0)
=/ last=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok)
=. wav.tide (put:wav wav.tide next wave)
?. =(next (add aeon.last waves.rul.tide)) tide
(petrify tide)
::
++ petrify
~& %hmm
|= =tide
^+ tide
=/ next=aeon
%+ max
(fall (bind (pry:rok rok.tide) head) 0)
(fall (bind (ram:wav wav.tide) head) 0)
=/ last=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok)
=. rok.tide
%+ gas:rok +<-:gas:rok
%- tab:rok :_ [~ +(rocks.rul.tide)]
%^ put:rok rok.tide next
%+ roll (tab:wav wav.tide `aeon.last waves.rul.tide)
|= [[aeon =wave:lake] =_rock.last]
(wash:lake rock wave)
~| %rock-none
tide(wav (lot:wav wav.tide (bind (ram:rok rok.tide) |=([r=@ *] (dec r))) ~))
::
++ read
;; (map path rock:lake)
%- ~(run by pub)
|= =tide
=< rock
=/ snap=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok)
%+ roll (tap:wav (lot:wav wav.tide `aeon.snap ~))
|= [[=aeon =wave:lake] =_snap]
?. =(aeon +(aeon.snap)) snap
[aeon (wash:lake rock.snap wave)]
::
:: %+ ~(put by pub) path
:: =/ =tide (~(gut by pub) path *tide)
:: =^ last rok.tide (pop:rok rok.tide)
:: =^ next wav.tide
:: %^ (dip:wav ,[aeon rock:lake])
:: (lot:wav wav.tide `-.last ~)
:: last
:: |= [[aeon =rock:lake] [=aeon =wave:lake]]
:: ^- [(unit wave:lake) ? [^aeon rock:lake]]
:: [~ | aeon (wash:lake rock wave)]
:: tide(rok (put:rok +<-:put:rok next))
::
++ apply
|= req=(request:poke paths)
^- card:agent:gall
=* 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^what.req^(scot %ud aeon.req)^path.req)
%agent [src.bowl from.req]
%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)
== == ==
::
%pine
=/ =aeon
?- what.req
%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^what.req^path.req)
%agent [src.bowl from.req]
%poke mark result-type ^- result
[path.req dap.bowl aeon what.req]
==
==
--
--

12
pkg/base-dev/mar/sss/to-pub.hoon Normal file
View File

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

37
pkg/base-dev/sur/sss.hoon Normal file
View File

@ -0,0 +1,37 @@
|%
++ lake
|$ [rock wave]
$_ ^?
|%
++ name *term
+$ rock ^rock
+$ wave ^wave
++ wash |~ [rock wave] *rock
--
+$ aeon @ud
+$ dude dude:agent:gall
+$ what ?(%rock %wave)
++ poke
|%
++ request
|* paths=mold
$: path=paths
from=dude
$% [type=%pine =what]
[type=%scry =what aeon=@ud]
== ==
++ response
|* [=(lake) paths=mold]
$: path=paths
from=dude
aeon=@ud
$= payload
$@ =what
$% [what=%rock =rock:lake]
[what=%wave =wave:lake]
== ==
++ on-rock
|* [=(lake) paths=mold]
,[path=paths src=ship from=dude =rock:lake wave=(unit wave:lake)]
--
--