From 6c4ddb45d7c4c6f16ae512277264798c8b506123 Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Thu, 1 Jan 2015 12:43:50 -0800 Subject: [PATCH 01/13] Various fixes and improvements. --- main/app/radio/core.hook | 89 ++-- main/app/talk/core.hook | 907 +++++++++++++++++++-------------------- main/sur/radio/core.hook | 33 +- 3 files changed, 502 insertions(+), 527 deletions(-) diff --git a/main/app/radio/core.hook b/main/app/radio/core.hook index f29c3082c..20ca241e4 100644 --- a/main/app/radio/core.hook +++ b/main/app/radio/core.hook @@ -14,7 +14,7 @@ [%0 house-0] :: 0: initial version == :: ++ house-1 :: - $: parties=(map span party) :: conversations + $: stories=(map span story) :: conversations general=(set bone) :: meta-subscribe outbox=(pair ,@ud (map ,@ud thought)) :: urbit outbox sent=(map ,@ud serial) :: own tweets @@ -31,7 +31,7 @@ [%exp p=@t q=tank] :: [%say p=@t] :: == == == :: - ++ party :: a conversation + ++ story :: a conversation $: count=@ud :: (lent grams) grams=(list telegram) :: all history locals=(map ship (pair ,@da status)) :: local presence @@ -119,7 +119,7 @@ :- %house %- ~(gas in *(set span)) ^- (list span) - (turn (~(tap by parties) ~) |=([a=span *] a)) + (turn (~(tap by stories) ~) |=([a=span *] a)) :: ++ ra-homes :: update stations =+ gel=general @@ -138,11 +138,10 @@ ?. =(her our.hid) (ra-evil %radio-no-owner) ?~ q.cod - ?. (~(has by parties) p.cod) - (ra-evil %radio-no-party) + ?. (~(has by stories) p.cod) + (ra-evil %radio-no-story) =. +>.$ (ra-config p.cod *config) - - ra-ever(parties (~(del by parties) p.cod)) + ra-ever(stories (~(del by stories) p.cod)) =. +>.$ (ra-config p.cod u.q.cod) ra-ever :: @@ -151,31 +150,31 @@ %ping (ra-notice her +.cod) == :: - ++ ra-config :: configure party + ++ ra-config :: configure story |= [man=span con=config] ^+ +> - =+ :- neu=(~(has by parties) man) - pur=(fall (~(get by parties) man) *party) + =+ :- neu=(~(has by stories) man) + pur=(fall (~(get by stories) man) *story) =. +>.$ pa-abet:(~(pa-reform pa man pur) con) ?:(neu +>.$ ra-homes) :: ++ ra-friend :: %friend response |= [man=span sih=sign] ^+ +> - =+ pur=(~(get by parties) man) + =+ pur=(~(get by stories) man) ?~ pur ~& [%ra-friend-none man] +>.$ pa-abet:(~(pa-friend pa man u.pur) sih) :: ++ ra-stalk :: %stalk response |= [man=span tay=station sih=sign] ^+ +> - =+ pur=(~(get by parties) man) + =+ pur=(~(get by stories) man) ?~ pur ~& [%ra-stalk-none man] +>.$ pa-abet:(~(pa-stalk pa man u.pur) tay sih) :: ++ ra-timer :: timeout ^+ . - =+ paz=parties + =+ paz=stories |- ^+ +> ?~ paz +>.$ =. +>.$ $(paz l.paz) @@ -204,16 +203,16 @@ ++ ra-cancel :: drop a bone %_ . general (~(del in general) ost) - parties - |- ^- (map span party) - ?~ parties ~ - :- :- p.n.parties - %= q.n.parties - guests (~(del by guests.q.n.parties) ost) - viewers (~(del in viewers.q.n.parties) ost) - owners (~(del in owners.q.n.parties) ost) + stories + |- ^- (map span story) + ?~ stories ~ + :- :- p.n.stories + %= q.n.stories + guests (~(del by guests.q.n.stories) ost) + viewers (~(del in viewers.q.n.stories) ost) + owners (~(del in owners.q.n.stories) ost) == - [$(parties l.parties) $(parties r.parties)] + [$(stories l.stories) $(stories r.stories)] == :: ++ ra-subscribe :: listen to @@ -223,16 +222,16 @@ ?: ?=(~ pax) (ra-house(general (~(put in general) ost)) ost) ?: ?=([%am @ ~] pax) - =+ pur=(~(get by parties) i.t.pax) + =+ pur=(~(get by stories) i.t.pax) ?~ pur - ~& [%bad-subscribe-party-a i.t.pax parties] - (ra-evil %radio-no-party) + ~& [%bad-subscribe-story-a i.t.pax stories] + (ra-evil %radio-no-story) pa-abet:(~(pa-watch pa i.t.pax u.pur) her) ?: ?=([%xm @ ~] pax) - =+ pur=(~(get by parties) i.t.pax) + =+ pur=(~(get by stories) i.t.pax) ?~ pur - ~& [%bad-subscribe-party-b i.t.pax] - (ra-evil %radio-no-party) + ~& [%bad-subscribe-story-b i.t.pax] + (ra-evil %radio-no-story) pa-abet:(~(pa-master pa i.t.pax u.pur) her) ?. ?=([%fm *] pax) ~& [%bad-subscribe-a pax] @@ -240,10 +239,10 @@ ?. &(?=([@ *] t.pax) ((sane %tas) i.t.pax)) ~& [%bad-subscribe-b pax] (ra-evil %radio-bad-path) - =+ pur=(~(get by parties) i.t.pax) + =+ pur=(~(get by stories) i.t.pax) ?~ pur - ~& [%bad-subscribe-party-c i.t.pax] - (ra-evil %radio-no-party) + ~& [%bad-subscribe-story-c i.t.pax] + (ra-evil %radio-no-story) pa-abet:(~(pa-listen pa i.t.pax u.pur) her t.t.pax) :: ++ ra-think :: publish/review @@ -282,10 +281,10 @@ ?^ who [u.who folks] =+ who=`human`[~ `(scot %p her)] :: XX do right [who (~(put by folks) her who)] - =+ pur=(~(get by parties) man) + =+ pur=(~(get by stories) man) ?~ pur ~& [%bad-appear man] - (ra-evil %radio-no-party) + (ra-evil %radio-no-story) pa-abet:(~(pa-notify pa man u.pur) her per who) :: ++ ra-provoke :: forward presence @@ -319,12 +318,12 @@ !! == == :: - ++ ra-record :: add to party + ++ ra-record :: add to story |= [man=span gam=telegram] ^+ +> - =+ pur=(~(get by parties) man) + =+ pur=(~(get by stories) man) ?~ pur - ~& [%no-party man] + ~& [%no-story man] +>.$ pa-abet:(~(pa-learn pa man u.pur) gam) :: @@ -343,13 +342,13 @@ == +>(p.outbox +(p.outbox), q.outbox (~(put by q.outbox) p.outbox tip)) :: - ++ pa :: party core + ++ pa :: story core |_ $: man=span - party + story == ++ pa-abet ^+ +> - +>(parties (~(put by parties) man `party`+<+)) + +>(stories (~(put by stories) man `story`+<+)) :: ++ pa-admire :: accept from |= her=ship @@ -535,6 +534,7 @@ ?: =(`presence`p.q.i.dur `presence`p.u.fuy) loc ?- p.u.fuy + %gone (~(del by loc) p.i.dur q.i.dur) %talk loc %hear (~(put by loc) p.i.dur q.i.dur) == @@ -724,9 +724,10 @@ ++ prep |= old=(unit (unit house-any)) ^- [(list move) _+>] - :- [0 %pass /time %t %wait (add ~s10 lat.hid)]~ :: XX only on new? - |- ?> ?=(^ old) + :- ?^ u.old ~ + [0 %pass /time %t %wait (add ~s10 lat.hid)]~ + |- ?~ u.old =+ paf=/(scot %p our.hid)/try/(scot %da lat.hid)/radio/backlog/jam ?. ?=([%0 %0 %0] [.^(%cy paf)]) @@ -743,16 +744,16 @@ ++ house-0-to-house-1 |= vat=house-0 ^- house-1 - =- :* parties=- + =- :* stories=- general=~ outbox=[0 ~] sent=~ folks=~ == - ^- (map span party) + ^- (map span story) =- %- ~(run by -) |= grams=(list telegram) - ^- party + ^- story :* count=(lent grams) grams=grams locals=~ diff --git a/main/app/talk/core.hook b/main/app/talk/core.hook index f2c43d2a0..04d1dbe5a 100644 --- a/main/app/talk/core.hook +++ b/main/app/talk/core.hook @@ -3,44 +3,65 @@ :: /? 314 /- *radio +/+ radio :: :::: :: !: -[sed=!>(.) .] -=> |% - ++ house - $: live=(unit span) :: looking at - parties=(map span party) :: all parties - shown=(set serial) :: messages shown - targets=(unit (set station)) :: talking to - mode=presence :: interactive mode +=> |% :: structures + ++ town :: all client state + $: live=(unit span) :: present story + console=terminal :: controlling terminal + stories=(map span story) :: all stories == :: - ++ party :: local party - $: count=@ud :: number shown - shape=(unit config) :: configuration - present=(map ship status) :: presence + ++ grip :: subscription state + |* nub=$+(* *) :: wrapped state + $% [%cold ~] :: inactive + [%cool ~] :: active but empty + [%warm p=nub] :: connected + == :: + ++ terminal :: terminal state + $: present=presence :: presence state == :: - ++ work :: user action - $% [%all p=mess] :: say - [%back p=?(%da %dr %ud) q=@] :: backlog - [%def p=mess] :: default - [%how ~] :: help - [%join p=station] :: subscribe /=main to - [%host p=span] :: create /=foo - [%priv p=(list station) q=mess] :: private - [%who ~] :: who + ++ story :: persona + $: link=bridge :: connection + count=@ud :: message counter + mike=(pair ,? (set station)) :: active/voice + quiet=? :: !verbose + past=(list station) :: past received auds + == :: + ++ bridge :: subscriptions + $: fm=(grip ,~) :: content grip + xm=(grip config) :: config grip + am=(grip register) :: presence grip + :: rb=(grip ,~) :: rollback grip + == :: + ++ work :: general action + $% [%ask (unit work)] :: help (about) + [%exp twig] :: compute + [%mor (list work)] :: sequence + [%rub work-adjust] :: configure story + [%say speech] :: publish in voice + [%wry work-construct] :: configure system + [%who (unit station)] :: show presence + == :: + ++ work-adjust :: adjust story + $% [%dark p=(set ship)] :: toggle blacklist + [%lite p=(set ship)] :: toggle whitelist + [%love p=(set station)] :: toggle stations + [%whom p=? q=(set station)] :: active/voice + [%wind p=@dr] :: rewind by date + == :: + ++ work-construct :: configure system + $% [%make p=span] :: create story + [%raze p=span] :: destroy story + [%tune p=span] :: switch to story == :: ++ iron :: terminal output $% [%prompt p=cord q=prom r=cord] :: prompt [%tang p=(list tank)] :: prettyprintable [%txt p=cord] :: simple text == - ++ mess - $% [%own p=@t] - [%exp p=@t q=(unit tank)] - [%say p=@t] - == ++ gift $% [%mean ares] [%nice ~] @@ -55,397 +76,403 @@ [%nuke p=hapt q=ship] [%show p=hapt q=ship r=path] == == - $: %t :: - $% [%wait p=@da] :: - == == == :: - ++ sign - $? $: %g + $: %t + $% [%wait p=@da] + == == == + ++ gall-sign :: subscription result $% [%mean p=ares] [%nice ~] $: %rush $= p - $% [%txt p=cord] - [%type p=?] + $% [%txt p=cord] :: input text + [%type p=?] :: typing notify == == $: %rust $= p $% [%txt p=cord] [%radio-report p=report] == == - == == - $: %t :: + == + ++ sign + $? [%g gall-sign] :: from %gall + $: %t :: from %time $% [%wake ~] :: timer wakeup == == == -- !: :::: :: -=| [our=@p lat=@da] -|% -++ talk - =< - %+ cook |=(a=work a) - ;~ pose - (cold [%how ~] wut) - (cold [%who ~] tis) - (stag %back dat) - (stag %priv target) - (stag %all ;~(pfix pam mess)) - (comd %join stati) - (comd %host urs:ab) - (stag %def mess) - == - |% - ++ posh - |* [a=_rule b=_rule] - ;~(pose (stag %& a) (stag %| b)) - :: - ++ peach :: either ++each branch - |* a=_[rule rule] - |= tub=nail - ^- (like (each ,_(wonk (-.a)) ,_(wonk (+.a)))) - %. tub - ;~(pose (stag %& -.a) (stag %| +.a)) - :: - ++ comd :: ! command - |* [a=@tas b=_rule] - %- full - ;~((glue (plus ace)) ;~(pfix zap (cold a (jest a))) b) - :: - :: - ++ dat - %+ sear - |= p=coin - ?. ?=([%$ ?(%da %dr %ud) @] p) ~ - (some +.p) - ;~(pfix bas bas (star ace) nuck:so) - :: - ++ expn - %- sear - :_ text - |= a=@t - ^- (unit ,[p=@t q=(unit tank)]) - =+ hun=(rush a wide:(vang | [&1:% &2:% (scot %da lat) |3:%])) - ?~ hun ~ - ?~(a ~ [~ a ~ (sell (slap sed u.hun))]) - :: - ++ mess - ^- $+(nail (like ^mess)) - ;~ pose - (stag %own ;~(pfix pat text)) - (stag %exp ;~(pfix hax expn)) - (stag %own (full (easy ''))) - (stag %say text) - == - :: - ++ target - ^- $+(nail (like ,[p=(list station) q=^mess])) - ;~ plug - (most ;~(plug com ace) stati) - ;~(pfix ace mess) - == - :: - ++ text (boss 256 (star prn)) - ++ stati - %+ peach - ;~ pose - ;~(pfix tis (stag our urs:ab)) - ;~ pfix sig +=> |% + ++ swatch :: print station set + |= tou=(set station) + =+ tuo=(~(tap in tou)) + |- ^- tape + ?~ tuo ~ + =+ ted=$(tuo t.tuo) + =+ ^= ind ^- tape + ?- -.i.tuo + %& =+ sip=(scow %p p.p.i.tuo) + ?: =(%floor q.p.i.tuo) + sip + (weld sip (trip q.p.i.tuo)) + %| ['^' '@' (trip p.p.i.tuo)] + == + ?~ ted ind + (welp ind `tape`[',' ' ' ted]) + :: + ++ parse :: command parser + =+ vag=(vang | [&1:% &2:% '0' |3:%]) + |% + ++ come :: keyword command + |* [a=@tas b=_rule] + ;~((glue (plus ace)) (cold a (jest a)) b) + :: + ++ gone :: parse unit + |* a=_rule + ;~(pose (stag ~ a) (easy ~)) + :: + ++ posh :: parse each + |* [a=_rule b=_rule] + ;~(pose (stag %& a) (stag %| b)) + :: + ++ ship ;~(pfix sig fed:ag) :: ship + ++ shiz :: ship set + %+ cook + |=(a=(list ^ship) (~(gas in *(set ^ship)) a)) + (most ;~(plug com (star ace)) ship) + :: + ++ stat :: station + %+ posh ;~ plug - fed:ag - ;~(pose ;~(pfix fas urs:ab) (easy %main)) + ship + ;~(pose ;~(pfix fas urs:ab) (easy %floor)) + == + ;~ pfix ket + ;~ pose + ;~(pfix pat (stag %twitter urs:ab)) == == - == - ;~(pfix fas (stag %twitter ;~(pfix ;~(plug (just 'twitter') fas) urs:ab))) - -- --- + :: + ++ staz :: station set + %+ cook + |=(a=(list station) (~(gas in *(set station)) a)) + (most ;~(plug com (star ace)) stat) + :: + ++ step :: rollback interval + %+ sear + |= a=coin + ?. ?=([%$ %dr @] a) ~ + (some `@dr`+>.a) + nuck:so + :: + ++ text (boss 256 (star prn)) :: utf8 text + ++ tome + %+ stag %lin + ;~ pose + (stag %| ;~(pfix pat text)) + (stag %& text) + == + :: + ++ work :: all commands + %+ knee *^work |. ~+ + ;~ pose + ;~ pfix zap + %+ stag %wry + ;~ pose + (come %make urs:ab) + (come %raze urs:ab) + (come %tune urs:ab) + == + == + :: + ;~ pfix cen + %+ stag %rub + ;~ pose + (come %dark shiz) + (come %lite shiz) + (come %whom (stag %& staz)) + (come %wind step) + == + == + :: + ;~(pfix wut (stag %ask (gone work))) + ;~(pfix tis (stag %who (gone stat))) + ;~(pfix cen (stag %exp wide:vag)) + :: + %+ cook + |= [a=(set station) b=(unit ,[%lin p=? q=@t])] + ^- ^work + =. b ?~(b ~ ?:(=(0 q.u.b) ~ b)) + =+ c=[%rub %whom %& a] + ?~(b c [%mor c [%say u.b] ~]) + ;~ plug + staz + (gone ;~(pfix (star ace) tome)) + == + :: + (stag %say tome) + == + -- + ++ stog :: toggle set + |* [tog=(set) tag=(set)] + =+ got=(~(tap in tog)) + |- ^+ tag + ?~ got tag + %= $ + got t.got + tag ?: (~(has in tag) i.got) + (~(del in tag) i.got) + (~(put in tag) i.got) + == + -- !: :::: :: -|_ [hid=hide house] +|_ [hid=hide town] +++ transmit :: radio command + |= [cod=command moz=(list move)] + ^- (list move) + :_ moz + :* 0 %pass /command + %g %mess [our.hid /radio] our.hid + [%radio-command !>(cod)] + == :: -++ destination - ^- audience - =- =+ ped=(~(tap in ted) ~) - %- ~(gas by *audience) - (turn ped |=(a=station [a %pending])) - ^= ted ^- (set station) - ?^ targets u.targets +++ subscribe :: radio show + |= [way=path hoc=path moz=(list move)] + ^- (list move) + :_(moz [0 %pass way %g %show [our.hid /radio] our.hid hoc]) +:: +++ unsubscribe :: radio nuke + |= [way=path moz=(list move)] + ^- (list move) + :_(moz [0 %pass way %g %nuke [our.hid /radio] our.hid]) +:: +++ render :: send to console + |= [rod=iron moz=(list move)] + =+ oss=(~(tap in (~(get ju pus.hid) /out))) + |- ^- (list move) + ?~ oss moz + [`move`[i.oss %give %rush rod] $(oss t.oss)] +:: +++ display :: print to console + |= [tay=(list tank) moz=(list move)] + (render [%tang tay] moz) +:: +++ show :: simple show + |= [tep=tape moz=(list move)] + (display [%leaf tep]~ moz) +:: +++ accept :: set prompt + |= [asq=cord moz=(list move)] + (render [%prompt asq %text ''] moz) +:: +++ sy + |_ $: $: man=span :: u.live + moz=(list move) :: pending moves + == :: + story :: current story + == + :: + ++ sy-abet :: resolve core + ^- [(list move) town] + [moz +>+<+(stories (~(put by stories) man +<+))] + :: + ++ sy-start :: start subscriptions + sy-subscribe-fm:sy-subscribe-am:sy-subscribe-xm + :: + ++ sy-stop :: stop subscriptions + sy-unsubscribe-fm:sy-unsubscribe-am:sy-unsubscribe-xm + :: + ++ sy-subscribe-am :: presence subscribe + ?> =(%cold -.am.link) + %_ . + am.link [%cool ~] + moz (subscribe /am/[man] /am/[man] moz) + == + :: + ++ sy-subscribe-xm :: config subscribe + ?> =(%cold -.xm.link) + %_ . + xm.link [%cool ~] + moz (subscribe /xm/[man] /xm/[man] moz) + == + :: + ++ sy-subscribe-fm :: content subscribe + ?> =(%cold -.fm.link) + %_ . + fm.link [%cool ~] + moz (subscribe /fm/[man] /fm/[man]/(scot %ud count) moz) + == + :: + ++ sy-unsubscribe-am :: presence unsub + ?: =(%cold -.am.link) . + %_ . + am.link [%cold ~] + moz (unsubscribe /am/[man] moz) + == + :: + ++ sy-unsubscribe-xm :: config unsubs + ?: =(%cold -.xm.link) . + %_ . + xm.link [%cold ~] + moz (unsubscribe /fm/[man] moz) + == + :: + ++ sy-unsubscribe-fm :: content unsub + ?: =(%cold -.fm.link) . + %_ . + fm.link [%cold ~] + moz (unsubscribe /fm/[man] moz) + == + :: + ++ sy-serial :: make serial no + ^- [serial _.] + [(shaf %serial eny.hid) .(eny.hid (shax eny.hid))] + :: + ++ sy-audience :: speech audience + %- ~(gas by *audience) + %+ turn `(list station)`[[%& our.hid man] (~(tap in q.mike))] + |=(a=station [a %pending]) + :: + ++ sy-message :: print message + |= msg=tape + %_(+> moz (display [%leaf "{(trip man)}: {msg}"]~ moz)) + :: + ++ sy-cordon :: set cordon + |= con=(each (set ship) (set ship)) + ^+ +> + ?. ?=(%warm -.xm.link) (sy-message "not connected") + =. cordon.p.xm.link + ?- -.cordon.p.xm.link + %& ?- -.con + %& [%& (stog p.con p.cordon.p.xm.link)] + %| con + == + %| ?- -.con + %& con + %| [%| (stog p.con p.cordon.p.xm.link)] + == + == + +>.$(moz (transmit [%design man ~ p.xm.link] moz)) + :: + ++ sy-sources :: set sources + |= src=(set station) + ^+ +> + ?. ?=(%warm -.xm.link) (sy-message "not connected") + =. sources.p.xm.link (stog src sources.p.xm.link) + +>.$(moz (transmit [%design man ~ p.xm.link] moz)) + :: + ++ sy-voice :: set targets + |= [act=? tou=(set station)] + %_(+> mike [act tou], moz (accept (crip (swatch tou)) moz)) + :: + ++ sy-rollback + |= lon=@dr + !! + :: + ++ sy-work + |= job=work + ^+ +> + ?- -.job + %ask !! + %exp !! + %mor + |- ^+ +>.^$ + ?~ +.job +>.^$ + $(+.job t.+.job, +>.^$ ^$(job i.+.job)) + :: + %rub + ?- +<.job + %lite (sy-cordon [%| +>.job]) + %dark (sy-cordon [%& +>.job]) + %love (sy-sources +>.job) + %whom (sy-voice +>.job) + %wind !! + == + %say + =^ sir +>.$ sy-serial + +>.$(moz (transmit [%publish [[sir sy-audience [lat.hid +.job]] ~]] moz)) + :: + %wry !! + %who !! + == + -- +++ ny :: top configuration + |_ moz=(list move) + ++ ny-abet :: resolve core + ^- [(list move) town] + [moz +>+<+] + :: + ++ ny-amid :: integrate story + |= nov=_sy + =^ zom +>+>+<+ sy-abet:nov + +>.$(moz zom) + :: + ++ ny-tune :: connect to story + |= man=span + ^+ +> + ?: =(`man live) + +>(moz (show "already tuned to {(trip man)}" moz)) + ?. (~(has by stories) man) + +>(moz (show "no story {(trip man)}" moz)) + =. +> ny-stop + =. live `man + ~& [%tune-start man] + (ny-amid sy-start:(need (novel moz))) + :: + ++ ny-stop :: disconnect story + ^+ . + ?~ live . + (ny-amid(live ~) sy-stop:(need (novel moz))) + :: + ++ ny-tell :: hear from server + |= sap=(set span) + ^+ +> + =. +> ?.(&(?=(^ live) !(~(has in sap) u.live)) +> ny-stop) + =. stories + =+ ros=(skim (~(tap by stories)) |=([a=span *] (~(has in sap) a))) + =+ pas=(~(tap in sap)) + %- ~(gas by *(map span story)) + |- ^- (list (pair span story)) + ?~ pas ros + =+ sor=$(pas t.pas) + ?:((~(has by stories) i.pas) sor [[i.pas *story] sor]) + ?^ live +>.$ + ?~ stories +>.$ + ?: (~(has by `(map span story)`stories) %floor) + (ny-tune %floor) + (ny-tune p.n.stories) + :: + ++ ny-work :: user command + |= jaw=work-construct + ^+ +> + ?- -.jaw + %raze +>(moz (transmit [%design p.jaw ~] moz)) + %make +>(moz (transmit [%design p.jaw [~ ~ %| ~]] moz)) + %tune (ny-tune p.jaw) + == + -- +:: +++ novel :: live story + |= moz=(list move) + ^- (unit ,_sy) ?~ live ~ - =+ pur=(~(get by parties) u.live) - ?~ pur ~ - ?~ shape.u.pur ~ - sources.u.shape.u.pur -:: -++ presentation - ^- (map station presence) - (~(run by destination) |=(a=* mode)) -:: -++ visible - ^- (map ship status) - ?~ live ~ - =+ pur=(~(get by parties) u.live) - ?~ pur ~ - present.u.pur + `~(. sy [u.live moz] (~(got by stories) u.live)) :: ++ pour-shell - |= [ost=bone txt=cord] + |= txt=cord ^- [(list move) _+>] - ?: =(0 txt) [~ +>.$] - =+ rey=(rush txt talk(lat lat.hid, our our.hid)) - ?~ rey - [(send /out %give %rush %tang [%leaf "invalid input"] ~) +>.$] - ~& [%rey rey] - |- ^- [(list move) _+>.^$] - ?- -.u.rey - %priv $(targets `(sa p.u.rey), u.rey [%def q.u.rey]) - %all $(targets ~, u.rey [%def p.u.rey]) - %who - :_ +>.^$ - %^ send /out %give :+ %rush %tang :_ ~ - :+ %rose [", " "" ""] - %+ turn (~(tap by visible) ~) - |= [a=ship b=status] - [%leaf (scow %p a)] - :: - %def - :: ?> ?=(?([%own %exp %say] -.p.u.rey) - ?~ live - ~& %not-live - !! - =+ aud=destination - ?~ aud - =+ txt="no audience; try !join {(scow %p (sein our.hid))}/hub" - [`(list move)`(send /out %give %rush %tang [%leaf txt] ~) +>.^$] - =- [[(send-radio ost [%publish - ~]) ~] +>.^$] - ^- thought - [(shaf %foo eny.hid) aud [lat.hid p.u.rey]] - :: - %host - [[(send-radio ost [%design p.u.rey ~ `config`[~ [%| ~]]]) ~] +>.^$] - :: - %join - ?~ live - ~& %not-live - !! - =+ par=(~(got by parties) u.live) - ?~ shape.par - ~& %not-configured - !! - =. sources.u.shape.par (~(put in sources.u.shape.par) p.u.rey) - [[(send-radio ost [%design u.live `u.shape.par]) ~] +>.^$] - :: - %how - :_ +>.^$ - %^ send /out %give :+ %rust %tang - %- flop - %- turn :_ |=(a=@t [%leaf (trip a)]) - %- lore - %- (hard ,@t) - .^(/cx/(scot %p our.hid)/main/(scot %da lat.hid)/pub/src/doc/chat/help/txt) - :: - %back - ?~ live - ~& %not-live - !! - =+ ^= sin - ?- p.u.rey - %ud [%ud q.u.rey] - %da [%da q.u.rey] - %dr [%da (sub lat.hid q.u.rey)] - == - :_ +>.^$ - :_ ~ - :* ost %pass /fm/backlog - %g %show - [our.hid /radio] our.hid - /fm/[u.live]/(scot sin)/(scot %da lat.hid) - == - == -:: -++ pour-attach :: attach to party - |= [man=span moz=(list move)] - ^- (list move) - ~& [%pour-attach man] - :* :* 0 %pass /fm/[man] - %g %show - [our.hid /radio] our.hid - /fm/[man] - == - (welp (send /out %give %rush %prompt prompt %text '') moz) - == -:: -++ pour-detach :: detach from party - |= [man=span moz=(list move)] - ^- (list move) - ~& [%pour-detach man] - :_ moz - :* 0 %pass /fm/[man] - %g %nuke - [our.hid /radio] our.hid - == -:: -++ pour-live - |= moz=(list move) - ^+ [moz +>] - ?~ live - ?: (~(has by parties) %main) - => .(live `%main) - [(pour-attach %main moz) +>.$] - ?~ parties - [moz +>] - => .(live `p.n.parties) - ~& [%pour-live p.n.parties] - [(pour-attach p.n.parties moz) +>.$] - ?: (~(has by parties) u.live) - [moz +>] - ~& %pour-detach - $(live ~, moz (pour-detach u.live moz)) -:: -++ pour-house - |= [ost=bone wha=(set span)] - ^- [(list move) _+>] - =+ lug=`(list span)`(~(tap in wha) ~) - =+ yap=`(list (pair span party))`(~(tap by parties) ~) - =+ nup=(skip lug |=(a=span (~(has by parties) a))) - =+ pig=(skip yap |=([a=span *] (~(has in wha) a))) - =. parties - |- ^+ parties - ?~ pig parties - $(pig t.pig, parties (~(del by parties) p.i.pig)) - =. parties - |- ^+ parties - ?~ nup parties - $(nup t.nup, parties (~(put by parties) i.nup *party)) - %- pour-live - ^- (list move) - %+ welp - ^- (list move) - %- zing - %+ turn nup - |= man=span - ^- (list move) - ~& [%new-party man] - :~ :* 0 %pass /am/[man] - %g %show - [our.hid /radio] our.hid - /am/[man] - == - :* 0 %pass /xm/[man] - %g %show - [our.hid /radio] our.hid - /xm/[man] - == - == - ^- (list move) - %- zing - %+ turn pig - |= [man=span *] - ^- (list move) - ~& [%old-party man] - :~ :* 0 %pass /am/[man] - %g %nuke - [our.hid /radio] our.hid - == - :* 0 %pass /xm/[man] - %g %nuke - [our.hid /radio] our.hid - == - == -:: -++ pour-grams - |= [ost=bone man=span raq=(pair ,@ud (list telegram))] - ^- [(list move) _+>] - :_ +>.$ - %- zing ^- (list (list move)) - %+ turn - `(list telegram)`q.raq - |= gam=telegram - %^ send /out %give :- %rush - =* sta r.q.gam - ?- -.q.sta - %say [%txt (rap 3 (scot %p p.gam) ': ' p.q.sta ~)] - %own [%txt (rap 3 (scot %p p.gam) ' ' p.q.sta ~)] - %inv !! - %exp - :- %tang :_ ~ - :~ %rose - [" " "" ""] - [%leaf "{} {(trip p.q.sta)}"] - (need q.q.sta) - == - == -:: -++ pour-config - |= [ost=bone man=span cof=config] - ^- [(list move) _+>] - =+ pur=(~(get by parties) man) - ?~ pur - ~& [%no-party man] - [~ +>.$] - [~ +>.$(parties (~(put by parties) man u.pur(shape `cof)))] -:: -++ pour-group - |= [ost=bone man=span reg=(pair atlas (map station atlas))] - ^- [(list move) _+>] - =+ pur=(~(get by parties) man) - ?~ pur - ~& [%no-party man] - [~ +>.$] - =+ ^= buk - =+ mer=(turn (~(tap by q.reg) ~) |=([* a=atlas] a)) - |- ^- atlas - ?~ mer p.reg - =. p.reg $(mer t.mer) - =+ dur=`(list (pair ship status))`(~(tap by i.mer) ~) - |- ^- atlas - ?~ dur p.reg - =. p.reg $(dur t.dur) - =+ fuy=(~(get by p.reg) p.i.dur) - ?~ fuy (~(put by p.reg) p.i.dur q.i.dur) - ?: =(`presence`p.q.i.dur `presence`p.u.fuy) - p.reg - ?- p.u.fuy - %talk p.reg - %hear (~(put by p.reg) p.i.dur q.i.dur) - == - [~ +>.$(parties (~(put by parties) man u.pur(present buk)))] -:: -++ prompt - ^- cord - ?~ live - 'waiting...' - ?~ targets - ?: =(%main u.live) - '& ' - (cat 3 u.live '& ') - =+ taz=(~(tap by u.targets) ~) - |- ^- cord - ?~ taz ' ' - %^ cat 3 '+' - %^ cat 3 - ?- -.i.taz - %& (cat 3 (scot %p p.p.i.taz) (cat 3 '/' q.p.i.taz)) - %| (cat 3 '/' (cat 3 %twitter (cat 3 '/' p.p.i.taz))) - == - $(taz t.taz) -:: -++ present - ^- (list move) - =+ taz=presentation - ?~ taz - ~ - [(send-radio 0 %ping taz) ~] -:: -++ peer - |= [ost=bone you=ship pax=path] - ^- [(list move) _+>] - :_ +>.$ - ?~ pax !! - ?+ i.pax !! - %out [ost %give %rust %prompt prompt %text '']~ - == + =+ jub=(rush txt work:parse) + ?~ jub + [(display [%leaf "invalid input"]~ ~) +>.$] + ?: ?=(%wry -.u.jub) + =^ moz +<+.+>.$ ny-abet:(ny-work:ny +.u.jub) + [moz +>.$] + =+ nuv=(novel ~) + ?~ nuv [(display [%leaf "not tuned to any story"]~ ~) +>.$] + =^ moz +<+.+>.$ sy-abet:(sy-work:u.nuv u.jub) + [moz +>.$] :: ++ pour |= [ost=bone pax=path sih=*] @@ -455,75 +482,24 @@ ?~ pax ~& talk-pour-strange-path/pax !! ?+ i.pax ~& talk-pour-strange-path/pax !! %cmd-in - ?+ +<.sih !! - %nice [~ +>.$] - %mean [(send /out %give +.sih) +>.$] - ?(%rush %rust) - ?> ?=(%txt -.p.sih) - (pour-shell ost p.p.sih) + ?+ +<.sih !! + %nice [~ +>.$] + %mean ~&(%talk-input-crash !!) + ?(%rush %rust) + ?> ?=(%txt -.p.sih) + (pour-shell p.p.sih) == - :: - %time - :_ +>.$ - :* [0 %pass /time %t %wait (add ~s10 lat.hid)] - present - == - :: - %cmd-ac - ?+ +<.sih !! - %nice [~ +>.$] - %mean ~&(%cmd-ac-mean [~ +>.$]) - ?(%rush %rust) - ?> ?=(%type -.p.sih) - =+ dom=`presence`?:(p.p.sih %talk %hear) - ?: =(dom mode) - [~ +>.$] - :: ~& [%cmd-ac-mode dom] - =. mode dom - [present +>.$] - == - :: - %command - ?> ?=(?(%mean %nice) +<.sih) - [~ +>.$] :: %server - ?+ &2.sih !! - %nice [~ +>.$] - %mean ~&(%server-mean [~ +>.$]) - %rust - ?> ?=([%radio-report %house *] +>.sih) - (pour-house ost `(set span)`+>.+>.sih) - == + ?+ +<.sih !! + %nice [~ +>.$] + %mean ~&(%talk-server-crash !!) + ?(%rush %rust) + ?> ?=([%radio-report %house *] p.sih) + =^ moz +>+<+ ny-abet:(ny-tell:ny +.p.p.sih) + [moz +>.$] :: - %am - ?> ?=([@ *] t.pax) - ?+ &2.sih !! - %nice [~ +>.$] - %mean ~&(%am-mean [~ +>.$]) - %rust - ?> ?=([%radio-report %group *] +>.sih) - (pour-group ost i.t.pax +>.+>.sih) - == - :: - %xm - ?> ?=([@ *] t.pax) - ?+ &2.sih !! - %nice [~ +>.$] - %mean ~&(%xm-mean [~ +>.$]) - %rust - ?> ?=([%radio-report %config *] +>.sih) - (pour-config ost i.t.pax `config`+>.+>.sih) - == - :: - %fm - ?> ?=([@ *] t.pax) - ?+ &2.sih !! - %nice [~ +>.$] - %mean ~&(%fm-mean [~ +>.$]) - %rust - ?> ?=([%radio-report %grams *] +>.sih) - (pour-grams ost i.t.pax `(pair ,@ud (list telegram))`+>.+>.sih) + % == == :: @@ -531,29 +507,14 @@ |= [ost=bone you=ship arg=~] ^- [(list move) _+>] :_ +> - :~ [ost %pass /cmd-in %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]] + :~ [0 %pass /cmd-in %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]] [0 %pass /time %t %wait (add ~s10 lat.hid)] - [ost %pass /cmd-ac %g %show [our.hid +.imp.hid] you /active/[-.imp.hid]] + [0 %pass /cmd-ac %g %show [our.hid +.imp.hid] you /active/[-.imp.hid]] ^- move - :* ost %pass /server + :* 0 %pass /server %g %show [our.hid /radio] our.hid / == == -:: -++ send - |= [pax=path msg=(mold note gift)] - ^- (list move) - :: ~& [%send pus.hid] - %+ turn (~(tap in (~(get ju pus.hid) pax))) - |=(ost=bone [ost msg]) -:: -++ send-radio - |= [ost=bone cod=command] - ^- move - :* ost %pass /command - %g %mess [our.hid /radio] our.hid - [%radio-command !>(cod)] - == -- diff --git a/main/sur/radio/core.hook b/main/sur/radio/core.hook index f2ae5b5d5..024948be5 100644 --- a/main/sur/radio/core.hook +++ b/main/sur/radio/core.hook @@ -15,7 +15,13 @@ cordon=(each (set ship) (set ship)) :: white/blacklist == :: ++ cousin (pair ship span) :: domestic flow -++ delivery ?(%pending %received %rejected %released) :: delivery state +++ delivery :: delivery state + $? %pending :: undelivered + %received :: delivered + %rejected :: undeliverable + %released :: sent one-way + %accepted :: fully processed + == :: ++ human :: human identifier $: true=(unit (trel ,@t (unit ,@t) ,@t)) :: true name hand=(unit ,@t) :: handle @@ -23,22 +29,29 @@ ++ partner :: foreign flow $% [%twitter p=@t] :: twitter == :: -++ presence ?(%hear %talk) :: status type +++ presence ?(%gone %hear %talk) :: status type +++ register (pair atlas (map station atlas)) :: ping me, ping srcs ++ report :: unified rush/rust $% [%house (set span)] :: meta-changes - [%grams (pair ,@ud (list telegram))] :: thoughts - [%group (pair atlas (map station atlas))] :: presence + [%grams (pair ,@ud (list telegram))] :: beginning, thoughts + [%group register] :: presence [%config config] :: reconfigure == :: +++ speech :: narrative action + :: XX unify %own and %say to %lin + :: + $% [%own p=@t] :: XX @ or /me + [%exp p=@t q=(unit tank)] :: program output + [%ext p=@tas q=*] :: extended action + [%inv p=station] :: invite station + [%irt p=serial q=speech] :: in-reply-to + [%lin p=? q=@t] :: no=@, text line + [%mor p=(list speech)] :: multi-line etc + [%say p=@t] :: XX normal line + == :: ++ serial ,@uvH :: unique identity ++ station (each cousin partner) :: interlocutor ++ status (pair presence human) :: participant -++ speech :: party action - $% [%own p=@t] :: @ or /me - [%exp p=@t q=(unit tank)] :: program output - [%say p=@t] :: normal line - [%inv p=ship q=span] :: invite to - == :: ++ statement (pair ,@da speech) :: when this ++ telegram (pair ship thought) :: who which whom what ++ thought (trel serial audience statement) :: which whom what From 3713e95d7c9b7af8143c1bfc3411c3bca641373c Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Sat, 3 Jan 2015 22:24:48 -0800 Subject: [PATCH 02/13] Various fixes and improvements. --- arvo/hoon.hoon | 1 + main/app/radio/core.hook | 19 +-- main/app/talk/core.hook | 331 ++++++++++++++++++++++++++------------- main/sur/radio/core.hook | 4 +- 4 files changed, 229 insertions(+), 126 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index d558f1840..0f4c05532 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -25,6 +25,7 @@ ~ |% :: ++ abel typo :: original sin: type +++ ache |*([a=$+(* *) b=$+(* *)] $%([| p=b] [& p=a])) :: each, b default ++ axis ,@ :: tree address ++ also ,[p=term q=wing r=type] :: alias ++ base ?([%atom p=odor] %noun %cell %bean %null) :: axils, @ * ^ ? ~ diff --git a/main/app/radio/core.hook b/main/app/radio/core.hook index 20ca241e4..51e772424 100644 --- a/main/app/radio/core.hook +++ b/main/app/radio/core.hook @@ -3,6 +3,7 @@ :: /? 314 /- *radio +/+ radio :: :::: :: @@ -222,17 +223,9 @@ ?: ?=(~ pax) (ra-house(general (~(put in general) ost)) ost) ?: ?=([%am @ ~] pax) - =+ pur=(~(get by stories) i.t.pax) - ?~ pur - ~& [%bad-subscribe-story-a i.t.pax stories] - (ra-evil %radio-no-story) - pa-abet:(~(pa-watch pa i.t.pax u.pur) her) + +> ?: ?=([%xm @ ~] pax) - =+ pur=(~(get by stories) i.t.pax) - ?~ pur - ~& [%bad-subscribe-story-b i.t.pax] - (ra-evil %radio-no-story) - pa-abet:(~(pa-master pa i.t.pax u.pur) her) + +> ?. ?=([%fm *] pax) ~& [%bad-subscribe-a pax] (ra-evil %radio-bad-path) @@ -486,8 +479,6 @@ %& :: ~& [%pa-acquire [our.hid man] [p.p.tay q.p.tay]] :~ :- /friend/show/[man] [%g %show [p.p.tay /radio] our.hid /fm/[q.p.tay]/(scot %ud num)] - :- /stalk/show/[man]/(scot %p p.p.tay)/[q.p.tay] - [%g %show [p.p.tay /radio] our.hid /am/[q.p.tay]] == == :: @@ -571,6 +562,8 @@ ++ pa-listen :: subscribe |= [her=ship pax=path] ^+ +> + =. +> (pa-watch her) + =. +> (pa-master her) ?. (pa-admire her) (pa-sauce ost [[%mean ~ %radio-listen-unauthorized ~] ~]) =+ ^= ruv ^- (unit river) @@ -733,7 +726,7 @@ ?. ?=([%0 %0 %0] [.^(%cy paf)]) $(u.old (some ((hard house-any) (cue ((hard ,@) .^(%cx paf)))))) :: ~& %radio-prep-new - +:ra-abet:(~(ra-apply ra 0 ~) our.hid %design %main `[~ [%| ~]]) + +:ra-abet:(~(ra-apply ra 0 ~) our.hid %design (main our.hid) `[~ [%| ~]]) :: ~& %radio-prep-old |- ?- -.u.u.old diff --git a/main/app/talk/core.hook b/main/app/talk/core.hook index 04d1dbe5a..a4e450864 100644 --- a/main/app/talk/core.hook +++ b/main/app/talk/core.hook @@ -16,25 +16,24 @@ == :: ++ grip :: subscription state |* nub=$+(* *) :: wrapped state - $% [%cold ~] :: inactive - [%cool ~] :: active but empty - [%warm p=nub] :: connected - == :: + $| $? %warm :: activated + %cool :: activating + %dead :: inoperative + %cold :: inactive + == [%live p=nub] :: operating ++ terminal :: terminal state $: present=presence :: presence state == :: ++ story :: persona - $: link=bridge :: connection + $: link=(grip bridge) :: connection count=@ud :: message counter mike=(pair ,? (set station)) :: active/voice quiet=? :: !verbose past=(list station) :: past received auds == :: - ++ bridge :: subscriptions - $: fm=(grip ,~) :: content grip - xm=(grip config) :: config grip - am=(grip register) :: presence grip - :: rb=(grip ,~) :: rollback grip + ++ bridge :: remote state + $: xm=config :: configuration + am=register :: presence == :: ++ work :: general action $% [%ask (unit work)] :: help (about) @@ -42,8 +41,8 @@ [%mor (list work)] :: sequence [%rub work-adjust] :: configure story [%say speech] :: publish in voice - [%wry work-construct] :: configure system [%who (unit station)] :: show presence + [%wry work-construct] :: configure system == :: ++ work-adjust :: adjust story $% [%dark p=(set ship)] :: toggle blacklist @@ -104,7 +103,7 @@ :: => |% ++ swatch :: print station set - |= tou=(set station) + |= [our=ship tou=(set station)] =+ tuo=(~(tap in tou)) |- ^- tape ?~ tuo ~ @@ -112,15 +111,16 @@ =+ ^= ind ^- tape ?- -.i.tuo %& =+ sip=(scow %p p.p.i.tuo) - ?: =(%floor q.p.i.tuo) + ?: =((main our) q.p.i.tuo) sip - (weld sip (trip q.p.i.tuo)) + (welp sip (trip q.p.i.tuo)) %| ['^' '@' (trip p.p.i.tuo)] == ?~ ted ind (welp ind `tape`[',' ' ' ted]) :: ++ parse :: command parser + |= our=ship =+ vag=(vang | [&1:% &2:% '0' |3:%]) |% ++ come :: keyword command @@ -145,7 +145,7 @@ %+ posh ;~ plug ship - ;~(pose ;~(pfix fas urs:ab) (easy %floor)) + ;~(pose ;~(pfix fas urs:ab) (easy (main our))) == ;~ pfix ket ;~ pose @@ -275,55 +275,35 @@ == :: ++ sy-abet :: resolve core - ^- [(list move) town] - [moz +>+<+(stories (~(put by stories) man +<+))] + ^- [(list move) _+>] + [(flop moz) +>(stories (~(put by stories) man +<+))] :: - ++ sy-start :: start subscriptions - sy-subscribe-fm:sy-subscribe-am:sy-subscribe-xm - :: - ++ sy-stop :: stop subscriptions - sy-unsubscribe-fm:sy-unsubscribe-am:sy-unsubscribe-xm - :: - ++ sy-subscribe-am :: presence subscribe - ?> =(%cold -.am.link) + ++ sy-subscribe :: story subscribe + ~& [%subscribe-link link] + ?> =(%cold -.link) %_ . - am.link [%cool ~] - moz (subscribe /am/[man] /am/[man] moz) + link %cool + moz ^- (list move) + :: %^ subscribe /xm/[man] /xm/[man] + :: %^ subscribe /am/[man] /am/[man] + %^ subscribe /fm/[man] + :~ %fm + man + ?: =(0 count) + ~& [%story-init man `@da`(sub lat.hid ~d1)] + (scot %da (sub lat.hid ~d1)) + (scot %ud count) + == + ~ == :: - ++ sy-subscribe-xm :: config subscribe - ?> =(%cold -.xm.link) + ++ sy-unsubscribe :: story unsubscribe + ?: =(& ?=(?(%cold %dead) -.link)) . %_ . - xm.link [%cool ~] - moz (subscribe /xm/[man] /xm/[man] moz) - == - :: - ++ sy-subscribe-fm :: content subscribe - ?> =(%cold -.fm.link) - %_ . - fm.link [%cool ~] - moz (subscribe /fm/[man] /fm/[man]/(scot %ud count) moz) - == - :: - ++ sy-unsubscribe-am :: presence unsub - ?: =(%cold -.am.link) . - %_ . - am.link [%cold ~] - moz (unsubscribe /am/[man] moz) - == - :: - ++ sy-unsubscribe-xm :: config unsubs - ?: =(%cold -.xm.link) . - %_ . - xm.link [%cold ~] - moz (unsubscribe /fm/[man] moz) - == - :: - ++ sy-unsubscribe-fm :: content unsub - ?: =(%cold -.fm.link) . - %_ . - fm.link [%cold ~] - moz (unsubscribe /fm/[man] moz) + link %cold + moz :: %+ unsubscribe /xm/[man] + :: %+ unsubscribe /am/[man] + (unsubscribe /fm/[man] ~) == :: ++ sy-serial :: make serial no @@ -339,75 +319,190 @@ |= msg=tape %_(+> moz (display [%leaf "{(trip man)}: {msg}"]~ moz)) :: - ++ sy-cordon :: set cordon - |= con=(each (set ship) (set ship)) - ^+ +> - ?. ?=(%warm -.xm.link) (sy-message "not connected") - =. cordon.p.xm.link - ?- -.cordon.p.xm.link - %& ?- -.con - %& [%& (stog p.con p.cordon.p.xm.link)] - %| con - == - %| ?- -.con - %& con - %| [%| (stog p.con p.cordon.p.xm.link)] - == - == - +>.$(moz (transmit [%design man ~ p.xm.link] moz)) - :: - ++ sy-sources :: set sources - |= src=(set station) - ^+ +> - ?. ?=(%warm -.xm.link) (sy-message "not connected") - =. sources.p.xm.link (stog src sources.p.xm.link) - +>.$(moz (transmit [%design man ~ p.xm.link] moz)) - :: ++ sy-voice :: set targets |= [act=? tou=(set station)] - %_(+> mike [act tou], moz (accept (crip (swatch tou)) moz)) + ?: &(p.mike !act) +> + %_(+> mike [act tou], moz (accept (crip (swatch our.hid tou)) moz)) :: ++ sy-rollback |= lon=@dr !! :: - ++ sy-work + ++ sy-work :: run user command |= job=work ^+ +> ?- -.job - %ask !! - %exp !! + %ask ~&(%sy-work-ask-stub !!) + %exp ~&(%sy-work-exp-stub !!) %mor |- ^+ +>.^$ ?~ +.job +>.^$ $(+.job t.+.job, +>.^$ ^$(job i.+.job)) :: %rub - ?- +<.job - %lite (sy-cordon [%| +>.job]) - %dark (sy-cordon [%& +>.job]) - %love (sy-sources +>.job) - %whom (sy-voice +>.job) - %wind !! + ?: ?=(%whom +<.job) + (sy-voice +>.job) + ?: ?=(%wind +<.job) + ~& %rub-wind-stub + !! + =+ suz=sy-live + ?~ suz (sy-message "not connected") + ?- +<.job + %lite sz-abet:(sz-cordon:u.suz [%| +>.job]) + %dark sz-abet:(sz-cordon:u.suz [%& +>.job]) + %love sz-abet:(sz-sources:u.suz +>.job) == + :: %say =^ sir +>.$ sy-serial +>.$(moz (transmit [%publish [[sir sy-audience [lat.hid +.job]] ~]] moz)) :: - %wry !! - %who !! + %wry ~&(%sy-work-wry !!) + %who ~&(%sy-work-who-stub !!) == + :: + ++ sy-gram :: apply telegram + |= gam=telegram + ^+ +> + %= +> + moz + %- render + :_ moz + ^- iron + =* sta r.q.gam + ?+ -.q.sta ~&([%strange-gram -.q.sta] !!) + :: + %say [%txt (rap 3 (scot %p p.gam) ': ' p.q.sta ~)] + %own [%txt (rap 3 (scot %p p.gam) ' ' p.q.sta ~)] + %lin [%txt (rap 3 (scot %p p.gam) ?:(p.q.sta ' ' ': ') q.q.sta ~)] + %inv !! + %exp + :- %tang + :_ ~ + :~ %rose + [" " "" ""] + [%leaf "{} {(trip p.q.sta)}"] + (need q.q.sta) + == + == + == + :: + ++ sy-grams :: apply telegrams + |= [num=@ud gaz=(list telegram)] + ^+ +> + =. . + ~? (gth num count) [%sy-grams-gap num count] + ?: =(num count) . + .(num count, gaz (slag (sub count num) gaz)) + |- ^+ +>.^$ + ?~ gaz +>.^$ + $(gaz t.gaz, +>.^$ (sy-gram i.gaz)) + :: + ++ sy-error :: report error + |= ars=ares + %= +> + moz + %- display :_ moz + ?~ ars [%leaf "connection error"]~ + [leaf/"error: (trip p.u.ars)" q.u.ars] + == + :: + ++ sy-sign :: subscription sign + |= res=gall-sign + ^+ +> + ~& [%sy-sign res] + ?- -.res + %mean + =. link %dead + (sy-error p.res) + :: + %nice :: misordered, ignore + :: ?. ?=(%cool link) + :: ~& [%sy-sign-nice-bad -.link] + :: +>.$ + ::+>(link %warm) + +>.$ + :: + %rush :: should use, don't + ~&(%sy-sign-rush !!) + :: + %rust :: direct update + ?: ?=(?(%cold %dead) link) + ~& [%sy-sign-rust-bad `@tas`-.link] + +>.$ + ?> ?=(%radio-report +<.res) + ?: ?=(%cool link) + :: XX workaround for inverted nice + $(link %warm) + =+ suz=sy-live + ?~ suz (sy-message "not connected") + sz-abet:(sz-apply:u.suz +>.res) + == + :: + ++ sy-live :: as connected + ^- (unit ,_sz) + ?: ?=([%live *] link) + `~(. sz p.link) + ?.(?=(%warm link) ~ `~(. sz *bridge)) + :: + ++ sz :: story, connected + |_ big=bridge + ++ sz-abet %_(+> link [%live big]) :: resolve to ++sy + ++ sz-amok + |= why=?(%cold %cool %dead %warm) + %_(+>+> link why) + :: + ++ sz-cordon :: design cordon + |= con=(ache (set ship) (set ship)) + ^+ +> + =. cordon.xm.big + ?- -.cordon.xm.big + %& ?- -.con + %& [%& (stog p.con p.cordon.xm.big)] + %| con + == + %| ?- -.con + %& con + %| [%| (stog p.con p.cordon.xm.big)] + == + == + +>.$(moz (transmit [%design man ~ xm.big] moz)) + :: + ++ sz-sources :: design sources + |= src=(set station) + ^+ +> + =. sources.xm.big (stog src sources.xm.big) + +>.$(moz (transmit [%design man ~ xm.big] moz)) + :: + ++ sz-config :: apply config + |= cof=config + %_(+> xm.big cof, +> (sy-voice %| sources.cof)) + :: + ++ sz-group :: apply register + |= rex=register + %_(+> am.big rex) + :: + ++ sz-apply :: apply report + |= rad=report + ^+ +> + ?- -.rad + %house ~&(%sz-apply-house !!) + %grams +>(+> (sy-grams +.rad)) + %config (sz-config +.rad) + %group (sz-group +.rad) + == + -- -- ++ ny :: top configuration |_ moz=(list move) ++ ny-abet :: resolve core - ^- [(list move) town] - [moz +>+<+] + ^- [(list move) _+>] + [(flop moz) +>] :: ++ ny-amid :: integrate story |= nov=_sy - =^ zom +>+>+<+ sy-abet:nov - +>.$(moz zom) + =^ zom +>+> sy-abet:nov + +>.$(moz (flop zom)) :: ++ ny-tune :: connect to story |= man=span @@ -419,12 +514,12 @@ =. +> ny-stop =. live `man ~& [%tune-start man] - (ny-amid sy-start:(need (novel moz))) + (ny-amid sy-subscribe:(need (novel moz))) :: ++ ny-stop :: disconnect story ^+ . ?~ live . - (ny-amid(live ~) sy-stop:(need (novel moz))) + (ny-amid(live ~) sy-unsubscribe:(need (novel moz))) :: ++ ny-tell :: hear from server |= sap=(set span) @@ -440,8 +535,8 @@ ?:((~(has by stories) i.pas) sor [[i.pas *story] sor]) ?^ live +>.$ ?~ stories +>.$ - ?: (~(has by `(map span story)`stories) %floor) - (ny-tune %floor) + ?: (~(has by `(map span story)`stories) (main our.hid)) + (ny-tune (main our.hid)) (ny-tune p.n.stories) :: ++ ny-work :: user command @@ -463,16 +558,14 @@ ++ pour-shell |= txt=cord ^- [(list move) _+>] - =+ jub=(rush txt work:parse) + =+ jub=(rush txt work:(parse our.hid)) ?~ jub [(display [%leaf "invalid input"]~ ~) +>.$] ?: ?=(%wry -.u.jub) - =^ moz +<+.+>.$ ny-abet:(ny-work:ny +.u.jub) - [moz +>.$] + ny-abet:(ny-work:ny +.u.jub) =+ nuv=(novel ~) ?~ nuv [(display [%leaf "not tuned to any story"]~ ~) +>.$] - =^ moz +<+.+>.$ sy-abet:(sy-work:u.nuv u.jub) - [moz +>.$] + sy-abet:(sy-work:u.nuv u.jub) :: ++ pour |= [ost=bone pax=path sih=*] @@ -489,6 +582,9 @@ ?> ?=(%txt -.p.sih) (pour-shell p.p.sih) == + :: + %cmd-ac + [~ +>.$] :: %server ?+ +<.sih !! @@ -496,11 +592,22 @@ %mean ~&(%talk-server-crash !!) ?(%rush %rust) ?> ?=([%radio-report %house *] p.sih) - =^ moz +>+<+ ny-abet:(ny-tell:ny +.p.p.sih) - [moz +>.$] - :: - % + ny-abet:(ny-tell:ny +.p.p.sih) == + :: + %time + :_ +>.$ + ~& [%talk-pour-time lat.hid `@da`(add ~s10 lat.hid)] + :~ [0 %pass /time %t %wait (add ~s10 lat.hid)] + == + :: + %fm + ?> ?=([@ *] t.pax) + ?. &(?=(^ live) =(u.live i.t.pax)) + ~& [%talk-wrong-story live i.t.pax] + [~ +>.$] + ?> ?=(%g -.sih) + sy-abet:(sy-sign:(need (novel ~)) +.sih) == :: ++ poke-talk-args diff --git a/main/sur/radio/core.hook b/main/sur/radio/core.hook index 024948be5..ac763fa15 100644 --- a/main/sur/radio/core.hook +++ b/main/sur/radio/core.hook @@ -2,6 +2,7 @@ :::: /hook/core/radio/sur :: |% +++ ache |*([a=$+(* *) b=$+(* *)] $%([| p=b] [& p=a])) :: PM 314 ++ audience (map station delivery) :: destination/state ++ atlas (map ship status) :: presence map ++ command :: effect on party @@ -12,9 +13,10 @@ == :: ++ config :: party configuration $: sources=(set station) :: pulls from - cordon=(each (set ship) (set ship)) :: white/blacklist + cordon=control :: & white, | black == :: ++ cousin (pair ship span) :: domestic flow +++ control (ache (set ship) (set ship)) :: & white, | black ++ delivery :: delivery state $? %pending :: undelivered %received :: delivered From 4917dc9e59ad9f54a69ecfabe3b9a0eb232f35ae Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Mon, 5 Jan 2015 15:59:57 -0800 Subject: [PATCH 03/13] Basic radio service now active. --- main/app/radio/core.hook | 33 ++++++--- main/app/talk/core.hook | 117 ++++++++++++++++++++----------- main/mar/radio-command/door.hook | 4 +- main/mar/radio-report/door.hook | 5 +- main/sur/radio/core.hook | 4 +- 5 files changed, 106 insertions(+), 57 deletions(-) diff --git a/main/app/radio/core.hook b/main/app/radio/core.hook index 51e772424..6c3a48123 100644 --- a/main/app/radio/core.hook +++ b/main/app/radio/core.hook @@ -130,6 +130,14 @@ =. +> $(gel r.gel) (ra-house n.gel) :: + ++ ra-init :: initialize radio + =+ sir=(sein our.hid) + %+ ra-apply our.hid + :+ %design (main our.hid) + :- ~ + :_ [%| ~] + ?:(=(sir our.hid) ~ [[%& sir (main sir)] ~ ~]) + :: ++ ra-apply :: apply command |= [her=ship cod=command] ^+ +> @@ -219,7 +227,7 @@ ++ ra-subscribe :: listen to |= [her=ship pax=path] ^+ +> - :: ~& [%ra-subscribe pax] + :: ~& [%ra-subscribe her pax] ?: ?=(~ pax) (ra-house(general (~(put in general) ost)) ost) ?: ?=([%am @ ~] pax) @@ -411,9 +419,10 @@ :: [%g %rust %radio-report *] :: ~& [%pa-friend-report +>+.sih] - ?+ -.+>+.sih ~&([%radio-odd-friend sih] !!) - %grams - (pa-lesson q.+.+>+.sih) + ?+ -.+>+.sih ~&([%radio-odd-friend sih] !!) + %config +>.$ + %group +>.$ + %grams (pa-lesson q.+.+>+.sih) == == :: @@ -476,7 +485,7 @@ %| ~& tweet-acquire/p.p.tay !! :: - %& :: ~& [%pa-acquire [our.hid man] [p.p.tay q.p.tay]] + %& ~& [%pa-acquire [our.hid man] [p.p.tay q.p.tay]] :~ :- /friend/show/[man] [%g %show [p.p.tay /radio] our.hid /fm/[q.p.tay]/(scot %ud num)] == @@ -578,6 +587,7 @@ ?. ?=([~ %$ ?(%ud %da) @] say) ~ ?. ?=([~ %$ ?(%ud %da) @] den) ~ `[(point +>.say) (point +>.den)] + :: ~& [%pa-listen her pax ruv] ?~ ruv (pa-sauce ost [[%mean ~ %radio-malformed ~] ~]) (pa-start u.ruv) @@ -588,6 +598,7 @@ =+ ^= moy |- ^- (pair (list bone) (list move)) ?~ guests [~ ~] + :: ~& [%pa-refresh num n.guests] =+ lef=$(guests l.guests) =+ rit=$(guests r.guests) =+ old=[p=(welp p.lef p.rit) q=(welp q.lef q.rit)] @@ -659,9 +670,9 @@ ++ pour |= [ost=bone pax=path sih=*] ^- [(list move) _+>] - :: ~& [%radio-pour ost pax sih] :: ~& sih=sih =+ sih=((hard sign) sih) + :: ~& [%radio-pour ost pax sih] ?+ pax ~& [%radio-strange-path pax] !! :: [%provoke ~] [~ +>.$] @@ -718,16 +729,16 @@ |= old=(unit (unit house-any)) ^- [(list move) _+>] ?> ?=(^ old) - :- ?^ u.old ~ - [0 %pass /time %t %wait (add ~s10 lat.hid)]~ + =+ moz=`(list move)`[0 %pass /time %t %wait (add ~s10 lat.hid)]~ |- ?~ u.old =+ paf=/(scot %p our.hid)/try/(scot %da lat.hid)/radio/backlog/jam ?. ?=([%0 %0 %0] [.^(%cy paf)]) $(u.old (some ((hard house-any) (cue ((hard ,@) .^(%cx paf)))))) - :: ~& %radio-prep-new - +:ra-abet:(~(ra-apply ra 0 ~) our.hid %design (main our.hid) `[~ [%| ~]]) - :: ~& %radio-prep-old + ~& %radio-prep-new + ra-abet:~(ra-init ra 0 moz) + ~& %radio-prep-old + :- moz |- ?- -.u.u.old %1 %_(+>.^^$ +<+ u.u.old) diff --git a/main/app/talk/core.hook b/main/app/talk/core.hook index a4e450864..8ba4884e4 100644 --- a/main/app/talk/core.hook +++ b/main/app/talk/core.hook @@ -27,7 +27,7 @@ ++ story :: persona $: link=(grip bridge) :: connection count=@ud :: message counter - mike=(pair ,? (set station)) :: active/voice + mike=(pair ,? (set station)) :: passive/voice quiet=? :: !verbose past=(list station) :: past received auds == :: @@ -101,24 +101,7 @@ !: :::: :: -=> |% - ++ swatch :: print station set - |= [our=ship tou=(set station)] - =+ tuo=(~(tap in tou)) - |- ^- tape - ?~ tuo ~ - =+ ted=$(tuo t.tuo) - =+ ^= ind ^- tape - ?- -.i.tuo - %& =+ sip=(scow %p p.p.i.tuo) - ?: =((main our) q.p.i.tuo) - sip - (welp sip (trip q.p.i.tuo)) - %| ['^' '@' (trip p.p.i.tuo)] - == - ?~ ted ind - (welp ind `tape`[',' ' ' ted]) - :: +=> |% :: tools ++ parse :: command parser |= our=ship =+ vag=(vang | [&1:% &2:% '0' |3:%]) @@ -213,6 +196,24 @@ (stag %say tome) == -- + :: + ++ swatch :: print station set + |= [our=ship tou=(set station)] + =+ tuo=(~(tap in tou)) + |- ^- tape + ?~ tuo ~ + =+ ted=$(tuo t.tuo) + =+ ^= ind ^- tape + ?- -.i.tuo + %& =+ sip=(scow %p p.p.i.tuo) + ?: =((main p.p.i.tuo) q.p.i.tuo) + sip + :(welp sip "/" (trip q.p.i.tuo)) + %| ['^' '@' (trip p.p.i.tuo)] + == + ?~ ted ind + (welp ind `tape`[',' ' ' ted]) + :: ++ stog :: toggle set |* [tog=(set) tag=(set)] =+ got=(~(tap in tog)) @@ -279,9 +280,10 @@ [(flop moz) +>(stories (~(put by stories) man +<+))] :: ++ sy-subscribe :: story subscribe - ~& [%subscribe-link link] - ?> =(%cold -.link) - %_ . + ?> =(%cold link) + =+ cub=?.(=(0 count) (scot %ud count) (scot %da (sub lat.hid ~d1))) + =. + (sy-message "subscribe <{(trip cub)}>") + %_ + link %cool moz ^- (list move) :: %^ subscribe /xm/[man] /xm/[man] @@ -294,11 +296,11 @@ (scot %da (sub lat.hid ~d1)) (scot %ud count) == - ~ + moz == :: ++ sy-unsubscribe :: story unsubscribe - ?: =(& ?=(?(%cold %dead) -.link)) . + ?: =(& ?=(?(%cold %dead) link)) . %_ . link %cold moz :: %+ unsubscribe /xm/[man] @@ -317,12 +319,29 @@ :: ++ sy-message :: print message |= msg=tape - %_(+> moz (display [%leaf "{(trip man)}: {msg}"]~ moz)) + %_(+> moz (display [%leaf ":{(trip man)}: {msg}"]~ moz)) + :: + ++ sy-present + |= [msg=tape tay=(list tank)] + =. tay (welp tay `(list tank)`[%leaf "::"]~) + =. tay :_(tay [%leaf ":{(trip man)}: {msg}:: "]) + %_(+>.$ moz (display (flop tay) moz)) + :: + ++ sy-prompt + |= tou=(set station) + ^- tape + ;: welp + (scow %p our.hid) + "/" + (trip man) + ?~ tou "& " + :(welp "(" (swatch our.hid tou) ")& ") + == :: ++ sy-voice :: set targets - |= [act=? tou=(set station)] - ?: &(p.mike !act) +> - %_(+> mike [act tou], moz (accept (crip (swatch our.hid tou)) moz)) + |= [pas=? tou=(set station)] + ?: &(!p.mike pas) +> + %_(+>.$ mike [pas tou], moz (accept (crip (sy-prompt tou)) moz)) :: ++ sy-rollback |= lon=@dr @@ -374,7 +393,7 @@ :: %say [%txt (rap 3 (scot %p p.gam) ': ' p.q.sta ~)] %own [%txt (rap 3 (scot %p p.gam) ' ' p.q.sta ~)] - %lin [%txt (rap 3 (scot %p p.gam) ?:(p.q.sta ' ' ': ') q.q.sta ~)] + %lin [%txt (rap 3 (scot %p p.gam) ?:(p.q.sta ': ' ' ') q.q.sta ~)] %inv !! %exp :- %tang @@ -390,13 +409,15 @@ ++ sy-grams :: apply telegrams |= [num=@ud gaz=(list telegram)] ^+ +> + ?: (gth num count) + (sy-message(count 0) "message gap: {} at {}") =. . - ~? (gth num count) [%sy-grams-gap num count] ?: =(num count) . .(num count, gaz (slag (sub count num) gaz)) + =+ las=(add count (lent gaz)) |- ^+ +>.^$ - ?~ gaz +>.^$ - $(gaz t.gaz, +>.^$ (sy-gram i.gaz)) + ?~ gaz +>.^$(count las) + $(gaz t.gaz, count +(count), +>.^$ (sy-gram i.gaz)) :: ++ sy-error :: report error |= ars=ares @@ -404,13 +425,13 @@ moz %- display :_ moz ?~ ars [%leaf "connection error"]~ - [leaf/"error: (trip p.u.ars)" q.u.ars] + [leaf/"disaster: (trip p.u.ars)" q.u.ars] == :: ++ sy-sign :: subscription sign |= res=gall-sign ^+ +> - ~& [%sy-sign res] + :: ~& [%sy-sign res] ?- -.res %mean =. link %dead @@ -418,7 +439,7 @@ :: %nice :: misordered, ignore :: ?. ?=(%cool link) - :: ~& [%sy-sign-nice-bad -.link] + :: ~& [%sy-sign-nice-bad link] :: +>.$ ::+>(link %warm) +>.$ @@ -428,7 +449,7 @@ :: %rust :: direct update ?: ?=(?(%cold %dead) link) - ~& [%sy-sign-rust-bad `@tas`-.link] + ~& [%sy-sign-rust-bad `@tas`link] +>.$ ?> ?=(%radio-report +<.res) ?: ?=(%cool link) @@ -476,7 +497,9 @@ :: ++ sz-config :: apply config |= cof=config - %_(+> xm.big cof, +> (sy-voice %| sources.cof)) + =. +>+> (sy-present "config" >cof< ~) + :: ~& [%sz-config cof] + %_(+> xm.big cof, +> (sy-voice %& sources.cof)) :: ++ sz-group :: apply register |= rex=register @@ -513,7 +536,7 @@ +>(moz (show "no story {(trip man)}" moz)) =. +> ny-stop =. live `man - ~& [%tune-start man] + :: ~& [%tune-start man] (ny-amid sy-subscribe:(need (novel moz))) :: ++ ny-stop :: disconnect story @@ -555,6 +578,11 @@ ?~ live ~ `~(. sy [u.live moz] (~(got by stories) u.live)) :: +++ peer + |= [ost=bone you=ship pax=path] + ^- [(list move) _+>] + [~ +>.$] +:: ++ pour-shell |= txt=cord ^- [(list move) _+>] @@ -573,11 +601,18 @@ => .(sih ((hard sign) sih)) :: ~& talk-pour/sih ?~ pax ~& talk-pour-strange-path/pax !! - ?+ i.pax ~& talk-pour-strange-path/pax !! + ?+ i.pax ~& talk-pour-strange-path/pax + ~& sign/sih + !! + %command + ?+ +<.sih !! + %nice [~ +>.$] + %mean ~&([%pour-mean-cmd-in +>.sih] !!) + == %cmd-in ?+ +<.sih !! %nice [~ +>.$] - %mean ~&(%talk-input-crash !!) + %mean ~&([%pour-mean-cmd-in +>.sih] !!) ?(%rush %rust) ?> ?=(%txt -.p.sih) (pour-shell p.p.sih) @@ -597,7 +632,7 @@ :: %time :_ +>.$ - ~& [%talk-pour-time lat.hid `@da`(add ~s10 lat.hid)] + :: ~& [%talk-pour-time lat.hid `@da`(add ~s10 lat.hid)] :~ [0 %pass /time %t %wait (add ~s10 lat.hid)] == :: diff --git a/main/mar/radio-command/door.hook b/main/mar/radio-command/door.hook index eee32b9ed..d6e40bdbb 100644 --- a/main/mar/radio-command/door.hook +++ b/main/mar/radio-command/door.hook @@ -69,11 +69,13 @@ :: ++ stam ^- $+(json (unit statement)) + =- (ot now/di speech/(of -) ~) :~ own/so say/so + lin/(ot say/bo txt/so ~) exp/(cu |=(a=cord [a ~]) so) - inv/(ot ship/(su fed:ag) party/(su urs:ab) ~) + :: inv/(ot ship/(su fed:ag) party/(su urs:ab) ~) == :: :: diff --git a/main/mar/radio-report/door.hook b/main/mar/radio-report/door.hook index ca125c550..d975ce9cf 100644 --- a/main/mar/radio-report/door.hook +++ b/main/mar/radio-report/door.hook @@ -64,10 +64,11 @@ ++ spec |= a=speech %+ joba -.a - ?- -.a + ?+ -.a !! ?(%own %say) [%s p.a] + %lin (jobe say/[%b p.a] txt/[%s q.a] ~) %exp (jobe code/[%s p.a] done/?~(q.a ~ (joke u.q.a)) ~) - %inv (jobe ship/(jope p.a) party/[%s q.a] ~) + :: %inv (jobe ship/(jope p.a) party/[%s q.a] ~) == :: ++ huma diff --git a/main/sur/radio/core.hook b/main/sur/radio/core.hook index ac763fa15..ab58fd66d 100644 --- a/main/sur/radio/core.hook +++ b/main/sur/radio/core.hook @@ -45,8 +45,8 @@ $% [%own p=@t] :: XX @ or /me [%exp p=@t q=(unit tank)] :: program output [%ext p=@tas q=*] :: extended action - [%inv p=station] :: invite station - [%irt p=serial q=speech] :: in-reply-to + :: [%inv p=station] :: invite station + [%ire p=serial q=speech] :: in-reply-to [%lin p=? q=@t] :: no=@, text line [%mor p=(list speech)] :: multi-line etc [%say p=@t] :: XX normal line From 23dd79c52c8ead3ae19213a632daac4a49035bfe Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Tue, 6 Jan 2015 12:31:36 -0800 Subject: [PATCH 04/13] Refactor ++hy. --- main/app/radio/core.hook | 6 +- main/app/talk/core.hook | 167 +++++++++++++++---------------- main/mar/radio-command/door.hook | 3 +- main/sur/radio/core.hook | 18 +++- 4 files changed, 101 insertions(+), 93 deletions(-) diff --git a/main/app/radio/core.hook b/main/app/radio/core.hook index 6c3a48123..8c2074892 100644 --- a/main/app/radio/core.hook +++ b/main/app/radio/core.hook @@ -782,9 +782,9 @@ =+ ^= spe |= r=_r:*zong ^- speech ?- -.r - %say [%say p.r] - %do [%own p.r] - %exp [%exp p.r [~ q.r]] + %say [%lin %& p.r] + %do [%lin %| p.r] + %exp [%fat [%tank q.r ~] [%exp p.r]] == %+ turn b |= d=zong ^- telegram diff --git a/main/app/talk/core.hook b/main/app/talk/core.hook index 8ba4884e4..500457132 100644 --- a/main/app/talk/core.hook +++ b/main/app/talk/core.hook @@ -102,6 +102,44 @@ :::: :: => |% :: tools + ++ hy :: messenger + |_ [moz=(list move) hide] + ++ hy-abet moz :: resolve core + ++ hy-transmit :: send command + |= cod=command + %_ +> + moz :_ moz + [0 %pass /command %g %mess [our /radio] our [%radio-command !>(cod)]] + == + :: + ++ hy-render :: return to console + |= rod=iron + %_ +> + moz + =+ oss=(~(tap in (~(get ju pus) /out))) + |- ^- (list move) + ?~ oss moz + [`move`[i.oss %give %rush rod] $(oss t.oss)] + == + :: + ++ hy-subscribe :: send %show + |= [way=path hoc=path] + %_(+> moz :_(moz [0 %pass way %g %show [our /radio] our hoc])) + :: + ++ hy-unsubscribe :: send %nuke + |= way=path + %_(+> moz :_(moz [0 %pass way %g %nuke [our /radio] our])) + :: + ++ hy-display :: print to console + |=(tay=(list tank) (hy-render %tang tay)) + :: + ++ hy-print :: simple print + |=(tep=tape (hy-display [%leaf tep]~)) + :: + ++ hy-accept :: set prompt + |=(asq=cord (hy-render [%prompt asq %text ''])) + -- + :: ++ parse :: command parser |= our=ship =+ vag=(vang | [&1:% &2:% '0' |3:%]) @@ -230,44 +268,7 @@ :::: :: |_ [hid=hide town] -++ transmit :: radio command - |= [cod=command moz=(list move)] - ^- (list move) - :_ moz - :* 0 %pass /command - %g %mess [our.hid /radio] our.hid - [%radio-command !>(cod)] - == -:: -++ subscribe :: radio show - |= [way=path hoc=path moz=(list move)] - ^- (list move) - :_(moz [0 %pass way %g %show [our.hid /radio] our.hid hoc]) -:: -++ unsubscribe :: radio nuke - |= [way=path moz=(list move)] - ^- (list move) - :_(moz [0 %pass way %g %nuke [our.hid /radio] our.hid]) -:: -++ render :: send to console - |= [rod=iron moz=(list move)] - =+ oss=(~(tap in (~(get ju pus.hid) /out))) - |- ^- (list move) - ?~ oss moz - [`move`[i.oss %give %rush rod] $(oss t.oss)] -:: -++ display :: print to console - |= [tay=(list tank) moz=(list move)] - (render [%tang tay] moz) -:: -++ show :: simple show - |= [tep=tape moz=(list move)] - (display [%leaf tep]~ moz) -:: -++ accept :: set prompt - |= [asq=cord moz=(list move)] - (render [%prompt asq %text ''] moz) -:: +++ hype |=(moz=(list move) ~(. hy moz hid)) ++ sy |_ $: $: man=span :: u.live moz=(list move) :: pending moves @@ -285,27 +286,23 @@ =. + (sy-message "subscribe <{(trip cub)}>") %_ + link %cool - moz ^- (list move) - :: %^ subscribe /xm/[man] /xm/[man] - :: %^ subscribe /am/[man] /am/[man] - %^ subscribe /fm/[man] - :~ %fm - man - ?: =(0 count) - ~& [%story-init man `@da`(sub lat.hid ~d1)] - (scot %da (sub lat.hid ~d1)) - (scot %ud count) - == - moz + moz =< hy-abet + %+ hy-subscribe:(hype moz) + /fm/[man] + :~ %fm + man + ?: =(0 count) + ~& [%story-init man `@da`(sub lat.hid ~d1)] + (scot %da (sub lat.hid ~d1)) + (scot %ud count) + == == :: ++ sy-unsubscribe :: story unsubscribe ?: =(& ?=(?(%cold %dead) link)) . %_ . link %cold - moz :: %+ unsubscribe /xm/[man] - :: %+ unsubscribe /am/[man] - (unsubscribe /fm/[man] ~) + moz hy-abet:(hy-unsubscribe:(hype moz) /fm/[man]) == :: ++ sy-serial :: make serial no @@ -319,13 +316,13 @@ :: ++ sy-message :: print message |= msg=tape - %_(+> moz (display [%leaf ":{(trip man)}: {msg}"]~ moz)) + %_(+> moz hy-abet:(hy-print:(hype moz) ":{(trip man)}: {msg}")) :: ++ sy-present |= [msg=tape tay=(list tank)] =. tay (welp tay `(list tank)`[%leaf "::"]~) =. tay :_(tay [%leaf ":{(trip man)}: {msg}:: "]) - %_(+>.$ moz (display (flop tay) moz)) + %_(+>.$ moz hy-abet:(hy-display:(hype moz) (flop tay))) :: ++ sy-prompt |= tou=(set station) @@ -341,7 +338,10 @@ ++ sy-voice :: set targets |= [pas=? tou=(set station)] ?: &(!p.mike pas) +> - %_(+>.$ mike [pas tou], moz (accept (crip (sy-prompt tou)) moz)) + %_ +>.$ + mike [pas tou] + moz hy-abet:(hy-accept:(hype moz) (crip (sy-prompt tou))) + == :: ++ sy-rollback |= lon=@dr @@ -374,34 +374,33 @@ :: %say =^ sir +>.$ sy-serial - +>.$(moz (transmit [%publish [[sir sy-audience [lat.hid +.job]] ~]] moz)) + %= +>.$ + moz + =< hy-abet + %- ~(hy-transmit hy moz hid) + [%publish [[sir sy-audience [lat.hid +.job]] ~]] + == :: %wry ~&(%sy-work-wry !!) %who ~&(%sy-work-who-stub !!) == :: ++ sy-gram :: apply telegram - |= gam=telegram + |= [num=@ud gam=telegram] ^+ +> %= +> moz - %- render - :_ moz - ^- iron + =< hy-abet + %- hy-render:(hype moz) =* sta r.q.gam ?+ -.q.sta ~&([%strange-gram -.q.sta] !!) :: - %say [%txt (rap 3 (scot %p p.gam) ': ' p.q.sta ~)] - %own [%txt (rap 3 (scot %p p.gam) ' ' p.q.sta ~)] - %lin [%txt (rap 3 (scot %p p.gam) ?:(p.q.sta ': ' ' ') q.q.sta ~)] - %inv !! - %exp - :- %tang - :_ ~ - :~ %rose - [" " "" ""] - [%leaf "{} {(trip p.q.sta)}"] - (need q.q.sta) + %lin + :- %txt + %+ rap 3 + :~ (scot %ud num) '.' + (scot %p p.gam) ?:(p.q.sta ': ' ' ') + q.q.sta == == == @@ -417,15 +416,15 @@ =+ las=(add count (lent gaz)) |- ^+ +>.^$ ?~ gaz +>.^$(count las) - $(gaz t.gaz, count +(count), +>.^$ (sy-gram i.gaz)) + $(gaz t.gaz, count +(count), +>.^$ (sy-gram num i.gaz)) :: ++ sy-error :: report error |= ars=ares %= +> moz - %- display :_ moz - ?~ ars [%leaf "connection error"]~ - [leaf/"disaster: (trip p.u.ars)" q.u.ars] + =< hy-abet + %- hy-print:(hype moz) + ?~(ars "connection error" "disaster: (trip p.u.ars)") == :: ++ sy-sign :: subscription sign @@ -487,13 +486,13 @@ %| [%| (stog p.con p.cordon.xm.big)] == == - +>.$(moz (transmit [%design man ~ xm.big] moz)) + +>.$(moz hy-abet:(hy-transmit:(hype moz) [%design man ~ xm.big])) :: ++ sz-sources :: design sources |= src=(set station) ^+ +> =. sources.xm.big (stog src sources.xm.big) - +>.$(moz (transmit [%design man ~ xm.big] moz)) + +>.$(moz hy-abet:(hy-transmit:(hype moz) [%design man ~ xm.big])) :: ++ sz-config :: apply config |= cof=config @@ -531,9 +530,9 @@ |= man=span ^+ +> ?: =(`man live) - +>(moz (show "already tuned to {(trip man)}" moz)) + +>(moz hy-abet:(hy-print:(hype moz) "already tuned to {(trip man)}")) ?. (~(has by stories) man) - +>(moz (show "no story {(trip man)}" moz)) + +>(moz hy-abet:(hy-print:(hype moz) "no story {(trip man)}")) =. +> ny-stop =. live `man :: ~& [%tune-start man] @@ -566,8 +565,8 @@ |= jaw=work-construct ^+ +> ?- -.jaw - %raze +>(moz (transmit [%design p.jaw ~] moz)) - %make +>(moz (transmit [%design p.jaw [~ ~ %| ~]] moz)) + %raze +>(moz hy-abet:(hy-transmit:(hype moz) [%design p.jaw ~])) + %make +>(moz hy-abet:(hy-transmit:(hype moz) [%design p.jaw [~ ~ %| ~]])) %tune (ny-tune p.jaw) == -- @@ -588,11 +587,11 @@ ^- [(list move) _+>] =+ jub=(rush txt work:(parse our.hid)) ?~ jub - [(display [%leaf "invalid input"]~ ~) +>.$] + [hy-abet:(hy-print:(hype ~) "invalid input") +>.$] ?: ?=(%wry -.u.jub) ny-abet:(ny-work:ny +.u.jub) =+ nuv=(novel ~) - ?~ nuv [(display [%leaf "not tuned to any story"]~ ~) +>.$] + ?~ nuv [hy-abet:(hy-print:(hype ~) "not tuned to any story") +>.$] sy-abet:(sy-work:u.nuv u.jub) :: ++ pour diff --git a/main/mar/radio-command/door.hook b/main/mar/radio-command/door.hook index d6e40bdbb..794383556 100644 --- a/main/mar/radio-command/door.hook +++ b/main/mar/radio-command/door.hook @@ -69,12 +69,11 @@ :: ++ stam ^- $+(json (unit statement)) - =- (ot now/di speech/(of -) ~) :~ own/so say/so lin/(ot say/bo txt/so ~) - exp/(cu |=(a=cord [a ~]) so) + :: exp/(cu |=(a=cord [a ~]) so) :: inv/(ot ship/(su fed:ag) party/(su urs:ab) ~) == :: diff --git a/main/sur/radio/core.hook b/main/sur/radio/core.hook index ab58fd66d..3d66dce6e 100644 --- a/main/sur/radio/core.hook +++ b/main/sur/radio/core.hook @@ -42,13 +42,16 @@ ++ speech :: narrative action :: XX unify %own and %say to %lin :: - $% [%own p=@t] :: XX @ or /me - [%exp p=@t q=(unit tank)] :: program output + $% [%lan p=span q=@t] :: local announce + [%own p=@t] :: XX @ or /me + [%exp p=@t] :: hoon line + [%non ~] :: no content [%ext p=@tas q=*] :: extended action - :: [%inv p=station] :: invite station + [%fat p=torso q=speech] :: attachment + :: [%inv p=station] :: invite to station [%ire p=serial q=speech] :: in-reply-to [%lin p=? q=@t] :: no=@, text line - [%mor p=(list speech)] :: multi-line etc + [%mor p=(list speech)] :: XX deleteme [%say p=@t] :: XX normal line == :: ++ serial ,@uvH :: unique identity @@ -57,4 +60,11 @@ ++ statement (pair ,@da speech) :: when this ++ telegram (pair ship thought) :: who which whom what ++ thought (trel serial audience statement) :: which whom what +++ torso :: attachment + $% [%text (list ,@t)] :: text lines + [%tank (list tank)] :: tank list + == :: + :: markdown + :: image + :: mime object -- From 709d633815aa4f81057d5002c05a90aaa7452753 Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Tue, 6 Jan 2015 17:27:02 -0800 Subject: [PATCH 05/13] Various fixes and improvements. --- main/app/radio/core.hook | 23 ++++++++++++----------- main/app/talk/core.hook | 11 +++++------ 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/main/app/radio/core.hook b/main/app/radio/core.hook index 8c2074892..08ed3c91d 100644 --- a/main/app/radio/core.hook +++ b/main/app/radio/core.hook @@ -230,21 +230,22 @@ :: ~& [%ra-subscribe her pax] ?: ?=(~ pax) (ra-house(general (~(put in general) ost)) ost) - ?: ?=([%am @ ~] pax) - +> - ?: ?=([%xm @ ~] pax) - +> - ?. ?=([%fm *] pax) - ~& [%bad-subscribe-a pax] - (ra-evil %radio-bad-path) - ?. &(?=([@ *] t.pax) ((sane %tas) i.t.pax)) - ~& [%bad-subscribe-b pax] + ?. ?=([@ @ *] pax) (ra-evil %radio-bad-path) + =+ ^= vab ^- (set ,@tas) + =| vab=(set ,@tas) + |- ^+ vab + ?: =(0 i.pax) vab + $(i.pax (rsh 3 1 i.pax), vab (~(put in vab) (end 3 1 i.pax))) =+ pur=(~(get by stories) i.t.pax) ?~ pur ~& [%bad-subscribe-story-c i.t.pax] (ra-evil %radio-no-story) - pa-abet:(~(pa-listen pa i.t.pax u.pur) her t.t.pax) + =+ soy=~(. pa i.t.pax u.pur) + =. soy ?.((~(has in vab) %a) soy (pa-watch:soy her)) + =. soy ?.((~(has in vab) %x) soy (pa-master:soy her)) + =. soy ?.((~(has in vab) %f) soy (pa-listen:soy her t.t.pax)) + pa-abet:soy :: ++ ra-think :: publish/review |= [pub=? her=ship tiz=(list thought)] @@ -487,7 +488,7 @@ :: %& ~& [%pa-acquire [our.hid man] [p.p.tay q.p.tay]] :~ :- /friend/show/[man] - [%g %show [p.p.tay /radio] our.hid /fm/[q.p.tay]/(scot %ud num)] + [%g %show [p.p.tay /radio] our.hid /af/[q.p.tay]/(scot %ud num)] == == :: diff --git a/main/app/talk/core.hook b/main/app/talk/core.hook index 500457132..3f39ef7df 100644 --- a/main/app/talk/core.hook +++ b/main/app/talk/core.hook @@ -289,7 +289,7 @@ moz =< hy-abet %+ hy-subscribe:(hype moz) /fm/[man] - :~ %fm + :~ %afx man ?: =(0 count) ~& [%story-init man `@da`(sub lat.hid ~d1)] @@ -329,10 +329,9 @@ ^- tape ;: welp (scow %p our.hid) - "/" - (trip man) + ?:(=(man (main our.hid)) "" `tape`:(welp "/" (trip man))) ?~ tou "& " - :(welp "(" (swatch our.hid tou) ")& ") + `tape`:(welp "(" (swatch our.hid tou) ")& ") == :: ++ sy-voice :: set targets @@ -398,7 +397,7 @@ %lin :- %txt %+ rap 3 - :~ (scot %ud num) '.' + :~ (scot %ud num) ')' (scot %p p.gam) ?:(p.q.sta ': ' ' ') q.q.sta == @@ -631,7 +630,7 @@ :: %time :_ +>.$ - :: ~& [%talk-pour-time lat.hid `@da`(add ~s10 lat.hid)] + ~& [%talk-pour-time lat.hid `@da`(add ~s10 lat.hid)] :~ [0 %pass /time %t %wait (add ~s10 lat.hid)] == :: From 1ab6cac650dfbb54abf6abbfa0ed8daf354bb597 Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Wed, 7 Jan 2015 12:37:55 -0800 Subject: [PATCH 06/13] Fix activity timer bug. --- arvo/dill.hoon | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/arvo/dill.hoon b/arvo/dill.hoon index de03c36fb..f230aedc4 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -374,7 +374,7 @@ == :: %wake - ?: (lte q.s.yar (sub now ~s15)) + ?: (lte (sub now ~s15) q.s.yar) %_ +>.$ mos :_ mos From d2be7d7585a9943ad572baccd555dd67094e1d9e Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Wed, 7 Jan 2015 13:26:05 -0800 Subject: [PATCH 07/13] About to do some performance testing. --- main/app/talk/core.hook | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/app/talk/core.hook b/main/app/talk/core.hook index 3f39ef7df..9ac0b34ec 100644 --- a/main/app/talk/core.hook +++ b/main/app/talk/core.hook @@ -329,7 +329,7 @@ ^- tape ;: welp (scow %p our.hid) - ?:(=(man (main our.hid)) "" `tape`:(welp "/" (trip man))) + ?:(=(man (main our.hid)) "" `tape`(welp "/" (trip man))) ?~ tou "& " `tape`:(welp "(" (swatch our.hid tou) ")& ") == @@ -630,8 +630,8 @@ :: %time :_ +>.$ - ~& [%talk-pour-time lat.hid `@da`(add ~s10 lat.hid)] - :~ [0 %pass /time %t %wait (add ~s10 lat.hid)] + ~& [%talk-pour-time lat.hid `@da`(add ~s12 lat.hid)] + :~ [0 %pass /time %t %wait (add ~s12 lat.hid)] == :: %fm @@ -648,7 +648,7 @@ ^- [(list move) _+>] :_ +> :~ [0 %pass /cmd-in %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]] - [0 %pass /time %t %wait (add ~s10 lat.hid)] + [0 %pass /time %t %wait (add ~s13 lat.hid)] [0 %pass /cmd-ac %g %show [our.hid +.imp.hid] you /active/[-.imp.hid]] ^- move :* 0 %pass /server From 4247446cc35a890e8f7c14a971b071bcffbb265f Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Mon, 12 Jan 2015 17:49:31 -0800 Subject: [PATCH 08/13] Add cache to ++song, etc. --- arvo/ford.hoon | 228 ++++++++++++++++++++++++---------------- arvo/hoon.hoon | 170 ++++++++++++++++-------------- arvo/kahn.hoon | 2 +- main/app/talk/core.hook | 8 +- 4 files changed, 234 insertions(+), 174 deletions(-) diff --git a/arvo/ford.hoon b/arvo/ford.hoon index 34fb6ce99..de4fec3e1 100644 --- a/arvo/ford.hoon +++ b/arvo/ford.hoon @@ -114,6 +114,8 @@ == :: ++ calx :: concrete cache line $% [%hood p=calm q=(pair beam cage) r=hood] :: compile + [%slit p=calm q=[p=type q=type] r=type] :: slam type + [%slim p=calm q=[p=type q=twig] r=(pair type nock)]:: mint [%slap p=calm q=[p=vase q=twig] r=vase] :: compute [%slam p=calm q=[p=vase q=vase] r=vase] :: compute == :: @@ -131,6 +133,8 @@ %hood ?>(?=(%hood -.cax) r.cax) %slap ?>(?=(%slap -.cax) r.cax) %slam ?>(?=(%slam -.cax) r.cax) + %slim ?>(?=(%slim -.cax) r.cax) + %slit ?>(?=(%slit -.cax) r.cax) == :: ++ calk :: cache lookup @@ -189,6 +193,76 @@ =+ gib=(wox p.n.r.arc) ?~(gib rac [[u.gib p.n.r.arc] rac]) :: +-- +. == +=| axle +=* lex - +|= [now=@da eny=@ ski=sled] :: activate +^? :: opaque core +~% %ford-d +>+>+>+>+>+> ~ +|% :: +++ call :: request + ~/ %call + |= [hen=duct hic=(hypo (hobo kiss))] + ^- [p=(list move) q=_..^$] + => .(q.hic ?.(?=(%soft -.q.hic) q.hic ((hard kiss) p.q.hic))) + =+ ska=(slod ski) + =+ ^= our ^- @p + ?- -.q.hic + %exec p.q.hic + == + =+ ^= bay ^- baby + =+ buy=(~(get by pol.lex) our) + ?~(buy *baby u.buy) + =^ mos bay + abet:(~(apex za [[our ~ hen] [now eny ska] ~] bay) q.q.hic) + [mos ..^$(pol (~(put by pol) our bay))] +:: +++ doze + |= [now=@da hen=duct] + ^- (unit ,@da) + ~ +:: +++ load :: highly forgiving + |= old=* + =. old + ?. ?=([%0 *] old) old :: remove at 1 + :- %1 + |- ^- * + ?~ +.old ~ + ?> ?=([n=[p=* q=[tad=* dym=* jav=*]] l=* r=*] +.old) + :- [p.n.+.old [tad.q.n.+.old dym.q.n.+.old ~]] + [$(+.old l.+.old) $(+.old r.+.old)] + =+ lox=((soft axle) old) + ^+ ..^$ + ?~ lox + ~& %ford-reset + ..^$ + ..^$(+>- u.lox) +:: +++ scry + |= [fur=(unit (set monk)) ren=@tas who=ship syd=desk lot=coin tyl=path] + ^- (unit (unit (pair mark ,*))) + ~ +:: +++ stay :: save w/o cache + `axle`+>-.$(pol (~(run by pol) |=(a=baby [tad.a dym.a ~]))) +:: +++ take :: response + ~/ %take + |= [tea=wire hen=duct hin=(hypo sign)] + ^- [p=(list move) q=_..^$] + =+ ska=(slod ski) + ?> ?=([@ @ @ ~] tea) + =+ :* our=(need (slaw %p i.tea)) + num=(need (slaw %ud i.t.tea)) + tik=(need (slaw %ud i.t.t.tea)) + == + =+ bay=(need (~(get by pol.lex) our)) + =^ mos bay + abet:(~(axon za [[our tea hen] [now eny ska] ~] bay) num tik q.hin) + [mos ..^$(pol (~(put by pol) our bay))] +:: ++ za :: per event =| $: $: $: our=ship :: computation owner tea=wire :: event place @@ -202,6 +276,7 @@ == :: bay=baby :: all owned state == :: + ~% %za +> ~ |% ++ abet :: resolve ^- [(list move) baby] @@ -237,6 +312,7 @@ == :: ++ zo + ~% %zo +> ~ |_ [num=@ud task] ++ abet %_(..zo q.tad.bay (~(put by q.tad.bay) num +<+)) ++ amok @@ -581,6 +657,7 @@ -- :: ++ kale :: mutate + ~/ %kale |= [cof=cafe kas=silk muy=(list (pair wing silk))] ^- (bolt cage) %+ cope @@ -599,9 +676,10 @@ (fine cof p.cay vax) :: ++ keel :: apply mutations + ~/ %keel |= [cof=cafe suh=vase yom=(list (pair wing vase))] ^- (bolt vase) - %^ maim cof + %^ maim-a cof %+ slop suh |- ^- vase ?~ yom [[%atom %n] ~] @@ -666,6 +744,7 @@ ((lake for [our %main [%da now]]) cof [%noun som]) :: ++ lane :: type infer + ~/ %lane |= [cof=cafe typ=type gen=twig] %+ (cowl cof) (mule |.((~(play ut typ) gen))) |=(ref=type ref) @@ -754,7 +833,7 @@ ?: &((slab %grow p.pro) (slab too p:(slap pro [%cnzy %grow]))) %+ cope (keel cof pro [[%& 6]~ vax]~) |= [cof=cafe pox=vase] - (maim cof pox [%tsgr [%cnzy %grow] [%cnzy too]]) + (maim-b cof pox [%tsgr [%cnzy %grow] [%cnzy too]]) %+ cope (fang cof too bek) |= [cof=cafe pro=vase] =+ ^= zat ^- (unit vase) @@ -807,19 +886,37 @@ |= [cof=cafe yed=vase] ^$(cof cof, for i.yaw, yaw t.yaw, vax yed) :: - ++ maim :: slap - |= [cof=cafe vax=vase gen=twig] - ^- (bolt vase) - %+ (clef %slap) (fine cof vax gen) - |= [cof=cafe vax=vase gen=twig] - =+ puz=(mule |.((~(mint ut p.vax) [%noun gen]))) + ++ mail :: cached mint + ~/ %mail + |= [cof=cafe sut=type gen=twig] + ^- (bolt (pair type nock)) + %+ (clef %slim) (fine cof sut gen) + |= [cof=cafe sut=type gen=twig] + =+ puz=(mule |.((~(mint ut sut) [%noun gen]))) ?- -.puz | (flaw cof p.puz) - & %+ (coup cof) (mock [q.vax q.p.puz] (mole ska)) - |= val=* - `vase`[p.p.puz val] + & (fine cof p.puz) == :: + ++ maim :: slap + ~/ %maim + |= [cof=cafe vax=vase gen=twig] + ^- (bolt vase) + %+ cope (mail cof p.vax gen) + |= [cof=cafe typ=type fol=nock] + %+ (coup cof) (mock [q.vax fol] (mole ska)) + |=(val=* `vase`[typ val]) + :: + ++ maim-a ~/(%maim-a |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) + ++ maim-b ~/(%maim-b |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) + ++ maim-c ~/(%maim-c |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) + ++ maim-d ~/(%maim-d |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) + ++ maim-e ~/(%maim-e |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) + ++ maim-f ~/(%maim-f |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) + ++ maim-g ~/(%maim-g |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) + ++ maim-h ~/(%maim-h |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) + ++ maim-i ~/(%maim-i |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) + :: ++ make :: reduce silk |= [cof=cafe kas=silk] ^- (bolt cage) @@ -894,7 +991,7 @@ %+ cool |.(leaf/"ford: ride {<`@p`(mug kas)>}") %+ cope $(kas q.kas) |= [cof=cafe cay=cage] - %+ cope (maim cof q.cay p.kas) + %+ cope (maim-c cof q.cay p.kas) |= [cof=cafe vax=vase] (fine cof %noun vax) :: @@ -905,19 +1002,27 @@ (fine cof `cage`[p.kas vax]) == :: - ++ maul :: slam - |= [cof=cafe gat=vase sam=vase] - ^- (bolt vase) - %+ (clef %slam) (fine cof gat sam) - |= [cof=cafe gat=vase sam=vase] - =+ top=(mule |.((slit p.gat p.sam))) + ++ malt :: cached slit + ~/ %malt + |= [cof=cafe gat=type sam=type] + ^- (bolt type) + %+ (clef %slit) (fine cof gat sam) + |= [cof=cafe gat=type sam=type] + =+ top=(mule |.((slit gat sam))) ?- -.top | (flaw cof p.top) - & %+ (coup cof) (mong [q.gat q.sam] (mole ska)) - |= val=* - `vase`[p.top val] + & (fine cof p.top) == :: + ++ maul :: slam + ~/ %maul + |= [cof=cafe gat=vase sam=vase] + ^- (bolt vase) + %+ cope (malt cof p.gat p.sam) + |= [cof=cafe typ=type] + %+ (coup cof) (mong [q.gat q.sam] (mole ska)) + |=(val=* `vase`[typ val]) + :: ++ meow :: assemble |= [how=beam arg=heel] =| $: rop=(map term (pair hoof twig)) :: structure/complex @@ -926,6 +1031,7 @@ zeg=(set term) :: library guard boy=(list twig) :: body stack == + ~% %meow +>+> ~ |% ++ able :: assemble preamble ^- twig @@ -949,16 +1055,17 @@ [%ash [%tssg (flop boy)]] :: ++ abut :: generate + ~/ %abut |= [cof=cafe hyd=hood] ^- (bolt vase) %+ cope (apex cof hyd) |= [cof=cafe sel=_..abut] =. ..abut sel - %+ cope (maim cof pit able) + %+ cope (maim-d cof pit able) |= [cof=cafe bax=vase] %+ cope (chap cof bax [%fan fan.hyd]) |= [cof=cafe gox=vase] - %+ cope (maim cof (slop gox bax) [%tssg (flop boy)]) + %+ cope (maim-e cof (slop gox bax) [%tssg (flop boy)]) |= [cof=cafe fin=vase] (fine cof fin) :: ~> %slog.[0 ~(duck ut p.q.cay)] @@ -1030,12 +1137,13 @@ (slop $(doy l.doy) $(doy r.doy)) :: ++ chap :: produce resources + ~/ %chap |= [cof=cafe bax=vase hon=horn] ^- (bolt vase) ?- -.hon - %ape (maim cof bax p.hon) + %ape (maim-f cof bax p.hon) %arg - %+ cope (maim cof bax p.hon) + %+ cope (maim-g cof bax p.hon) |= [cof=cafe gat=vase] (maul cof gat !>([how arg])) :: @@ -1082,14 +1190,14 @@ %saw %+ cope $(hon q.hon) |= [cof=cafe sam=vase] - %+ cope (maim cof bax p.hon) + %+ cope (maim-h cof bax p.hon) |= [cof=cafe gat=vase] (maul cof gat sam) :: %sic %+ cope $(hon q.hon) |= [cof=cafe vax=vase] - %+ cope (maim cof bax [%bctr p.hon]) + %+ cope (maim-i cof bax [%bctr p.hon]) |= [cof=cafe tug=vase] ?. (~(nest ut p.tug) | p.vax) (flaw cof [%leaf "type error: {} {}"]~) @@ -1207,69 +1315,3 @@ -- -- -- -. == -=| axle -=* lex - -|= [now=@da eny=@ ski=sled] :: activate -^? :: opaque core -|% :: -++ call :: request - |= [hen=duct hic=(hypo (hobo kiss))] - ^- [p=(list move) q=_..^$] - => .(q.hic ?.(?=(%soft -.q.hic) q.hic ((hard kiss) p.q.hic))) - =+ ska=(slod ski) - =+ ^= our ^- @p - ?- -.q.hic - %exec p.q.hic - == - =+ ^= bay ^- baby - =+ buy=(~(get by pol.lex) our) - ?~(buy *baby u.buy) - =^ mos bay - abet:(~(apex za [[our ~ hen] [now eny ska] ~] bay) q.q.hic) - [mos ..^$(pol (~(put by pol) our bay))] -:: -++ doze - |= [now=@da hen=duct] - ^- (unit ,@da) - ~ -:: -++ load :: highly forgiving - |= old=* - =. old - ?. ?=([%0 *] old) old :: remove at 1 - :- %1 - |- ^- * - ?~ +.old ~ - ?> ?=([n=[p=* q=[tad=* dym=* jav=*]] l=* r=*] +.old) - :- [p.n.+.old [tad.q.n.+.old dym.q.n.+.old ~]] - [$(+.old l.+.old) $(+.old r.+.old)] - =+ lox=((soft axle) old) - ^+ ..^$ - ?~ lox - ~& %ford-reset - ..^$ - ..^$(+>- u.lox) -:: -++ scry - |= [fur=(unit (set monk)) ren=@tas who=ship syd=desk lot=coin tyl=path] - ^- (unit (unit (pair mark ,*))) - ~ -:: -++ stay :: save w/o cache - `axle`+>-.$(pol (~(run by pol) |=(a=baby [tad.a dym.a ~]))) -:: -++ take :: response - |= [tea=wire hen=duct hin=(hypo sign)] - ^- [p=(list move) q=_..^$] - =+ ska=(slod ski) - ?> ?=([@ @ @ ~] tea) - =+ :* our=(need (slaw %p i.tea)) - num=(need (slaw %ud i.t.tea)) - tik=(need (slaw %ud i.t.t.tea)) - == - =+ bay=(need (~(get by pol.lex) our)) - =^ mos bay - abet:(~(axon za [[our tea hen] [now eny ska] ~] bay) num tik q.hin) - [mos ..^$(pol (~(put by pol) our bay))] --- diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 0f4c05532..76a69d365 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -9678,7 +9678,8 @@ ++ sled $+ [(unit (set monk)) term beam] :: namespace function (unit (unit cage)) :: ++ slut $+(* (unit (unit))) :: old namespace -++ vile :: reflexive constants +++ veal (set ,^) :: actually pair type +++ vile :: reflexive constants $: typ=type :: -:!>(*type) duc=type :: -:!>(*duct) pah=type :: -:!>(*path) @@ -9713,21 +9714,21 @@ :: section 3bE, Arvo core :: :: ++ vent :: vane core - |= [lal=@tas vil=vile bud=vase ves=vase] + |= [lal=@tas vil=vile bud=vase sew=(pair veal vase)] ~% %vent +>+ ~ |% ++ ruck :: update vase |= [pax=path txt=@ta] ^+ +> =+ arg=[~2000.1.1 0 =>(~ |+(* ~))] - =+ rig=(slym ves arg) + =+ rig=(slym q.sew arg) =+ rev=(slym (slap bud (rain pax txt)) bud) =+ syg=(slym rev arg) - +>.$(ves (slam (slap syg [%cnzy %load]) (slap rig [%cnzy %stay]))) + +>.$(q.sew (slam (slap syg [%cnzy %load]) (slap rig [%cnzy %stay]))) :: ++ wink :: deploy |= [now=@da eny=@ ski=sled] - =+ rig=(slym ves +<) :: activate vane + =+ rig=(slym q.sew +<) :: activate vane ~% %wink +>+> ~ |% ++ doze @@ -9738,10 +9739,13 @@ ++ sike :: check metatype ~/ %sike |= [sub=type ref=*] - ^- ? - :: ?: =(~ ~) & - =+ gat=|=([a=type b=type] (~(nest ut a) | b)) - (,? .*(gat(+< [sub ref]) -.gat)) + ^- (pair ,? veal) + ?: (~(has in p.sew) [sub ref]) [& p.sew] + =+ ^= hip + =+ gat=|=([a=type b=type] (~(nest ut a) | b)) + (,? .*(gat(+< [sub ref]) -.gat)) + ?. hip [| p.sew] + [& (~(put in p.sew) [sub ref])] :: ++ slid |= [hed=mill tal=mill] @@ -9758,21 +9762,25 @@ | [%| [%cell typ.vil p.p.hil] p.hil] == :: - ++ slur + ++ slur :: call gate on |= [gat=vase hil=mill] - ^- (unit vase) + ^- (unit (pair vase veal)) =+ sam=(slot 6 gat) - ?. ?- -.hil - & (souk p.sam p.p.hil) - | (sike p.sam p.p.hil) - == ~ - `(slym gat +>.hil) + =+ ^= hig + ?- -.hil + & (souk p.sam p.p.hil) + | (sike p.sam p.p.hil) + == + ?.(p.hig ~ `[(slym gat +>.hil) q.hig]) :: ++ souk :: check type ~/ %souk |= [sub=type ref=type] - :: ?: =(~ ~) & - (~(nest ut sub) | ref) + ^- (pair ,? veal) + ?: (~(has in p.sew) [sub ref]) [& p.sew] + =+ hip=(~(nest ut sub) | ref) + ?. hip [| p.sew] + [& (~(put in p.sew) [sub ref])] :: ++ sunk :: type is cell |= ref=type @@ -9782,31 +9790,35 @@ ++ song :: reduce metacard ~/ %song :: |= mex=vase :: mex: vase of card - ^- (unit mill) :: - ?. (sunk p.mex) ~ :: a card is a cell - ?. ?=(%meta -.q.mex) `[%& mex] :: ordinary card + ^- (unit (pair mill veal)) :: + =^ hip p.sew (sunk p.mex) :: + ?. hip ~ :: a card is a cell + ?. ?=(%meta -.q.mex) `[[%& mex] p.sew] :: ordinary card =+ tiv=(slot 3 mex) :: tiv: vase of vase - ?. (sunk p.tiv) ~ :: a vase is a cell - ?. (souk typ.vil p:(slot 2 tiv)) ~ :: vase head is type - %- biff :_ |=(a=milt `[%| a]) :: milt to mill + =^ hip p.sew (sunk p.tiv) :: + ?. hip ~ :: a vase is a cell + =^ hip p.sew (souk typ.vil p:(slot 2 tiv)) :: + ?. hip ~ :: vase head is type + %- biff :_ |=(a=milt `[[%| a] p.sew]) :: milt to mill =+ mut=(milt q.tiv) :: card type, value |- ^- (unit milt) :: ?. ?=([%meta p=* q=milt] q.mut) `mut :: ordinary metacard - ?. (sike mev.vil p.mut) ~ :: meta-metacard + =^ hip p.sew (sike mev.vil p.mut) :: + ?. hip ~ :: meta-metacard $(mut +.q.mut) :: descend into meta :: ++ sump :: vase to move ~/ %sump |= wec=vase - ^- (unit move) + ^- (unit (pair move veal)) %+ biff ((soft duct) -.q.wec) |= a=duct - %- bind :_ |=(b=arvo `move`[a b]) + %- bind :_ |=(b=(pair arvo veal) [`move`[a p.b] q.b]) =- ?- -.har | ~& [%dead-card p.har] ~ :: XX properly log? & (some p.har) == - ^= har ^- (each arvo term) + ^= har ^- (each (pair arvo veal) term) =+ caq=(spec (slot 3 wec)) ?+ q.caq [%| (cat 3 %funk (,@tas q.caq))] :: @@ -9818,20 +9830,20 @@ %+ biff ((soft path) p.q.caq) |= pax=path %+ bind (song (spec (slot 15 caq))) - |= hil=mill - [%& %pass pax lal hil] + |= [hil=mill vel=veal] + [%& [%pass pax lal hil] vel] :: [%give p=[p=@tas q=*]] %- (bond |.([%| p.p.q.caq])) %+ bind (song (spec (slot 3 caq))) - |= hil=mill - [%& %give hil] + |= [hil=mill vel=veal] + [%& [%give hil] vel] :: [%sick p=[p=@tas q=*]] %- (bond |.([%| p.p.q.caq])) %+ bind (song (spec (slot 3 caq))) - |= hil=mill - [%& %sick hil] + |= [hil=mill vel=veal] + [%& [%sick hil] vel] :: [%slip p=@tas q=[p=@tas q=*]] %- (bond |.([%| p.q.q.caq])) @@ -9839,15 +9851,17 @@ |= lal=@tas ?. ((sane %tas) lal) ~ %+ bind (song (spec (slot 7 caq))) - |= hil=mill - [%& %slip lal hil] + |= [hil=mill vel=veal] + [%& [%slip lal hil] vel] == :: ++ said :: vase to (list move) |= vud=vase - |- ^- (list move) - ?: =(~ q.vud) ~ - [(need (sump (slot 2 vud))) $(vud (slot 3 vud))] + |- ^- (pair (list move) veal) + ?: =(~ q.vud) [~ p.sew] + =^ mov p.sew (need (sump (slot 2 vud))) + =^ moz p.sew $(vud (slot 3 vud)) + [[mov moz] p.sew] :: ++ scry :: read namespace ~/ %scry @@ -9861,7 +9875,7 @@ :* fur ren p.bed - q.bed + q.bed `coin`[%$ r.bed] (flop s.bed) == @@ -9875,8 +9889,8 @@ ++ soar :: scrub vane |= sev=vase ^- vase - ?: &(=(-.q.ves -.q.sev) =(+>.q.ves +>.q.sev)) - ves :: unchanged, use old + ?: &(=(-.q.q.sew -.q.sev) =(+>.q.q.sew +>.q.sev)) + q.sew :: unchanged, use old sev(+<.q [*@da *@ =>(~ |+(* ~))]) :: clear to stop leak :: ++ swim @@ -9886,7 +9900,7 @@ hen=duct hil=mill == - ^- [p=(list move) q=vase] + ^- [[p=(list move) q=veal] q=vase] =+ ^= pru ?~ pux ~| [%swim-call-vane lal] @@ -9901,8 +9915,8 @@ == ?~ pru ~& [%swim-lost lal (,@tas +>-.hil)] - [~ ves] - =+ pro=(need pru) + [[~ p.sew] q.sew] + =^ pro p.sew (need pru) :- (said (slap pro [%cnzy %p])) (soar (slap pro [%cnzy %q])) -- @@ -9910,7 +9924,7 @@ :: ++ vint :: create vane |= [lal=@tas vil=vile bud=vase pax=path txt=@ta] :: - (vent lal vil bud (slym (slap bud (rain pax txt)) bud)) + (vent lal vil bud ~ (slym (slap bud (rain pax txt)) bud)) :: ++ viol :: vane tools |= but=type @@ -9923,7 +9937,7 @@ == :: ++ is :: operate in time - |= [vil=vile eny=@ bud=vase fan=(list ,[p=@tas q=vase])] + |= [vil=vile eny=@ bud=vase niz=(pair veal (list ,[p=@tas q=vase]))] |_ now=@da ++ beck ^- sled @@ -9933,14 +9947,14 @@ =+ lal=(end 3 1 ron) =+ ren=(care (rsh 3 1 ron)) |- ^- (unit (unit cage)) - ?~ fan ~ - ?. =(lal p.i.fan) $(fan t.fan) - %- scry:(wink:(vent lal vil bud q.i.fan) now (shax now) ..^$) + ?~ q.niz ~ + ?. =(lal p.i.q.niz) $(q.niz t.q.niz) + %- scry:(wink:(vent lal vil bud p.niz q.i.q.niz) now (shax now) ..^$) [fur ren bed] :: ++ dink :: vase by char |= din=@tas ^- vase - ?~(fan !! ?:(=(din p.i.fan) q.i.fan $(fan t.fan))) + ?~(q.niz !! ?:(=(din p.i.q.niz) q.i.q.niz $(q.niz t.q.niz))) :: ++ dint :: input routing |= hap=path ^- @tas @@ -9956,7 +9970,7 @@ ++ doos :: sleep until |= hap=path ^- (unit ,@da) =+ lal=(dint hap) - (doze:(wink:(vent lal vil bud (dink lal)) now 0 beck) now [hap ~]) + (doze:(wink:(vent lal vil bud p.niz (dink lal)) now 0 beck) now [hap ~]) :: ++ hurl :: start loop |= [lac=? ovo=ovum] @@ -9976,27 +9990,27 @@ :: ++ race :: take |= [org=@tas lal=@tas pux=(unit wire) hen=duct hil=mill ves=vase] - ^- [p=(list move) q=vase] - =+ ven=(vent lal vil bud ves) + ^- [p=[p=(list move) q=veal] q=vase] + =+ ven=(vent lal vil bud [p.niz ves]) =+ win=(wink:ven now (shax now) beck) (swim:win org pux hen hil) :: ++ fire :: execute |= [org=term lal=term pux=(unit wire) hen=duct hil=mill] ?: &(?=(^ pux) ?=(~ hen)) - [[[[lal u.pux] (curd +>.hil)]~ ~] fan] - =+ naf=fan - |- ^- [[p=(list ovum) q=(list muse)] _fan] - ?~ naf [[~ ~] ~] + [[[[lal u.pux] (curd +>.hil)]~ ~] niz] + =+ naf=q.niz + |- ^- [[p=(list ovum) q=(list muse)] _niz] + ?~ naf [[~ ~] [p.niz ~]] ?. =(lal p.i.naf) =+ tuh=$(naf t.naf) - [-.tuh [i.naf +.tuh]] + [-.tuh [+<.tuh [i.naf +>.tuh]]] =+ fiq=(race org lal pux hen hil q.i.naf) - [[~ (turn p.fiq |=(a=move [lal a]))] [[p.i.naf q.fiq] t.naf]] + [[~ (turn p.p.fiq |=(a=move [lal a]))] [q.p.fiq [[p.i.naf q.fiq] t.naf]]] :: ++ jack :: dispatch card |= [lac=? gum=muse] - ^- [[p=(list ovum) q=(list muse)] _fan] + ^- [[p=(list ovum) q=(list muse)] _niz] %+ fire p.gum ?- -.r.gum @@ -10032,8 +10046,8 @@ |= [lac=? mor=(list muse)] =| ova=(list ovum) |- ^- [p=(list ovum) q=(list ,[p=@tas q=vase])] - ?~ mor [(flop ova) fan] - =^ nyx fan (jack lac i.mor) + ?~ mor [(flop ova) q.niz] + =^ nyx niz (jack lac i.mor) $(ova (weld p.nyx ova), mor (weld q.nyx t.mor)) -- -- @@ -10047,7 +10061,7 @@ =+ vil=(viol p.bud) :: cached reflexives =| $: lac=? :: laconic bit eny=@ :: entropy - fan=(list ,[p=@tas q=vase]) :: modules + niz=(pair veal (list ,[p=@tas q=vase])) :: modules == :: =< |% ++ come |= [@ (list ovum) pone] :: 11 @@ -10091,13 +10105,13 @@ ++ keep :: wakeup delay |= [now=@da hap=path] => .(+< ((hard ,[now=@da hap=path]) +<)) - (~(doos (is vil eny bud fan) now) hap) + (~(doos (is vil eny bud niz) now) hap) :: ++ load :: load compatible |= [yen=@ ova=(list ovum) nyf=pane] ^+ [ova +>] =: eny yen - fan nyf + q.niz nyf == |- ^+ [ova +>.^$] ?~ ova @@ -10112,7 +10126,7 @@ |= [now=@da hap=path] ^- (unit) ?~ hap [~ hoon] - =+ rob=((slod ~(beck (is vil eny bud fan) now)) hap) + =+ rob=((slod ~(beck (is vil eny bud niz) now)) hap) ?~ rob ~ ?~ u.rob ~ [~ u.u.rob] @@ -10122,8 +10136,8 @@ =. eny (mix eny (shax now)) :: ~& [%poke -.q.ovo] ^- [(list ovum) _+>] - =^ zef fan - (~(hurl (is vil eny bud fan) now) lac ovo) + =^ zef q.niz + (~(hurl (is vil eny bud niz) now) lac ovo) [zef +>.$] :: ++ vega :: reboot kernel @@ -10142,7 +10156,7 @@ ~& [%vega-compiled hoon nex] ?> (lte nex hoon) =+ gat=.*(ken .*(ken [0 ?:(=(nex hoon) 86 11)])) - =+ sam=[eny ova fan] + =+ sam=[eny ova q.niz] =+ raw=.*([-.gat [sam +>.gat]] -.gat) [[[~ %vega hap] ((list ovum) -.raw)] +.raw] :: @@ -10155,15 +10169,17 @@ =+ vax=(slap pit gen) +>.$(bud vax) %_ +> - fan - |- ^+ fan - ?~ fan + q.niz + |- ^+ q.niz + ?~ q.niz ~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)] - [[lal.fav ves:(vint lal.fav vil bud pax.fav txt.fav)] fan] - ?. =(lal.fav p.i.fan) - [i.fan $(fan t.fan)] + [[lal.fav q.sew:(vint lal.fav vil bud pax.fav txt.fav)] q.niz] + ?. =(lal.fav p.i.q.niz) + [i.q.niz $(q.niz t.q.niz)] ~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)] - [[p.i.fan ves:(ruck:(vent lal.fav vil bud q.i.fan) pax.fav txt.fav)] t.fan] + :_ t.q.niz + :- p.i.q.niz + q.sew:(ruck:(vent lal.fav vil bud [p.niz q.i.q.niz]) pax.fav txt.fav) == :: ++ wish :: external compute diff --git a/arvo/kahn.hoon b/arvo/kahn.hoon index 6ab228c51..962f7e8e7 100644 --- a/arvo/kahn.hoon +++ b/arvo/kahn.hoon @@ -62,7 +62,7 @@ =+ lox=((soft axle) old) ^+ ..^$ ?~ lox - ~& %lunt-reset + ~& %khan-reset ..^$ ..^$(+>- u.lox) :: diff --git a/main/app/talk/core.hook b/main/app/talk/core.hook index 9ac0b34ec..082c90c2d 100644 --- a/main/app/talk/core.hook +++ b/main/app/talk/core.hook @@ -27,10 +27,12 @@ ++ story :: persona $: link=(grip bridge) :: connection count=@ud :: message counter - mike=(pair ,? (set station)) :: passive/voice + mike=voice :: current audience quiet=? :: !verbose past=(list station) :: past received auds == :: + ++ voice :: speaking to + (pair (unit (set station)) (set station)) :: active/passive ++ bridge :: remote state $: xm=config :: configuration am=register :: presence @@ -325,7 +327,7 @@ %_(+>.$ moz hy-abet:(hy-display:(hype moz) (flop tay))) :: ++ sy-prompt - |= tou=(set station) + |= [pas=? tou=(set station)] ^- tape ;: welp (scow %p our.hid) @@ -630,7 +632,7 @@ :: %time :_ +>.$ - ~& [%talk-pour-time lat.hid `@da`(add ~s12 lat.hid)] + :: ~& [%talk-pour-time lat.hid `@da`(add ~s12 lat.hid)] :~ [0 %pass /time %t %wait (add ~s12 lat.hid)] == :: From c694ad1191ec1d3503bbeae8b705d89c3cb25968 Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Tue, 13 Jan 2015 04:40:15 -0800 Subject: [PATCH 09/13] Better caching. --- arvo/hoon.hoon | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 76a69d365..6ef2cc92e 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -9740,7 +9740,8 @@ ~/ %sike |= [sub=type ref=*] ^- (pair ,? veal) - ?: (~(has in p.sew) [sub ref]) [& p.sew] + ?: (~(has in p.sew) [sub ref]) + [& p.sew] =+ ^= hip =+ gat=|=([a=type b=type] (~(nest ut a) | b)) (,? .*(gat(+< [sub ref]) -.gat)) @@ -9777,7 +9778,8 @@ ~/ %souk |= [sub=type ref=type] ^- (pair ,? veal) - ?: (~(has in p.sew) [sub ref]) [& p.sew] + ?: (~(has in p.sew) [sub ref]) + [& p.sew] =+ hip=(~(nest ut sub) | ref) ?. hip [| p.sew] [& (~(put in p.sew) [sub ref])] @@ -9799,10 +9801,11 @@ ?. hip ~ :: a vase is a cell =^ hip p.sew (souk typ.vil p:(slot 2 tiv)) :: ?. hip ~ :: vase head is type - %- biff :_ |=(a=milt `[[%| a] p.sew]) :: milt to mill + %- biff :: + :_ |=(a=(pair milt veal) `[[%| p.a] q.a]) :: milt to mill =+ mut=(milt q.tiv) :: card type, value - |- ^- (unit milt) :: - ?. ?=([%meta p=* q=milt] q.mut) `mut :: ordinary metacard + |- ^- (unit (pair milt veal)) :: + ?. ?=([%meta p=* q=milt] q.mut) `[mut p.sew] :: ordinary metacard =^ hip p.sew (sike mev.vil p.mut) :: ?. hip ~ :: meta-metacard $(mut +.q.mut) :: descend into meta @@ -9901,6 +9904,7 @@ hil=mill == ^- [[p=(list move) q=veal] q=vase] + :: ~& [%swim-wyt `@ud`~(wyt in p.sew)] =+ ^= pru ?~ pux ~| [%swim-call-vane lal] @@ -9975,7 +9979,7 @@ ++ hurl :: start loop |= [lac=? ovo=ovum] ~? &(!lac !=(%belt -.q.ovo)) [%unix -.q.ovo p.ovo] - ^- [p=(list ovum) q=(list ,[p=@tas q=vase])] + ^- [p=(list ovum) q=(pair veal (list ,[p=@tas q=vase]))] ?> ?=(^ p.ovo) %+ kick lac :~ :* i.p.ovo @@ -10006,6 +10010,7 @@ =+ tuh=$(naf t.naf) [-.tuh [+<.tuh [i.naf +>.tuh]]] =+ fiq=(race org lal pux hen hil q.i.naf) + :: ~& [%fire-veal [`@ud`~(wyt in p.niz) `@ud`~(wyt in q.p.fiq)]] [[~ (turn p.p.fiq |=(a=move [lal a]))] [q.p.fiq [[p.i.naf q.fiq] t.naf]]] :: ++ jack :: dispatch card @@ -10045,8 +10050,8 @@ ++ kick :: new main loop |= [lac=? mor=(list muse)] =| ova=(list ovum) - |- ^- [p=(list ovum) q=(list ,[p=@tas q=vase])] - ?~ mor [(flop ova) q.niz] + |- ^- [p=(list ovum) q=(pair veal (list ,[p=@tas q=vase]))] + ?~ mor [(flop ova) niz] =^ nyx niz (jack lac i.mor) $(ova (weld p.nyx ova), mor (weld q.nyx t.mor)) -- @@ -10136,7 +10141,7 @@ =. eny (mix eny (shax now)) :: ~& [%poke -.q.ovo] ^- [(list ovum) _+>] - =^ zef q.niz + =^ zef niz (~(hurl (is vil eny bud niz) now) lac ovo) [zef +>.$] :: From 29cec7719e88e80e60c9d2f80df908b9b7f0803d Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Thu, 15 Jan 2015 11:10:29 -0800 Subject: [PATCH 10/13] Memory and other optimizations. --- arvo/hoon.hoon | 220 +++++++++++++++++++++++++----------- main/app/talk/core.hook | 14 +-- main/app/terminal/core.hook | 2 +- 3 files changed, 159 insertions(+), 77 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 6ef2cc92e..c51820e07 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -417,7 +417,11 @@ [%unit p=term q=wine] :: == :: ++ wonk |*(veq=edge ?~(q.veq !! p.u.q.veq)) :: -:: :: +++ worm :: compiler cache + $: nes=(set ,^) :: ++nest + pay=(map (pair type twig) type) :: ++play + mit=(map (pair type twig) (pair type nock)) :: ++mint + == :: :: :: ++ map |* [a=_,* b=_,*] :: associative tree $|(~ [n=[p=a q=b] l=(map a b) r=(map a b)]) :: @@ -6126,6 +6130,71 @@ ++ wash :: render tank at width |= [[tab=@ edg=@] tac=tank] ^- wall (~(win re tac) tab edg) +:: +++ wa :: cached compile + !: + |_ worm + ++ nell |=(ref=type (nest [%cell %noun %noun] ref)) :: nest in cell + ++ nest :: nest:ut + |= [sut=type ref=type] + ^- [? worm] + ?: (~(has in nes) [sut ref]) [& +>+<] + ?. (~(nest ut sut) | ref) [| +>+<] + [& +>+<(nes (~(put in nes) [sut ref]))] + :: + ++ nets :: typeless nest + |= [sut=type ref=*] + ^- [? worm] + ?: (~(has in nes) [sut ref]) [& +>+<] + =+ gat=|=([a=type b=type] (~(nest ut a) | b)) + ?. (,? .*(gat(+< [sut ref]) -.gat)) + [| +>+<.$] + [& +>+<.$(nes (~(put in nes) [sut ref]))] + :: + ++ play :: play:ut + |= [sut=type gen=twig] + ^- [type worm] + =+ old=(~(get by pay) [sut gen]) + ?^ old [u.old +>+<.$] + =+ new=(~(play ut sut) gen) + [new +>+<.$(pay (~(put by pay) [sut gen] new))] + :: + ++ mint :: mint:ut to noun + |= [sut=type gen=twig] + ^- [(pair type nock) worm] + =+ old=(~(get by mit) [sut gen]) + ?^ old [u.old +>+<.$] + =+ new=(~(mint ut sut) %noun gen) + [new +>+<.$(mit (~(put by mit) [sut gen] new))] + :: + ++ slap :: ++slap, cached + |= [vax=vase gen=twig] + ^- [vase worm] + =^ gun +>+< (mint p.vax gen) + [[p.gun .*(q.vax q.gun)] +>+<.$] + :: + ++ slot :: ++slot, cached + |= [axe=@ vax=vase] + ^- [vase worm] + =^ gun +>+< (mint p.vax [%$ axe]) + [[p.gun .*(q.vax [0 axe])] +>+<.$] + :: + ++ spec :: specialize vase + |= vax=vase + ^- [vase worm] + =+ ^= gen ^- twig + ?@ q.vax [%wtts [%axil [%atom %$]] [%$ 1]~] + ?@ -.q.vax [%wtts [%leaf %tas -.q.vax] [%$ 2]~] + [%wtts [%axil %cell] [%$ 1]~] + =^ typ +>+<.$ (play p.vax [%wtgr gen [%$ 1]]) + [[typ q.vax] +>+<.$] + :: + ++ spot :: slot and spec + |= [axe=@ vax=vase] + ^- [vase worm] + =^ xav +>+< (slot axe vax) + (spec xav) + -- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: section 2fB, macro expansion :: :: @@ -9481,6 +9550,8 @@ glu=@ud :: samples in glue mal=@ud :: samples in alloc far=@ud :: samples in frag + coy=@ud :: samples in copy + euq=@ud :: samples in equal == :: :: ++ hump @@ -9524,10 +9595,12 @@ %glu mon(glu +(glu.mon)) %mal mon(mal +(mal.mon)) %far mon(far +(far.mon)) + %coy mon(coy +(coy.mon)) + %euq mon(euq +(euq.mon)) == ++ pi-moth :: count sample |= mon=moan ^- @ud - :(add fun.mon noc.mon glu.mon mal.mon far.mon) + :(add fun.mon noc.mon glu.mon mal.mon far.mon coy.mon euq.mon) :: ++ pi-mumm :: print sample |= mon=moan ^- tape @@ -9552,6 +9625,14 @@ ^- tape ?: =(0 far.mon) ~ (welp (scow %ud (div (mul 100 far.mon) tot)) "f ") + :: + ^- tape + ?: =(0 coy.mon) ~ + (welp (scow %ud (div (mul 100 coy.mon) tot)) "y ") + :: + ^- tape + ?: =(0 euq.mon) ~ + (welp (scow %ud (div (mul 100 euq.mon) tot)) "e ") == :: ++ pi-tell :: produce dump @@ -9678,7 +9759,6 @@ ++ sled $+ [(unit (set monk)) term beam] :: namespace function (unit (unit cage)) :: ++ slut $+(* (unit (unit))) :: old namespace -++ veal (set ,^) :: actually pair type ++ vile :: reflexive constants $: typ=type :: -:!>(*type) duc=type :: -:!>(*duct) @@ -9714,7 +9794,7 @@ :: section 3bE, Arvo core :: :: ++ vent :: vane core - |= [lal=@tas vil=vile bud=vase sew=(pair veal vase)] + |= [lal=@tas vil=vile bud=vase sew=(pair worm vase)] ~% %vent +>+ ~ |% ++ ruck :: update vase @@ -9736,18 +9816,6 @@ ^- (unit ,@da) ((hard (unit ,@da)) q:(slym (slap rig [%cnzy %doze]) +<)) :: - ++ sike :: check metatype - ~/ %sike - |= [sub=type ref=*] - ^- (pair ,? veal) - ?: (~(has in p.sew) [sub ref]) - [& p.sew] - =+ ^= hip - =+ gat=|=([a=type b=type] (~(nest ut a) | b)) - (,? .*(gat(+< [sub ref]) -.gat)) - ?. hip [| p.sew] - [& (~(put in p.sew) [sub ref])] - :: ++ slid |= [hed=mill tal=mill] ^- mill @@ -9765,64 +9833,72 @@ :: ++ slur :: call gate on |= [gat=vase hil=mill] - ^- (unit (pair vase veal)) + ^- (unit (pair vase worm)) =+ sam=(slot 6 gat) =+ ^= hig ?- -.hil - & (souk p.sam p.p.hil) - | (sike p.sam p.p.hil) + & (~(nest wa p.sew) p.sam p.p.hil) + | (~(nets wa p.sew) p.sam p.p.hil) == - ?.(p.hig ~ `[(slym gat +>.hil) q.hig]) + ?.(-.hig ~ `[(slym gat +>.hil) +.hig]) :: - ++ souk :: check type - ~/ %souk - |= [sub=type ref=type] - ^- (pair ,? veal) - ?: (~(has in p.sew) [sub ref]) - [& p.sew] - =+ hip=(~(nest ut sub) | ref) - ?. hip [| p.sew] - [& (~(put in p.sew) [sub ref])] + ++ slur-a ~/(%slur-a |=([gat=vase hil=mill] (slur gat hil))) + ++ slur-b ~/(%slur-b |=([gat=vase hil=mill] (slur gat hil))) + ++ slur-c ~/(%slur-c |=([gat=vase hil=mill] (slur gat hil))) + ++ slur-d ~/(%slur-d |=([gat=vase hil=mill] (slur gat hil))) + ++ slur-e ~/(%slur-e |=([gat=vase hil=mill] (slur gat hil))) + ++ slur-f ~/(%slur-f |=([gat=vase hil=mill] (slur gat hil))) + ++ slur-g ~/(%slur-g |=([gat=vase hil=mill] (slur gat hil))) + ++ slur-z ~/(%slur-z |=([gat=vase hil=mill] (slur gat hil))) :: - ++ sunk :: type is cell - |= ref=type - :: ?: =(~ ~) & - (souk [%cell %noun %noun] ref) + ++ slur-pro :: profiling slur + ~/ %slur-pro + |= [lal=@tas gat=vase hil=mill] + ?+ lal (slur-z gat hil) + %a (slur-a gat hil) + %b (slur-b gat hil) + %c (slur-c gat hil) + %d (slur-d gat hil) + %e (slur-e gat hil) + %f (slur-f gat hil) + %g (slur-g gat hil) + == :: ++ song :: reduce metacard ~/ %song :: |= mex=vase :: mex: vase of card - ^- (unit (pair mill veal)) :: - =^ hip p.sew (sunk p.mex) :: + ^- (unit (pair mill worm)) :: + =^ hip p.sew (~(nell wa p.sew) p.mex) :: ?. hip ~ :: a card is a cell ?. ?=(%meta -.q.mex) `[[%& mex] p.sew] :: ordinary card - =+ tiv=(slot 3 mex) :: tiv: vase of vase - =^ hip p.sew (sunk p.tiv) :: + =^ tiv p.sew (~(slot wa p.sew) 3 mex) :: + =^ hip p.sew (~(nell wa p.sew) p.tiv) :: ?. hip ~ :: a vase is a cell - =^ hip p.sew (souk typ.vil p:(slot 2 tiv)) :: + =^ vax p.sew (~(slot wa p.sew) 2 tiv) :: + =^ hip p.sew (~(nest wa p.sew) typ.vil p.vax) :: ?. hip ~ :: vase head is type %- biff :: - :_ |=(a=(pair milt veal) `[[%| p.a] q.a]) :: milt to mill + :_ |=(a=(pair milt worm) `[[%| p.a] q.a]) :: milt to mill =+ mut=(milt q.tiv) :: card type, value - |- ^- (unit (pair milt veal)) :: + |- ^- (unit (pair milt worm)) :: ?. ?=([%meta p=* q=milt] q.mut) `[mut p.sew] :: ordinary metacard - =^ hip p.sew (sike mev.vil p.mut) :: + =^ hip p.sew (~(nets wa p.sew) mev.vil p.mut) :: ?. hip ~ :: meta-metacard $(mut +.q.mut) :: descend into meta :: ++ sump :: vase to move ~/ %sump |= wec=vase - ^- (unit (pair move veal)) + ^- (unit (pair move worm)) %+ biff ((soft duct) -.q.wec) |= a=duct - %- bind :_ |=(b=(pair arvo veal) [`move`[a p.b] q.b]) + %- bind :_ |=(b=(pair arvo worm) [`move`[a p.b] q.b]) =- ?- -.har | ~& [%dead-card p.har] ~ :: XX properly log? & (some p.har) == - ^= har ^- (each (pair arvo veal) term) - =+ caq=(spec (slot 3 wec)) + ^= har ^- (each (pair arvo worm) term) + =^ caq p.sew (~(spot wa p.sew) 3 wec) ?+ q.caq [%| (cat 3 %funk (,@tas q.caq))] :: [%pass p=* q=@tas r=[p=@tas q=*]] @@ -9832,20 +9908,23 @@ ?. ((sane %tas) lal) ~ %+ biff ((soft path) p.q.caq) |= pax=path - %+ bind (song (spec (slot 15 caq))) - |= [hil=mill vel=veal] + =^ yav p.sew (~(spot wa p.sew) 15 caq) + %+ bind (song yav) + |= [hil=mill vel=worm] [%& [%pass pax lal hil] vel] :: [%give p=[p=@tas q=*]] %- (bond |.([%| p.p.q.caq])) - %+ bind (song (spec (slot 3 caq))) - |= [hil=mill vel=veal] + =^ yav p.sew (~(spot wa p.sew) 3 caq) + %+ bind (song yav) + |= [hil=mill vel=worm] [%& [%give hil] vel] :: [%sick p=[p=@tas q=*]] %- (bond |.([%| p.p.q.caq])) - %+ bind (song (spec (slot 3 caq))) - |= [hil=mill vel=veal] + =^ yav p.sew (~(spot wa p.sew) 3 caq) + %+ bind (song yav) + |= [hil=mill vel=worm] [%& [%sick hil] vel] :: [%slip p=@tas q=[p=@tas q=*]] @@ -9853,17 +9932,20 @@ %+ biff ((soft ,@) p.q.caq) |= lal=@tas ?. ((sane %tas) lal) ~ - %+ bind (song (spec (slot 7 caq))) - |= [hil=mill vel=veal] + =^ yav p.sew (~(spot wa p.sew) 7 caq) + %+ bind (song yav) + |= [hil=mill vel=worm] [%& [%slip lal hil] vel] == :: ++ said :: vase to (list move) |= vud=vase - |- ^- (pair (list move) veal) + |- ^- (pair (list move) worm) ?: =(~ q.vud) [~ p.sew] - =^ mov p.sew (need (sump (slot 2 vud))) - =^ moz p.sew $(vud (slot 3 vud)) + =^ hed p.sew (~(slot wa p.sew) 2 vud) + =^ tal p.sew (~(slot wa p.sew) 3 vud) + =^ mov p.sew (need (sump hed)) + =^ moz p.sew $(vud tal) [[mov moz] p.sew] :: ++ scry :: read namespace @@ -9903,15 +9985,17 @@ hen=duct hil=mill == - ^- [[p=(list move) q=veal] q=vase] + ^- [[p=(list move) q=worm] q=vase] :: ~& [%swim-wyt `@ud`~(wyt in p.sew)] =+ ^= pru ?~ pux ~| [%swim-call-vane lal] - %+ slur (slap rig [%cnzy %call]) + =^ vax p.sew (~(slap wa p.sew) rig [%cnzy %call]) + %^ slur-pro lal vax (slid [%& duc.vil hen] (slix hil)) ~| [%swim-take-vane lal] - %+ slur (slap rig [%cnzy %take]) + =^ vax p.sew (~(slap wa p.sew) rig [%cnzy %take]) + %^ slur-pro lal vax ;: slid [%& pah.vil u.pux] [%& duc.vil hen] @@ -9921,14 +10005,15 @@ ~& [%swim-lost lal (,@tas +>-.hil)] [[~ p.sew] q.sew] =^ pro p.sew (need pru) - :- (said (slap pro [%cnzy %p])) - (soar (slap pro [%cnzy %q])) + =^ moz p.sew (~(slap wa p.sew) pro [%cnzy %p]) + =^ vem p.sew (~(slap wa p.sew) pro [%cnzy %q]) + [(said moz) (soar vem)] -- -- :: ++ vint :: create vane |= [lal=@tas vil=vile bud=vase pax=path txt=@ta] :: - (vent lal vil bud ~ (slym (slap bud (rain pax txt)) bud)) + (vent lal vil bud *worm (slym (slap bud (rain pax txt)) bud)) :: ++ viol :: vane tools |= but=type @@ -9941,7 +10026,7 @@ == :: ++ is :: operate in time - |= [vil=vile eny=@ bud=vase niz=(pair veal (list ,[p=@tas q=vase]))] + |= [vil=vile eny=@ bud=vase niz=(pair worm (list ,[p=@tas q=vase]))] |_ now=@da ++ beck ^- sled @@ -9979,7 +10064,7 @@ ++ hurl :: start loop |= [lac=? ovo=ovum] ~? &(!lac !=(%belt -.q.ovo)) [%unix -.q.ovo p.ovo] - ^- [p=(list ovum) q=(pair veal (list ,[p=@tas q=vase]))] + ^- [p=(list ovum) q=(pair worm (list ,[p=@tas q=vase]))] ?> ?=(^ p.ovo) %+ kick lac :~ :* i.p.ovo @@ -9994,7 +10079,7 @@ :: ++ race :: take |= [org=@tas lal=@tas pux=(unit wire) hen=duct hil=mill ves=vase] - ^- [p=[p=(list move) q=veal] q=vase] + ^- [p=[p=(list move) q=worm] q=vase] =+ ven=(vent lal vil bud [p.niz ves]) =+ win=(wink:ven now (shax now) beck) (swim:win org pux hen hil) @@ -10010,7 +10095,6 @@ =+ tuh=$(naf t.naf) [-.tuh [+<.tuh [i.naf +>.tuh]]] =+ fiq=(race org lal pux hen hil q.i.naf) - :: ~& [%fire-veal [`@ud`~(wyt in p.niz) `@ud`~(wyt in q.p.fiq)]] [[~ (turn p.p.fiq |=(a=move [lal a]))] [q.p.fiq [[p.i.naf q.fiq] t.naf]]] :: ++ jack :: dispatch card @@ -10050,7 +10134,7 @@ ++ kick :: new main loop |= [lac=? mor=(list muse)] =| ova=(list ovum) - |- ^- [p=(list ovum) q=(pair veal (list ,[p=@tas q=vase]))] + |- ^- [p=(list ovum) q=(pair worm (list ,[p=@tas q=vase]))] ?~ mor [(flop ova) niz] =^ nyx niz (jack lac i.mor) $(ova (weld p.nyx ova), mor (weld q.nyx t.mor)) @@ -10066,7 +10150,7 @@ =+ vil=(viol p.bud) :: cached reflexives =| $: lac=? :: laconic bit eny=@ :: entropy - niz=(pair veal (list ,[p=@tas q=vase])) :: modules + niz=(pair worm (list ,[p=@tas q=vase])) :: modules == :: =< |% ++ come |= [@ (list ovum) pone] :: 11 diff --git a/main/app/talk/core.hook b/main/app/talk/core.hook index 082c90c2d..ee878dde5 100644 --- a/main/app/talk/core.hook +++ b/main/app/talk/core.hook @@ -27,12 +27,10 @@ ++ story :: persona $: link=(grip bridge) :: connection count=@ud :: message counter - mike=voice :: current audience + mike=(pair ,? (set station)) :: passive/voice quiet=? :: !verbose past=(list station) :: past received auds == :: - ++ voice :: speaking to - (pair (unit (set station)) (set station)) :: active/passive ++ bridge :: remote state $: xm=config :: configuration am=register :: presence @@ -327,11 +325,11 @@ %_(+>.$ moz hy-abet:(hy-display:(hype moz) (flop tay))) :: ++ sy-prompt - |= [pas=? tou=(set station)] + |= tou=(set station) ^- tape ;: welp (scow %p our.hid) - ?:(=(man (main our.hid)) "" `tape`(welp "/" (trip man))) + ?:(=(man (main our.hid)) "" `tape`:(welp "/" (trip man))) ?~ tou "& " `tape`:(welp "(" (swatch our.hid tou) ")& ") == @@ -632,8 +630,8 @@ :: %time :_ +>.$ - :: ~& [%talk-pour-time lat.hid `@da`(add ~s12 lat.hid)] - :~ [0 %pass /time %t %wait (add ~s12 lat.hid)] + :: ~& [%talk-pour-time lat.hid `@da`(add ~s10 lat.hid)] + :~ [0 %pass /time %t %wait (add ~s10 lat.hid)] == :: %fm @@ -650,7 +648,7 @@ ^- [(list move) _+>] :_ +> :~ [0 %pass /cmd-in %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]] - [0 %pass /time %t %wait (add ~s13 lat.hid)] + [0 %pass /time %t %wait (add ~s10 lat.hid)] [0 %pass /cmd-ac %g %show [our.hid +.imp.hid] you /active/[-.imp.hid]] ^- move :* 0 %pass /server diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 319d82588..127ef62e2 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -124,7 +124,7 @@ ?- gal %term [ost %give %rust %hymn page] :: hymn front end %lines [ost %give %rust %term-line tel] :: term-line output - == + == == :: ++ poke From b6c7b64d77532daca121ad9b4e47f80cd62658e1 Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Thu, 15 Jan 2015 11:25:22 -0800 Subject: [PATCH 11/13] A little more cleanup. --- arvo/ford.hoon | 178 +++++++++++++++++++++---------------------------- 1 file changed, 77 insertions(+), 101 deletions(-) diff --git a/arvo/ford.hoon b/arvo/ford.hoon index de4fec3e1..7d5aa3b39 100644 --- a/arvo/ford.hoon +++ b/arvo/ford.hoon @@ -193,76 +193,6 @@ =+ gib=(wox p.n.r.arc) ?~(gib rac [[u.gib p.n.r.arc] rac]) :: --- -. == -=| axle -=* lex - -|= [now=@da eny=@ ski=sled] :: activate -^? :: opaque core -~% %ford-d +>+>+>+>+>+> ~ -|% :: -++ call :: request - ~/ %call - |= [hen=duct hic=(hypo (hobo kiss))] - ^- [p=(list move) q=_..^$] - => .(q.hic ?.(?=(%soft -.q.hic) q.hic ((hard kiss) p.q.hic))) - =+ ska=(slod ski) - =+ ^= our ^- @p - ?- -.q.hic - %exec p.q.hic - == - =+ ^= bay ^- baby - =+ buy=(~(get by pol.lex) our) - ?~(buy *baby u.buy) - =^ mos bay - abet:(~(apex za [[our ~ hen] [now eny ska] ~] bay) q.q.hic) - [mos ..^$(pol (~(put by pol) our bay))] -:: -++ doze - |= [now=@da hen=duct] - ^- (unit ,@da) - ~ -:: -++ load :: highly forgiving - |= old=* - =. old - ?. ?=([%0 *] old) old :: remove at 1 - :- %1 - |- ^- * - ?~ +.old ~ - ?> ?=([n=[p=* q=[tad=* dym=* jav=*]] l=* r=*] +.old) - :- [p.n.+.old [tad.q.n.+.old dym.q.n.+.old ~]] - [$(+.old l.+.old) $(+.old r.+.old)] - =+ lox=((soft axle) old) - ^+ ..^$ - ?~ lox - ~& %ford-reset - ..^$ - ..^$(+>- u.lox) -:: -++ scry - |= [fur=(unit (set monk)) ren=@tas who=ship syd=desk lot=coin tyl=path] - ^- (unit (unit (pair mark ,*))) - ~ -:: -++ stay :: save w/o cache - `axle`+>-.$(pol (~(run by pol) |=(a=baby [tad.a dym.a ~]))) -:: -++ take :: response - ~/ %take - |= [tea=wire hen=duct hin=(hypo sign)] - ^- [p=(list move) q=_..^$] - =+ ska=(slod ski) - ?> ?=([@ @ @ ~] tea) - =+ :* our=(need (slaw %p i.tea)) - num=(need (slaw %ud i.t.tea)) - tik=(need (slaw %ud i.t.t.tea)) - == - =+ bay=(need (~(get by pol.lex) our)) - =^ mos bay - abet:(~(axon za [[our tea hen] [now eny ska] ~] bay) num tik q.hin) - [mos ..^$(pol (~(put by pol) our bay))] -:: ++ za :: per event =| $: $: $: our=ship :: computation owner tea=wire :: event place @@ -276,7 +206,6 @@ == :: bay=baby :: all owned state == :: - ~% %za +> ~ |% ++ abet :: resolve ^- [(list move) baby] @@ -312,7 +241,6 @@ == :: ++ zo - ~% %zo +> ~ |_ [num=@ud task] ++ abet %_(..zo q.tad.bay (~(put by q.tad.bay) num +<+)) ++ amok @@ -657,7 +585,6 @@ -- :: ++ kale :: mutate - ~/ %kale |= [cof=cafe kas=silk muy=(list (pair wing silk))] ^- (bolt cage) %+ cope @@ -676,10 +603,9 @@ (fine cof p.cay vax) :: ++ keel :: apply mutations - ~/ %keel |= [cof=cafe suh=vase yom=(list (pair wing vase))] ^- (bolt vase) - %^ maim-a cof + %^ maim cof %+ slop suh |- ^- vase ?~ yom [[%atom %n] ~] @@ -744,7 +670,6 @@ ((lake for [our %main [%da now]]) cof [%noun som]) :: ++ lane :: type infer - ~/ %lane |= [cof=cafe typ=type gen=twig] %+ (cowl cof) (mule |.((~(play ut typ) gen))) |=(ref=type ref) @@ -833,7 +758,7 @@ ?: &((slab %grow p.pro) (slab too p:(slap pro [%cnzy %grow]))) %+ cope (keel cof pro [[%& 6]~ vax]~) |= [cof=cafe pox=vase] - (maim-b cof pox [%tsgr [%cnzy %grow] [%cnzy too]]) + (maim cof pox [%tsgr [%cnzy %grow] [%cnzy too]]) %+ cope (fang cof too bek) |= [cof=cafe pro=vase] =+ ^= zat ^- (unit vase) @@ -887,7 +812,6 @@ ^$(cof cof, for i.yaw, yaw t.yaw, vax yed) :: ++ mail :: cached mint - ~/ %mail |= [cof=cafe sut=type gen=twig] ^- (bolt (pair type nock)) %+ (clef %slim) (fine cof sut gen) @@ -899,7 +823,6 @@ == :: ++ maim :: slap - ~/ %maim |= [cof=cafe vax=vase gen=twig] ^- (bolt vase) %+ cope (mail cof p.vax gen) @@ -907,16 +830,6 @@ %+ (coup cof) (mock [q.vax fol] (mole ska)) |=(val=* `vase`[typ val]) :: - ++ maim-a ~/(%maim-a |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) - ++ maim-b ~/(%maim-b |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) - ++ maim-c ~/(%maim-c |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) - ++ maim-d ~/(%maim-d |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) - ++ maim-e ~/(%maim-e |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) - ++ maim-f ~/(%maim-f |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) - ++ maim-g ~/(%maim-g |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) - ++ maim-h ~/(%maim-h |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) - ++ maim-i ~/(%maim-i |=([cof=cafe vax=vase gen=twig] (maim cof vax gen))) - :: ++ make :: reduce silk |= [cof=cafe kas=silk] ^- (bolt cage) @@ -991,7 +904,7 @@ %+ cool |.(leaf/"ford: ride {<`@p`(mug kas)>}") %+ cope $(kas q.kas) |= [cof=cafe cay=cage] - %+ cope (maim-c cof q.cay p.kas) + %+ cope (maim cof q.cay p.kas) |= [cof=cafe vax=vase] (fine cof %noun vax) :: @@ -1003,7 +916,6 @@ == :: ++ malt :: cached slit - ~/ %malt |= [cof=cafe gat=type sam=type] ^- (bolt type) %+ (clef %slit) (fine cof gat sam) @@ -1015,7 +927,6 @@ == :: ++ maul :: slam - ~/ %maul |= [cof=cafe gat=vase sam=vase] ^- (bolt vase) %+ cope (malt cof p.gat p.sam) @@ -1031,7 +942,6 @@ zeg=(set term) :: library guard boy=(list twig) :: body stack == - ~% %meow +>+> ~ |% ++ able :: assemble preamble ^- twig @@ -1055,17 +965,16 @@ [%ash [%tssg (flop boy)]] :: ++ abut :: generate - ~/ %abut |= [cof=cafe hyd=hood] ^- (bolt vase) %+ cope (apex cof hyd) |= [cof=cafe sel=_..abut] =. ..abut sel - %+ cope (maim-d cof pit able) + %+ cope (maim cof pit able) |= [cof=cafe bax=vase] %+ cope (chap cof bax [%fan fan.hyd]) |= [cof=cafe gox=vase] - %+ cope (maim-e cof (slop gox bax) [%tssg (flop boy)]) + %+ cope (maim cof (slop gox bax) [%tssg (flop boy)]) |= [cof=cafe fin=vase] (fine cof fin) :: ~> %slog.[0 ~(duck ut p.q.cay)] @@ -1137,13 +1046,12 @@ (slop $(doy l.doy) $(doy r.doy)) :: ++ chap :: produce resources - ~/ %chap |= [cof=cafe bax=vase hon=horn] ^- (bolt vase) ?- -.hon - %ape (maim-f cof bax p.hon) + %ape (maim cof bax p.hon) %arg - %+ cope (maim-g cof bax p.hon) + %+ cope (maim cof bax p.hon) |= [cof=cafe gat=vase] (maul cof gat !>([how arg])) :: @@ -1190,14 +1098,14 @@ %saw %+ cope $(hon q.hon) |= [cof=cafe sam=vase] - %+ cope (maim-h cof bax p.hon) + %+ cope (maim cof bax p.hon) |= [cof=cafe gat=vase] (maul cof gat sam) :: %sic %+ cope $(hon q.hon) |= [cof=cafe vax=vase] - %+ cope (maim-i cof bax [%bctr p.hon]) + %+ cope (maim cof bax [%bctr p.hon]) |= [cof=cafe tug=vase] ?. (~(nest ut p.tug) | p.vax) (flaw cof [%leaf "type error: {} {}"]~) @@ -1314,4 +1222,72 @@ exec(q.kig (~(del by q.kig) tik)) -- -- +:: +-- +. == +=| axle +=* lex - +|= [now=@da eny=@ ski=sled] :: activate +^? :: opaque core +~% %ford-d +>+>+>+>+>+> ~ +|% :: +++ call :: request + |= [hen=duct hic=(hypo (hobo kiss))] + ^- [p=(list move) q=_..^$] + => .(q.hic ?.(?=(%soft -.q.hic) q.hic ((hard kiss) p.q.hic))) + =+ ska=(slod ski) + =+ ^= our ^- @p + ?- -.q.hic + %exec p.q.hic + == + =+ ^= bay ^- baby + =+ buy=(~(get by pol.lex) our) + ?~(buy *baby u.buy) + =^ mos bay + abet:(~(apex za [[our ~ hen] [now eny ska] ~] bay) q.q.hic) + [mos ..^$(pol (~(put by pol) our bay))] +:: +++ doze + |= [now=@da hen=duct] + ^- (unit ,@da) + ~ +:: +++ load :: highly forgiving + |= old=* + =. old + ?. ?=([%0 *] old) old :: remove at 1 + :- %1 + |- ^- * + ?~ +.old ~ + ?> ?=([n=[p=* q=[tad=* dym=* jav=*]] l=* r=*] +.old) + :- [p.n.+.old [tad.q.n.+.old dym.q.n.+.old ~]] + [$(+.old l.+.old) $(+.old r.+.old)] + =+ lox=((soft axle) old) + ^+ ..^$ + ?~ lox + ~& %ford-reset + ..^$ + ..^$(+>- u.lox) +:: +++ scry + |= [fur=(unit (set monk)) ren=@tas who=ship syd=desk lot=coin tyl=path] + ^- (unit (unit (pair mark ,*))) + ~ +:: +++ stay :: save w/o cache + `axle`+>-.$(pol (~(run by pol) |=(a=baby [tad.a dym.a ~]))) +:: +++ take :: response + |= [tea=wire hen=duct hin=(hypo sign)] + ^- [p=(list move) q=_..^$] + =+ ska=(slod ski) + ?> ?=([@ @ @ ~] tea) + =+ :* our=(need (slaw %p i.tea)) + num=(need (slaw %ud i.t.tea)) + tik=(need (slaw %ud i.t.t.tea)) + == + =+ bay=(need (~(get by pol.lex) our)) + =^ mos bay + abet:(~(axon za [[our tea hen] [now eny ska] ~] bay) num tik q.hin) + [mos ..^$(pol (~(put by pol) our bay))] -- From 6dfd825b9c61aabc2726cd07d4524312e7f2d9ed Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Thu, 15 Jan 2015 11:32:04 -0800 Subject: [PATCH 12/13] Rename radio to rodeo. --- main/app/{radio => rodeo}/core.hook | 96 +++++++++---------- main/app/talk/core.hook | 18 ++-- main/lib/rodeo/core.hook | 19 ++++ .../door.hook | 4 +- .../{radio-report => rodeo-report}/door.hook | 4 +- main/sur/{radio => rodeo}/core.hook | 2 +- 6 files changed, 81 insertions(+), 62 deletions(-) rename main/app/{radio => rodeo}/core.hook (92%) create mode 100644 main/lib/rodeo/core.hook rename main/mar/{radio-command => rodeo-command}/door.hook (98%) rename main/mar/{radio-report => rodeo-report}/door.hook (98%) rename main/sur/{radio => rodeo}/core.hook (99%) diff --git a/main/app/radio/core.hook b/main/app/rodeo/core.hook similarity index 92% rename from main/app/radio/core.hook rename to main/app/rodeo/core.hook index 08ed3c91d..260e3da91 100644 --- a/main/app/radio/core.hook +++ b/main/app/rodeo/core.hook @@ -1,9 +1,9 @@ :: -:::: /hook/core/radio/app +:::: /hook/core/rodeo/app :: /? 314 -/- *radio -/+ radio +/- *rodeo +/+ rodeo :: :::: :: @@ -11,7 +11,7 @@ => |% :: data structures ++ house ,[%1 house-1] :: full state ++ house-any :: app history - $% [%1 house-1] :: 1: radio + $% [%1 house-1] :: 1: rodeo [%0 house-0] :: 0: initial version == :: ++ house-1 :: @@ -50,7 +50,7 @@ [%da p=@da] :: by date == :: ++ gift :: result - $% [%rust %radio-report report] :: refresh + $% [%rust %rodeo-report report] :: refresh [%mean ares] :: cancel [%nice ~] :: accept == :: @@ -61,7 +61,7 @@ $: %g :: application $% [%mean p=ares] :: cancel [%nice ~] :: acknowledge - [%rust %radio-report report] :: refresh + [%rust %rodeo-report report] :: refresh == == :: $: %t :: $% [%wake ~] :: timer wakeup @@ -116,7 +116,7 @@ ++ ra-house :: emit stations |= ost=bone %+ ra-emit ost - :^ %give %rust %radio-report + :^ %give %rust %rodeo-report :- %house %- ~(gas in *(set span)) ^- (list span) @@ -130,7 +130,7 @@ =. +> $(gel r.gel) (ra-house n.gel) :: - ++ ra-init :: initialize radio + ++ ra-init :: initialize rodeo =+ sir=(sein our.hid) %+ ra-apply our.hid :+ %design (main our.hid) @@ -145,10 +145,10 @@ ?- -.cod %design ?. =(her our.hid) - (ra-evil %radio-no-owner) + (ra-evil %rodeo-no-owner) ?~ q.cod ?. (~(has by stories) p.cod) - (ra-evil %radio-no-story) + (ra-evil %rodeo-no-story) =. +>.$ (ra-config p.cod *config) ra-ever(stories (~(del by stories) p.cod)) =. +>.$ (ra-config p.cod u.q.cod) @@ -204,7 +204,7 @@ %+ ~(put by q.u.oot) [%& her man] ?+ sih !! - [%g %mean *] ~&([%radio-repeat-rejected num her man sih] %rejected) + [%g %mean *] ~&([%rodeo-repeat-rejected num her man sih] %rejected) [%g %nice ~] %received == (ra-think | our.hid u.oot ~) @@ -231,7 +231,7 @@ ?: ?=(~ pax) (ra-house(general (~(put in general) ost)) ost) ?. ?=([@ @ *] pax) - (ra-evil %radio-bad-path) + (ra-evil %rodeo-bad-path) =+ ^= vab ^- (set ,@tas) =| vab=(set ,@tas) |- ^+ vab @@ -240,7 +240,7 @@ =+ pur=(~(get by stories) i.t.pax) ?~ pur ~& [%bad-subscribe-story-c i.t.pax] - (ra-evil %radio-no-story) + (ra-evil %rodeo-no-story) =+ soy=~(. pa i.t.pax u.pur) =. soy ?.((~(has in vab) %a) soy (pa-watch:soy her)) =. soy ?.((~(has in vab) %x) soy (pa-master:soy her)) @@ -273,7 +273,7 @@ (ra-appear her q.p.p.i.sul q.i.sul) ?: =(her our.hid) (ra-provoke p.p.p.i.sul i.sul) - (ra-evil %radio-unauthorized-presence) + (ra-evil %rodeo-unauthorized-presence) == :: ++ ra-appear :: review presence @@ -286,7 +286,7 @@ =+ pur=(~(get by stories) man) ?~ pur ~& [%bad-appear man] - (ra-evil %radio-no-story) + (ra-evil %rodeo-no-story) pa-abet:(~(pa-notify pa man u.pur) her per who) :: ++ ra-provoke :: forward presence @@ -296,9 +296,9 @@ /provoke %g %mess - [him /radio] + [him /rodeo] our.hid - [%radio-command !>(`command`[%ping [[tay per] ~ ~]])] + [%rodeo-command !>(`command`[%ping [[tay per] ~ ~]])] == :: ++ ra-conduct :: thought to station @@ -338,9 +338,9 @@ /repeat/(scot %ud p.outbox)/(scot %p p.cuz)/[q.cuz] %g %mess - [p.cuz /radio] + [p.cuz /rodeo] our.hid - [%radio-command !>(`command`[%review tip ~])] + [%rodeo-command !>(`command`[%review tip ~])] == +>(p.outbox +(p.outbox), q.outbox (~(put by q.outbox) p.outbox tip)) :: @@ -375,17 +375,17 @@ ++ pa-watch :: watch presence |= her=ship ?. (pa-admire her) - (pa-sauce ost [[%mean ~ %radio-watch-unauthorized ~] ~]) + (pa-sauce ost [[%mean ~ %rodeo-watch-unauthorized ~] ~]) =. viewers (~(put in viewers) ost) (pa-display ost ~ ~) :: ++ pa-master :: hear config |= her=ship ?. (pa-admire her) - (pa-sauce ost [[%mean ~ %radio-master-unauthorized ~] ~]) + (pa-sauce ost [[%mean ~ %rodeo-master-unauthorized ~] ~]) =. owners (~(put in owners) ost) :: ~& [%pa-master her man shape] - (pa-sauce ost [[%rust %radio-report %config shape] ~]) + (pa-sauce ost [[%rust %rodeo-report %config shape] ~]) :: ++ pa-display :: update presence |= vew=(set bone) @@ -399,7 +399,7 @@ ?~ vew +>.^$ =. +>.^$ $(vew l.vew) =. +>.^$ $(vew r.vew) - (pa-sauce n.vew [[%rust %radio-report %group reg] ~]) + (pa-sauce n.vew [[%rust %rodeo-report %group reg] ~]) :: ++ pa-monitor :: update config =+ owe=owners @@ -408,19 +408,19 @@ =. +> $(owe l.owe) =. +> $(owe r.owe) :: ~& [%pa-monitor man shape] - (pa-sauce n.owe [[%rust %radio-report %config shape] ~]) + (pa-sauce n.owe [[%rust %rodeo-report %config shape] ~]) :: ++ pa-friend :: subscribed update |= sih=sign ^+ +> - ?+ sih ~&([%radio-bad-friend sih] !!) + ?+ sih ~&([%rodeo-bad-friend sih] !!) [%g %nice ~] :: ~& %pa-friend-nice +>.$ :: - [%g %rust %radio-report *] + [%g %rust %rodeo-report *] :: ~& [%pa-friend-report +>+.sih] - ?+ -.+>+.sih ~&([%radio-odd-friend sih] !!) + ?+ -.+>+.sih ~&([%rodeo-odd-friend sih] !!) %config +>.$ %group +>.$ %grams (pa-lesson q.+.+>+.sih) @@ -430,13 +430,13 @@ ++ pa-stalk :: subscribed present |= [tay=station sih=sign] ^+ +> - ?+ sih ~&([%radio-bad-friend sih] !!) + ?+ sih ~&([%rodeo-bad-friend sih] !!) [%g %nice ~] :: ~& %pa-stalk-nice +>.$ :: - [%g %rust %radio-report *] - ?+ -.+>+.sih ~&([%radio-odd-friend sih] !!) + [%g %rust %rodeo-report *] + ?+ -.+>+.sih ~&([%rodeo-odd-friend sih] !!) %group (pa-remind tay +.+>+.sih) == @@ -468,9 +468,9 @@ :: %& :: ~& [%pa-abjure [our.hid man] [p.p.tay q.p.tay]] :~ :- /friend/nuke/[man] - [%g %nuke [p.p.tay /radio] our.hid] + [%g %nuke [p.p.tay /rodeo] our.hid] :- /stalk/nuke/[man] - [%g %nuke [p.p.tay /radio] our.hid] + [%g %nuke [p.p.tay /rodeo] our.hid] == == :: @@ -488,7 +488,7 @@ :: %& ~& [%pa-acquire [our.hid man] [p.p.tay q.p.tay]] :~ :- /friend/show/[man] - [%g %show [p.p.tay /radio] our.hid /af/[q.p.tay]/(scot %ud num)] + [%g %show [p.p.tay /rodeo] our.hid /af/[q.p.tay]/(scot %ud num)] == == :: @@ -549,7 +549,7 @@ ++ pa-start :: start stream |= riv=river ^+ +> - =- =. +>.$ (pa-sauce ost [[%rust %radio-report %grams q.lab r.lab] ~]) + =- =. +>.$ (pa-sauce ost [[%rust %rodeo-report %grams q.lab r.lab] ~]) ?: p.lab (pa-sauce ost [[%mean ~] ~]) +>.$(guests (~(put by guests) ost riv)) @@ -575,7 +575,7 @@ =. +> (pa-watch her) =. +> (pa-master her) ?. (pa-admire her) - (pa-sauce ost [[%mean ~ %radio-listen-unauthorized ~] ~]) + (pa-sauce ost [[%mean ~ %rodeo-listen-unauthorized ~] ~]) =+ ^= ruv ^- (unit river) ?: ?=(~ pax) `[[%ud count] [%da (dec (bex 128))]] @@ -590,7 +590,7 @@ `[(point +>.say) (point +>.den)] :: ~& [%pa-listen her pax ruv] ?~ ruv - (pa-sauce ost [[%mean ~ %radio-malformed ~] ~]) + (pa-sauce ost [[%mean ~ %rodeo-malformed ~] ~]) (pa-start u.ruv) :: ++ pa-refresh :: update stream @@ -614,7 +614,7 @@ == old :- p.old - [[p.n.guests %give %rust %radio-report %grams num gam ~] q.old] + [[p.n.guests %give %rust %rodeo-report %grams num gam ~] q.old] =. moves (welp q.moy moves) |- ^+ +>.^$ ?~ p.moy +>.^$ @@ -659,13 +659,13 @@ ++ peer |= [ost=bone her=ship pax=path] ^- [(list move) _+>] - :: ~& [%radio-peer ost her pax] + :: ~& [%rodeo-peer ost her pax] ra-abet:(~(ra-subscribe ra ost ~) her pax) :: -++ poke-radio-command +++ poke-rodeo-command |= [ost=bone her=ship cod=command] ^- [(list move) _+>] - :: ~& [%radio-poke-command her cod] + :: ~& [%rodeo-poke-command her cod] ra-abet:(~(ra-apply ra ost ~) her cod) :: ++ pour @@ -673,8 +673,8 @@ ^- [(list move) _+>] :: ~& sih=sih =+ sih=((hard sign) sih) - :: ~& [%radio-pour ost pax sih] - ?+ pax ~& [%radio-strange-path pax] !! + :: ~& [%rodeo-pour ost pax sih] + ?+ pax ~& [%rodeo-strange-path pax] !! :: [%provoke ~] [~ +>.$] [%time ~] @@ -685,7 +685,7 @@ [%twitter *] =- ra-abet:(~(ra-twitter ra ost ~) met sih) ^= met - ?+ t.pax ~& [%radio-twitter-strange-path pax] !! + ?+ t.pax ~& [%rodeo-twitter-strange-path pax] !! [%mine @ @ ~] [i.t.pax i.t.t.t.pax] [%stat @ ~] @@ -716,14 +716,14 @@ ++ pull |= ost=bone ^- [(list move) _+>] - :: ~& [%radio-pull ost] + :: ~& [%rodeo-pull ost] ra-abet:~(ra-cancel ra ost ~) :: ++ poke-bit |= [ost=bone you=ship ~] ^- [(list move) _+>] :_ +>.$ - =+ paf=/(scot %p our.hid)/try/(scot %da lat.hid)/radio/backlog/jam + =+ paf=/(scot %p our.hid)/try/(scot %da lat.hid)/rodeo/backlog/jam [ost %pass /jamfile %c %info our.hid (foal paf (jam +<+.+>.$))]~ :: ++ prep @@ -733,12 +733,12 @@ =+ moz=`(list move)`[0 %pass /time %t %wait (add ~s10 lat.hid)]~ |- ?~ u.old - =+ paf=/(scot %p our.hid)/try/(scot %da lat.hid)/radio/backlog/jam + =+ paf=/(scot %p our.hid)/try/(scot %da lat.hid)/rodeo/backlog/jam ?. ?=([%0 %0 %0] [.^(%cy paf)]) $(u.old (some ((hard house-any) (cue ((hard ,@) .^(%cx paf)))))) - ~& %radio-prep-new + ~& %rodeo-prep-new ra-abet:~(ra-init ra 0 moz) - ~& %radio-prep-old + ~& %rodeo-prep-old :- moz |- ?- -.u.u.old diff --git a/main/app/talk/core.hook b/main/app/talk/core.hook index ee878dde5..b64856fec 100644 --- a/main/app/talk/core.hook +++ b/main/app/talk/core.hook @@ -2,8 +2,8 @@ :::: /hook/core/talk/app :: /? 314 -/- *radio -/+ radio +/- *rodeo +/+ rodeo :: :::: :: @@ -89,7 +89,7 @@ $: %rust $= p $% [%txt p=cord] - [%radio-report p=report] + [%rodeo-report p=report] == == == ++ sign @@ -109,7 +109,7 @@ |= cod=command %_ +> moz :_ moz - [0 %pass /command %g %mess [our /radio] our [%radio-command !>(cod)]] + [0 %pass /command %g %mess [our /rodeo] our [%rodeo-command !>(cod)]] == :: ++ hy-render :: return to console @@ -124,11 +124,11 @@ :: ++ hy-subscribe :: send %show |= [way=path hoc=path] - %_(+> moz :_(moz [0 %pass way %g %show [our /radio] our hoc])) + %_(+> moz :_(moz [0 %pass way %g %show [our /rodeo] our hoc])) :: ++ hy-unsubscribe :: send %nuke |= way=path - %_(+> moz :_(moz [0 %pass way %g %nuke [our /radio] our])) + %_(+> moz :_(moz [0 %pass way %g %nuke [our /rodeo] our])) :: ++ hy-display :: print to console |=(tay=(list tank) (hy-render %tang tay)) @@ -449,7 +449,7 @@ ?: ?=(?(%cold %dead) link) ~& [%sy-sign-rust-bad `@tas`link] +>.$ - ?> ?=(%radio-report +<.res) + ?> ?=(%rodeo-report +<.res) ?: ?=(%cool link) :: XX workaround for inverted nice $(link %warm) @@ -624,7 +624,7 @@ %nice [~ +>.$] %mean ~&(%talk-server-crash !!) ?(%rush %rust) - ?> ?=([%radio-report %house *] p.sih) + ?> ?=([%rodeo-report %house *] p.sih) ny-abet:(ny-tell:ny +.p.p.sih) == :: @@ -653,7 +653,7 @@ ^- move :* 0 %pass /server %g %show - [our.hid /radio] our.hid + [our.hid /rodeo] our.hid / == == diff --git a/main/lib/rodeo/core.hook b/main/lib/rodeo/core.hook new file mode 100644 index 000000000..bd8983332 --- /dev/null +++ b/main/lib/rodeo/core.hook @@ -0,0 +1,19 @@ +:: +:::: /hook/core/rodeo/lib + :: + :: This file is in the public domain. + :: +/? 314 +/- *rodeo +:: +:::: + :: +|% +++ main :: main story + |= our=ship ^- cord + =+ can=(clan our) + ?+ can %porch + %czar %court + %king %floor + == +-- diff --git a/main/mar/radio-command/door.hook b/main/mar/rodeo-command/door.hook similarity index 98% rename from main/mar/radio-command/door.hook rename to main/mar/rodeo-command/door.hook index 794383556..9fd42e3f7 100644 --- a/main/mar/radio-command/door.hook +++ b/main/mar/rodeo-command/door.hook @@ -1,8 +1,8 @@ :: -:::: /hook/door/radio-command/mar +:::: /hook/door/rodeo-command/mar :: /? 314 -/- *radio +/- *rodeo !: |_ cod=command :: diff --git a/main/mar/radio-report/door.hook b/main/mar/rodeo-report/door.hook similarity index 98% rename from main/mar/radio-report/door.hook rename to main/mar/rodeo-report/door.hook index d975ce9cf..78b68b130 100644 --- a/main/mar/radio-report/door.hook +++ b/main/mar/rodeo-report/door.hook @@ -1,8 +1,8 @@ :: -:::: /hook/door/radio-report/mar +:::: /hook/door/rodeo-report/mar :: /? 314 -/- *radio +/- *rodeo !: |_ rep=report :: diff --git a/main/sur/radio/core.hook b/main/sur/rodeo/core.hook similarity index 99% rename from main/sur/radio/core.hook rename to main/sur/rodeo/core.hook index 3d66dce6e..41ee43373 100644 --- a/main/sur/radio/core.hook +++ b/main/sur/rodeo/core.hook @@ -1,5 +1,5 @@ :: -:::: /hook/core/radio/sur +:::: /hook/core/rodeo/sur :: |% ++ ache |*([a=$+(* *) b=$+(* *)] $%([| p=b] [& p=a])) :: PM 314 From 22ef9e18b24e2042f5fcf7e58043a7d8cdcfdcbe Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Thu, 15 Jan 2015 11:39:22 -0800 Subject: [PATCH 13/13] Add old radio back into radio branch. --- main/app/radio/core.hook | 95 ++++++++++++++++++++++++++++++++ main/mar/radio-command/door.hook | 90 ++++++++++++++++++++++++++++++ main/mar/radio-report/door.hook | 92 +++++++++++++++++++++++++++++++ main/sur/radio/core.hook | 45 +++++++++++++++ 4 files changed, 322 insertions(+) create mode 100644 main/app/radio/core.hook create mode 100644 main/mar/radio-command/door.hook create mode 100644 main/mar/radio-report/door.hook create mode 100644 main/sur/radio/core.hook diff --git a/main/app/radio/core.hook b/main/app/radio/core.hook new file mode 100644 index 000000000..bdba7c0f6 --- /dev/null +++ b/main/app/radio/core.hook @@ -0,0 +1,95 @@ +/- mess,user,users,zing,zong +!: +=> |% + ++ axle + $% [%0 p=(map path ,[p=(list zong) q=(map ship ,?)])] + == + ++ blitz + $% [%zong p=zong] + [%user p=user] + == + ++ iron + $% [%zongs p=(list zong)] + [%users p=users] + == + ++ gift + $% [%rush blitz] + [%rust iron] + [%mean ares] + [%nice ~] + == + ++ move ,[p=bone q=(mold note gift)] + ++ note ,~ + -- +|_ [hid=hide vat=axle] +++ grab + |= sta=path + (fall (~(get by p.vat) sta) *[p=(list zong) q=(map ship ,?)]) +:: +++ ident + |= you=ship + %- (hard ,@t) + .^(%a (scot %p our.hid) %name (scot %da lat.hid) (scot %p you) ~) +:: +++ peer + |= [ost=bone you=ship pax=path] + ^- [(list move) _+>] + ?~ pax + [[ost %give %mean ~ %radio-bad-path ~]~ +>.$] + =+ ya=(grab t.pax) + ?+ -.pax [~ +>.$] + %mensajes + [[ost %give %rust %zongs p.ya]~ +>.$] + %amigos + =. q.ya (~(put by q.ya) you %.y) + :_ +>.$(p.vat (~(put by p.vat) t.pax ya)) + :_ (send pax %give %rush %user %in you (ident you)) + :* ost %give %rust %users + %+ murn (~(tap by q.ya)) + |= [shi=ship liv=?] + ?. liv + ~ + (some [shi (ident shi)]) + == + == +:: +++ poke-zing + |= [ost=bone you=ship zig=zing] + ^- [(list move) _+>] + =+ ya=(grab p.zig) + ?. (~(has by q.ya) you) + [[ost %give %mean ~ %no-te-conozco ~]~ +>.$] + =+ zog=`zong`[%mess lat.hid you q.zig] + =. p.vat (~(put by p.vat) p.zig [[zog p.ya] q.ya]) + :_ +>.$ + :- [ost %give %nice ~] + (send mensajes/p.zig %give %rush %zong zog) +:: +++ poke-bit + |= [ost=bone you=ship ~] + ^- [(list move) _+>] + :_ +>.$ + %+ turn (~(tap by sup.hid)) + |= [ost=bone her=ship pax=path] + [ost %give %mean ~ %reload leaf/"please quit chat and re-enter" ~] +:: +++ pull + |= ost=bone + ^- [(list move) _+>] + =+ ^- (unit ,[his=ship pax=path]) + (~(get by sup.hid) ost) + ?~ - ~& %strange-pull [~ +>.$] + ?. ?=([%mensajes *] pax.u) + [~ +>.$] + =+ sta=(~(got by p.vat) t.pax.u) + =. q.sta %+ ~(put by q.sta) his.u %.n + =. p.vat %+ ~(put by p.vat) t.pax.u sta + [(send amigos/t.pax.u %give %rush %user %out his.u (ident his.u)) +>.$] +:: +++ send + |= [pax=path msg=(mold note gift)] + ^- (list move) + :: ~& [%radi-sub pus.hid] + %+ turn (~(tap in (~(get ju pus.hid) pax))) + |=(ost=bone [ost msg]) +-- diff --git a/main/mar/radio-command/door.hook b/main/mar/radio-command/door.hook new file mode 100644 index 000000000..eee32b9ed --- /dev/null +++ b/main/mar/radio-command/door.hook @@ -0,0 +1,90 @@ +:: +:::: /hook/door/radio-command/mar + :: +/? 314 +/- *radio +!: +|_ cod=command +:: +++ grab :: convert from + |% + ++ noun command :: clam from %noun + ++ json + => [jo ..command] + |= a=json ^- command + =- (need ((of -) a)) + =< :~ publish/(ar thot) + review/(ar thot) + design/(ot party/so config/(mu conf) ~) + ping/auri + == + |% + ++ op :: parse keys of map + |* [fel=_rule wit=fist] + %+ cu mo + %- ci :_ (om wit) + |= a=(map cord ,_(need *wit)) + ^- (unit (list ,_[(wonk *fel) (need *wit)])) + (zl (turn (~(tap by a)) (head-rush fel))) + :: + ++ as :: array as set + :: |*(a=fist (cu sa (ar a))) :: XX types + |* a=fist + %- cu :_ (ar a) + ~(gas in *(set ,_(need *a))) + :: + ++ lake |*(a=_,* $+(json (unit a))) + ++ peach + |* a=_[rule rule] + |= tub=nail + ^- (like (each ,_(wonk (-.a)) ,_(wonk (+.a)))) + %. tub + ;~(pose (stag %& -.a) (stag %| +.a)) + :: + ++ head-rush + |* a=_rule + |* [b=cord c=*] + =+ nit=(rush b a) + ?~ nit ~ + (some [u.nit c]) + :: + :: + ++ thot + ^- $+(json (unit thought)) + %- ot :~ + serial/(ci (slat %uv) so) + audience/audi + statement/stam + == + :: + ++ audi (op stati (ci (soft delivery) so)) :: audience + ++ auri (op stati (ci (soft presence) so)) + :: + ++ stati + ^- $+(nail (like station)) + %+ peach + ;~((glue fas) ;~(pfix sig fed:ag) urs:ab) + %+ sear (soft partner) + ;~((glue fas) sym urs:ab) :: XX [a-z0-9_]{1,15} + :: + ++ stam + ^- $+(json (unit statement)) + =- (ot now/di speech/(of -) ~) + :~ own/so + say/so + exp/(cu |=(a=cord [a ~]) so) + inv/(ot ship/(su fed:ag) party/(su urs:ab) ~) + == + :: + :: + ++ conf + ^- $+(json (unit config)) + %- ot :~ + sources/(as (su stati)) + :- %cordon + %+ cu |*(a=^ ?~(-.a a a)) :: XX do type stuff + (ot white/bu list/(as (su fed:ag)) ~) + == + -- +-- -- + diff --git a/main/mar/radio-report/door.hook b/main/mar/radio-report/door.hook new file mode 100644 index 000000000..ca125c550 --- /dev/null +++ b/main/mar/radio-report/door.hook @@ -0,0 +1,92 @@ +:: +:::: /hook/door/radio-report/mar + :: +/? 314 +/- *radio +!: +|_ rep=report +:: +++ grab :: convert from + |% + ++ noun report :: clam from %noun + -- +++ grow + |% + ++ mime [/text/json (taco (crip (pojo json)))] + ++ json + => + + |^ %+ joba -.rep + ?- -.rep + %config ~! rep (conf +.rep) + %house [%a (turn (~(tap by +.rep)) joce)] + %grams (jobe num/(jone p.rep) tele/[%a (turn q.rep gram)] ~) + ::%group (grop +.rep) + %group (jobe local/(grop p.rep) global/%.(q.rep (jome stan grop)) ~) + == + ++ joce |=(a=span [%s a]) + ++ jope |=(a=ship (jape +:)) ::[%s (crip +:(scow %p a))]) + ++ joke |=(a=tank [%s (role (turn (wash 0^80 a) crip))]) + ++ jode |=(a=time (jone (div (mul (sub a ~1970.1.1) 1.000) ~s1))) +:: ++ jase +:: |* a=,json +:: |= b=(set ,_+<.a) ^- json +:: ~! b +:: [%a (turn (~(tap in b)) a)] + :: + ++ jome :: stringify keys + |* [a=_cord b=_json] + |= c=(map ,_+<.a ,_+<.b) + (jobe (turn (~(tap by c)) (both a b))) + :: + ++ both :: cons two gates + |* [a=_,* b=_,*] + |=(c=_[+<.a +<.b] [(a -.c) (b +.c)]) + :: + :: + ++ grop (jome phon stas) :: (map ship status) + ++ phon |=(a=ship (scot %p a)) + ++ stas |=(status (jobe presence/(joce p) human/(huma q) ~)) + ++ gram |=(telegram (jobe ship/(jope p) thought/(thot q) ~)) + ++ thot + |= thought + (jobe serial/(jape

) audience/(audi q) statement/(stam r) ~) + :: + ++ audi (jome stan joce) + ++ stan + |= a=station ^- cord + %- crip + ?~ -.a "{}/{(trip q.p.a)}" + ?- -.p.a + %twitter "{(trip -.p.a)}/{(trip p.p.a)}" + == + :: + ++ stam |=(statement (jobe time/(jode p) speech/(spec q) ~)) + ++ spec + |= a=speech + %+ joba -.a + ?- -.a + ?(%own %say) [%s p.a] + %exp (jobe code/[%s p.a] done/?~(q.a ~ (joke u.q.a)) ~) + %inv (jobe ship/(jope p.a) party/[%s q.a] ~) + == + :: + ++ huma + |= human + %^ jobe + hand/?~(hand ~ [%s u.hand]) + :- %true + ?~ true ~ + =+ u.true + (jobe first/[%s p] middle/?~(q ~ [%s u.q]) last/[%s r] ~) + ~ + :: + ++ conf + |= config + %- jobe :~ + sources/[%a (turn (~(tap in sources)) |=(a=station [%s (stan a)]))] + =- cordon/(jobe white/[%b -.cordon] list/[%a -] ~) + (turn (~(tap in p.cordon)) jope) :: XX jase + == + -- +-- -- + diff --git a/main/sur/radio/core.hook b/main/sur/radio/core.hook new file mode 100644 index 000000000..f2ae5b5d5 --- /dev/null +++ b/main/sur/radio/core.hook @@ -0,0 +1,45 @@ +:: +:::: /hook/core/radio/sur + :: +|% +++ audience (map station delivery) :: destination/state +++ atlas (map ship status) :: presence map +++ command :: effect on party + $% [%design (pair span (unit config))] :: configure/destroy + [%publish (list thought)] :: originate + [%review (list thought)] :: deliver + [%ping (map station presence)] :: declare status + == :: +++ config :: party configuration + $: sources=(set station) :: pulls from + cordon=(each (set ship) (set ship)) :: white/blacklist + == :: +++ cousin (pair ship span) :: domestic flow +++ delivery ?(%pending %received %rejected %released) :: delivery state +++ human :: human identifier + $: true=(unit (trel ,@t (unit ,@t) ,@t)) :: true name + hand=(unit ,@t) :: handle + == :: +++ partner :: foreign flow + $% [%twitter p=@t] :: twitter + == :: +++ presence ?(%hear %talk) :: status type +++ report :: unified rush/rust + $% [%house (set span)] :: meta-changes + [%grams (pair ,@ud (list telegram))] :: thoughts + [%group (pair atlas (map station atlas))] :: presence + [%config config] :: reconfigure + == :: +++ serial ,@uvH :: unique identity +++ station (each cousin partner) :: interlocutor +++ status (pair presence human) :: participant +++ speech :: party action + $% [%own p=@t] :: @ or /me + [%exp p=@t q=(unit tank)] :: program output + [%say p=@t] :: normal line + [%inv p=ship q=span] :: invite to + == :: +++ statement (pair ,@da speech) :: when this +++ telegram (pair ship thought) :: who which whom what +++ thought (trel serial audience statement) :: which whom what +--