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

Merge branch 'master' into crub

Browse Source 
Conflicts:
	urb/urbit.pill
	urb/zod/arvo/ames.hoon
	urb/zod/arvo/zuse.hoon
	v/reck.c
This commit is contained in:
Jared Hance 2014-08-01 14:17:18 -04:00
commit 4430c20e14
88 changed files with 19177 additions and 3616 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

318
arvo/ames.hoon
View File

@ -2,8 +2,61 @@
:: ames (4a), networking
::
|= pit=vase
^- vane
=> =~
:: structures
|%
++ flog :: error wrapper
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
== ::
++ gift :: out result <-$
$% [%hear p=lane q=@] :: receive packet
[%init p=@p] :: report install
[%send p=lane q=@] :: transmit packet
[%waft p=sock q=*] :: response message
[%wart p=sock q=@tas r=path s=*] :: network request
[%went p=ship q=cape] :: reaction message
== ::
++ hasp ,[p=ship q=term] :: see %gall
++ kiss :: in request ->$
$% [%barn ~] :: new unix process
[%crud p=@tas q=(list tank)] :: error with trace
[%cash p=@p q=buck] :: civil license
[%hear p=lane q=@] :: receive packet
[%hole p=lane q=@] :: packet failed
[%junk p=@] :: entropy
[%kick p=@da] :: wake up
[%make p=(unit ,@t) q=@ud r=@ s=?] :: wild license
[%sith p=@p q=@uw r=?] :: imperial generator
[%wake ~] :: timer activate
[%want p=sock q=path r=*] :: send message
== ::
++ move ,[p=duct q=(mold note gift)] :: local move
++ note :: out request $->
$? $: %d :: to %dill
$% [%flog p=flog] ::
== == ::
$: %a :: to %ames
$% [%kick p=@da] ::
== == ::
$: %g :: to %gall
$% [%rote p=sack q=term r=*] ::
[%roth p=sack q=term r=*] ::
== == ::
$: @tas :: to any
$% [%init p=@p] ::
[%want p=sock q=path r=*] ::
[%wart p=sock q=@tas r=path s=*] ::
== == == ::
++ sign :: in result $<-
$? $: %a :: from %ames
$% [%went p=ship q=cape] ::
== == ::
$: @tas ::
$% [%crud p=@tas q=(list tank)] :: by any
[%went p=ship q=cape] :: by %ames
== == == ::
--
::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4aA, identity logic ::
::
@ -39,7 +92,8 @@
|= [new=deed old=deed]
^- ?
=+ rac=(clan r.p.q.new)
?& ?~ q.p.q.new
?& =(r.new r.old) :: match fake
?~ q.p.q.new
?& =(r.p.q.old r.p.q.new)
&(!=(%earl rac) =(p.p.q.old (dec p.p.q.new)))
==
@ -63,11 +117,12 @@
?. =(i.wal i.ouf) ouf
$(wal t.wal, ouf t.ouf)
::
++ pier :: initial deed
++ pier !: :: initial deed
|= wed=deed
^- &
?> =+ rac=(clan r.p.q.wed)
=+ loy=(hail r.q.wed)
?: &(r.wed =(rac %czar)) %&
?> =(0 p.p.q.wed)
?> =(fig:ex:loy ?+(rac !! %czar (zeno r.p.q.wed), %pawn r.p.q.wed))
?> =((shaf %self (sham q.wed)) (need (sure:as:loy *code p.wed)))
@ -380,7 +435,7 @@
vix=(bex +((cut 0 [25 2] mag))) :: width of sender
tay=(cut 0 [27 5] mag) :: message type
==
?> =(6 vez)
?> =(7 vez)
?> =(chk (end 0 20 (mug bod)))
:+ [(end 3 wix bod) (cut 3 [wix vix] bod)]
(kins tay)
@ -400,7 +455,7 @@
=+ tay=(ksin q.kec)
%+ mix
%+ can 0
:~ [3 6]
:~ [3 7]
[20 (mug bod)]
[2 yax]
[2 qax]
@ -413,7 +468,7 @@
::
|%
++ go :: go
|_ ton=toun :: ames state
|_ ton=town :: ames state
++ as :: as:go
|_ [our=ship saf=sufi] :: per server
++ born :: born:as:go
@ -425,21 +480,23 @@
[~ +>.$]
=+ rad=(~(get by hoc.saf) her)
?^ rad
?> ?=(^ lew.wod.u.rad)
?. ?=(^ lew.wod.u.rad)
$(hoc.saf (~(del by hoc.saf) her)) :: XX how can this be?
?. =(pub r.q.i.lew.wod.u.rad) [~ +>.$]
[[~ lew.wod.u.rad] +>.$]
=+ syp=[[0 [~ p.nes] her now] ges pub]
=+ ded=[(sign:as:q.nes *code (shaf %meld (sham syp))) syp]
=+ ded=[(sign:as:q.nes *code (shaf %meld (sham syp))) syp fak.ton]
=+ wil=[ded law.saf]
?> =(wil (grip wil ~))
:- [~ wil]
+>.$(hoc.saf (~(put by hoc.saf) her [[~31337.1.1 ~ wil] ~ *cask]))
+>.$(hoc.saf (~(put by hoc.saf) her [[~31337.1.1 ~ wil] ~ *clot]))
::
++ lax :: lax:as:go
|_ [her=ship dur=door] :: per client
|_ [her=ship dur=dore] :: per client
++ cluy :: cluy:lax:as:go
^- [p=life q=gens r=acru] :: client crypto
?~ lew.wod.dur !!
?. =(fak.ton r.i.lew.wod.dur) ~|([%client-wrong-fake her] !!)
:+ p.p.q.i.lew.wod.dur
q.q.i.lew.wod.dur
(hail r.q.i.lew.wod.dur)
@ -507,9 +564,7 @@
?: ?| ?=(~ lun.wod.dur)
?=([%ix *] u.lun.wod.dur)
?& ?=([%if *] u.lun.wod.dur)
?| !=(q.ryn p.u.lun.wod.dur)
!=(r.ryn q.u.lun.wod.dur)
==
(gth p.ryn (add ~s10 p.u.lun.wod.dur))
==
==
[~ ryn]
@ -628,19 +683,19 @@
-- :: --zuul:lax:as:go
-- :: --lax:as:go
::
++ gur :: default door
++ gur :: default dore
|= her=ship
^- door
=+ def=?.((lth her 256) ~ [~ %if 0 (mix her .0.0.1.0)])
[[~2100.1.1 def ~] ~ *cask]
^- dore
=+ def=?.((lth her 256) ~ [~ %if ~2000.1.1 0 (mix her .0.0.1.0)])
[[~2100.1.1 def ~] ~ *clot]
::
++ myx :: door by ship
++ myx :: dore by ship
|= her=ship
^+ lax
=+ fod=(~(get by hoc.saf) her)
~(. lax [her ?~(fod (gur her) u.fod)])
::
++ nux :: install door
++ nux :: install dore
|= new=_lax
^+ +>
+>(hoc.saf (~(put by hoc.saf) her.new dur.new))
@ -682,15 +737,16 @@
?:((lth her 256) ~ $(her (sein her)))
-- :: --as:go
::
++ ha :: adopt new license
++ ha !: :: adopt new license
|= [our=ship mac=mace wil=will]
^- toun
^- town
?> !=(~ mac)
?> ?=(^ wil)
:: ?> =(our r.p.q.i.wil)
?> =(wil (grip wil ~))
?> (real mac wil)
%_ ton
fak r.i.wil
urb
%+ ~(put by urb.ton)
our
@ -707,12 +763,12 @@
::
++ su :: install safe
|= new=_as
^- toun
^- town
ton(urb (~(put by urb.ton) our.new saf.new))
::
++ ti :: expire by time
|= [now=@da]
^- toun
^- town
!!
::
++ us :: produce safe
@ -935,9 +991,9 @@
::
|%
++ am :: am
|_ [now=@da fox=furt] :: protocol engine
|_ [now=@da fox=fort] :: protocol engine
++ boot :: boot:am
^- furt :: restore from noun
^- fort :: restore from noun
%= fox
urb.ton
%- ~(gas by *(map ship sufi))
@ -951,7 +1007,7 @@
==
==
++ come :: come:am
|= [ges=(unit ,@t) wid=@ bur=@] :: instantiate pawn
|= [ges=(unit ,@t) wid=@ bur=@ fak=?] :: instantiate pawn
^- [p=[p=ship q=@uvG] q=furt]
=+ loy=(brew wid bur)
=+ rig=sec:ex:loy
@ -963,27 +1019,31 @@
%^ ~(ha go ton.fox)
our
`mace`[[0 rig] ~]
`will`[[(sign:as:loy _@ (shaf %self (sham syp))) syp] ~]
`will`[[(sign:as:loy _@ (shaf %self (sham syp))) syp fak] ~]
fak.ton
fak
==
::
++ czar :: czar:am
|= [our=ship ger=@uw] :: instantiate emperor
^- [p=(list boon) q=furt]
=+ loy=(brew 2.048 ger)
?> =(fig:ex:loy (zeno our))
=+ fim==(fig:ex:loy (zeno our))
?: &(!fak !fim) !!
=+ mac=`mace`[[0 sec:ex:loy] ~]
=+ syp=`step`[`bray`[0 ~ our now] [%en %czar ~] pub:ex:loy]
=+ ded=`deed`[(sign:as:loy _@ (shaf %self (sham syp))) syp]
=+ ded=`deed`[(sign:as:loy _@ (shaf %self (sham syp))) syp fak]
=+ buq=`buck`[mac [ded ~]]
=: ton.fox (~(ha go ton.fox) our buq)
zac.fox (~(put by zac.fox) our *corn)
fak.ton.fox fak
==
[[[%beer our pac:ex:loy] ~] fox]
::
++ gnaw :: gnaw:am
|= [kay=cape ryn=lane pac=rock] :: process packet
^- [p=(list boon) q=furt]
?. =(6 (end 0 3 pac)) [~ fox]
^- [p=(list boon) q=fort]
?. =(7 (end 0 3 pac)) [~ fox]
=+ kec=(bite pac)
?: (goop p.p.kec) [~ fox]
?. (~(has by urb.ton.fox) q.p.kec)
@ -1013,7 +1073,7 @@
::
++ have :: have:am
|= [our=ship buq=buck] :: acquire license
^- [p=(list boon) q=furt]
^- [p=(list boon) q=fort]
=: ton.fox (~(ha go ton.fox) our buq)
zac.fox (~(put by zac.fox) our *corn)
==
@ -1022,7 +1082,7 @@
++ kick :: kick:am
|= hen=duct :: refresh net
=+ aks=(turn (~(tap by urb.ton.fox) ~) |=([p=ship q=sufi] p))
|- ^- [p=(list boon) q=furt]
|- ^- [p=(list boon) q=fort]
?~ aks [~ fox]
=^ buz fox zork:(kick:(um i.aks) hen)
=^ biz fox $(aks t.aks)
@ -1030,10 +1090,10 @@
::
++ wake :: wake:am
|= hen=duct :: harvest packets
^- [p=(list boon) q=furt]
^- [p=(list boon) q=fort]
=+ sox=hall
=| bin=(list boon)
|- ^- [p=(list boon) q=furt]
|- ^- [p=(list boon) q=fort]
?~ sox
=^ ban fox (kick hen)
[(weld bin p.ban) fox]
@ -1042,12 +1102,12 @@
::
++ wash :: wash:am
|= [soq=sock sup=soap ham=meal] :: dispatch and send
^- [p=(list boon) q=furt]
^- [p=(list boon) q=fort]
zork:zank:(wind:(ho:(um p.soq) q.soq) [q.sup r.sup] ham)
::
++ wise :: wise:am
|= [soq=sock hen=duct cha=path val=*] :: send a statement
^- [p=(list boon) q=furt]
^- [p=(list boon) q=fort]
zork:zank:(wool:(ho:(um p.soq) q.soq) hen cha val)
::
++ um :: per server
@ -1207,7 +1267,6 @@
^+ +>
?- -.fud
%back
:: ~& [%back aut her ryn `@p`(mug dam)]
=. +> ?.(=(%full aut) +> cock) :: finish key exch
+>(..la (tuck p.fud q.fud r.fud))
::
@ -1246,7 +1305,7 @@
=+ ^= lyn ^- lane
?~ q.fud ryn
?. ?=(%if -.u.q.fud) u.q.fud
[%ix now +.u.q.fud]
[%ix +.u.q.fud]
:: u.q.fud
?: =(our p.fud)
(emit %mead lyn r.fud)
@ -1311,7 +1370,8 @@
=^ yoh puz (bick:puz now fap)
=. +>.$
?~ p.yoh +>.$
=^ hud +>.$ (done p.u.p.yoh q.u.p.yoh)
=^ hud +>.$
(done p.u.p.yoh q.u.p.yoh)
?~ hud +>.$
%= +>.$
bin
@ -1414,7 +1474,7 @@
zank:(pong:(ho her) hen)
::
++ zork :: zork:um:am
^- [p=(list boon) q=furt] :: resolve
^- [p=(list boon) q=fort] :: resolve
:- (flop bin)
%_ fox
ton (~(su go ton.fox) gus)
@ -1427,30 +1487,30 @@
::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4aH, protocol vane ::
::
=| $: fox=furt :: kernel state
=| $: fox=fort :: kernel state
== ::
|= [now=@da eny=@ ska=$+(* (unit (unit)))] :: current invocation
|= [now=@da eny=@ ski=sled] :: current invocation
^? :: opaque core
=<
|% :: vane interface
++ beat
|= [tea=wire hen=duct fav=card]
=+ wru=*(unit writ)
^- [p=(list move) q=vane]
=^ duy ..knap
(knap wru tea hen fav)
++ call :: handle request
|= $: hen=duct
hic=(hypo (hobo kiss))
==
=> %= . :: XX temporary
q.hic
^- kiss
?: ?=(%soft -.q.hic)
((hard kiss) p.q.hic)
?: (~(nest ut -:!>(*kiss)) | p.hic) q.hic
~& [%ames-call-flub (,@tas `*`-.q.hic)]
((hard kiss) q.hic)
==
^- [p=(list move) q=_..^$]
=^ duy ..knob
(knob hen q.hic)
[duy ..^$]
::
++ call
|= [hen=duct fav=card]
^- [p=(list move) q=vane]
(beat ~ hen fav)
::
++ come
|= [sam=? old=vase]
^- vane
(load old)
::
++ doze
|= [now=@da hen=duct]
=+ doz=`(unit ,@da)`[~ (add now ~s32)]
@ -1467,56 +1527,65 @@
(hunt doz rtn.sop.bah)
::
++ load
|= new=vase
^- vane
?. (~(nest ut -:!>(fox)) | p.new) ~&(%ames-reset ..^$)
..^$(fox ~(boot am [now (furt q.new)]))
::
++ raze
^- vane
..$(fox *furt)
|= old=fort
^+ ..^$
..^$(fox old)
::
++ scry
|= [our=ship ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit))
|= [fur=(unit (set monk)) ren=@tas who=ship syd=desk lot=coin tyl=path]
^- (unit (unit (pair mark ,*)))
?~ tyl [~ ~]
=+ hun=(slaw %p i.tyl)
?~ hun [~ ~]
=- ?~ old ~
[~ ~ u.old]
^= old
?. =(0 ren) ~
?+ lot ~
[%$ %ud @]
(perm our his q.p.lot [syd tyl])
%+ bind
(perm who u.hun q.p.lot [syd t.tyl])
|=(a=* [%noun a])
::
[%$ %da @]
?. =(now q.p.lot) ~
(temp our his [syd tyl])
%+ bind
(temp who u.hun [syd t.tyl])
|=(a=* [%noun a])
==
::
++ stay `vase`!>(fox)
++ vern [164 0]
++ stay fox
++ take :: accept response
|= [tea=wire hen=duct hin=(hypo sign)]
^- [p=(list move) q=_..^$]
=^ duy ..knap
(knap tea hen q.hin)
[duy ..^$]
--
|%
++ claw |=(our=ship ^-(duct hen:(need (~(get by zac.fox) our))))
++ clop
|= [wru=(unit writ) now=@da hen=duct bon=boon]
^- [(list move) furt]
|= [now=@da hen=duct bon=boon]
^- [(list move) fort]
?- -.bon
%beer
:_ fox(zac (~(put by zac.fox) p.bon `corn`[hen ~ ~ ~]))
:* [[/c hen] [%init p.bon]]
[hen [%init p.bon]]
[[/a hen] [%kick now]]
[[/e hen] [%init p.bon]]
:: ~& [%ames-clop p.bon hen]
:* [hen [%slip %c %init p.bon]]
[hen [%give %init p.bon]]
[hen [%slip %a %kick now]]
[hen [%slip %e %init p.bon]]
[hen [%slip %g %init p.bon]]
~
==
::
%coke
:: ~& [%tz p.bon q.bon r.bon]
:_ fox
:~ [s.bon [%went q.p.bon r.bon]]
:~ [s.bon [%give %went q.p.bon r.bon]]
==
::
%mead :_(fox [[hen [%hear p.bon q.bon]] ~])
%mead :_(fox [[hen [%give %hear p.bon q.bon]] ~])
%milk
:: ~& [%rx p.bon q.bon]
?> ?=([@ *] q.q.bon)
@ -1526,6 +1595,7 @@
=+ [cak=i.t.q.q.bon ven=i.t.t.q.q.bon]
:~ =+ neh=(claw p.p.bon)
?> ?=(^ neh)
=+ ton=[%waft p.bon r.bon]
:: ~& [%milk-waft [[ven `path`t.t.t.q.q.bon] t.neh]]
:- ?: =(%c ven)
?> =(%re cak)
@ -1534,22 +1604,32 @@
?> |(=(%pr cak) =(%pc cak))
[[%e `path`t.t.t.q.q.bon] hen]
[[ven `path`t.t.t.q.q.bon] t.neh]
`card`[%waft p.bon r.bon]
[%sick ton]
==
?> ?=(%q i.q.q.bon)
?> ?=([@ *] t.q.q.bon)
?+ i.t.q.q.bon
:_ fox
:~ :- (claw p.p.bon)
`card`[%wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]
[%sick %wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]
==
::
%ge :: gall request
?> ?=([@ ~] t.t.q.q.bon)
=+ app=`term`(need ((sand %tas) i.t.t.q.q.bon))
:_(fox [hen %pass ~ %g %rote p.bon app r.bon]~)
::
%gh :: gall response
?> ?=([@ ~] t.t.q.q.bon)
=+ app=`term`(need ((sand %tas) i.t.t.q.q.bon))
:_(fox [hen %pass ~ %g %roth p.bon app r.bon]~)
::
%pi :: ping
$(bon [%wine p.bon " sent a ping at {(scow %da now)}"])
::
?(%pr %pc) :: %pr, %pc
:_ fox
:~ [[/e hen] `card`[%wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]]
:~ [hen [%slip %e %wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]]
==
::
%ta
@ -1558,12 +1638,12 @@
=^ wyl gus (born:gus now gox)
=. ton.fox (~(su go ton.fox) gus)
:_ fox
:~ :- [/a /a hen]
`card`[%want p.bon [%r %ta t.t.q.q.bon] `(unit will)`wyl]
:~ :- hen
[%pass ~ %a %want p.bon [%r %ta t.t.q.q.bon] `(unit will)`wyl]
==
%re :: %re
:_ fox
:~ [[/c hen] `card`[%wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]]
:~ [hen [%slip %c %wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]]
==
::
%ye :: %ye
@ -1575,20 +1655,21 @@
:_ fox
%+ turn paz
|= him=ship
:- [/a /a hen]
[%want [p.p.bon him] /q/yu [q.p.bon r.bon]]
:- hen
[%pass ~ %a %want [p.p.bon him] /q/yu [q.p.bon r.bon]]
==
::
%ouzo
:: ~& [%send now p.bon `@p`(mug (shaf %flap q.bon))]
:: ~& [%send now p.bon `@p`(mug (shaf %flap q.bon))]
:_ fox
[[hen [%send p.bon q.bon]] ~]
[[gad.fox [%give %send p.bon q.bon]] ~]
::
%wine
:_ fox
=+ nym=(temp p.p.bon q.p.bon /name)
=+ fom=~(rend co %$ %p q.p.bon)
:~ :- [/d hen]
:~ :- hen
:+ %slip %d
:+ %flog %text
;: weld
"; "
@ -1600,38 +1681,47 @@
==
::
++ knap
|= [wru=(unit writ) tea=wire hen=duct fav=card]
|= [tea=wire hen=duct sih=sign]
^- [(list move) _+>]
?: ?=([%crud *] fav)
[[[[/d hen] [%flog fav]] ~] +>]
=+ ^= fuy ^- [p=(list boon) q=furt]
?+ -.fav
[~ fox]
::
?- +<.sih
%crud [[[hen [%slip %d %flog +.sih]] ~] +>]
%went [~ +>]
==
::
++ knob
|= [hen=duct kyz=kiss]
^- [(list move) _+>]
?: ?=([%crud *] kyz)
[[[hen [%slip %d %flog kyz]] ~] +>]
=+ ^= fuy
^- [p=(list boon) q=fort]
?- -.kyz
%barn
[~ fox(gad hen)]
%cash
(~(have am [now fox]) p.fav q.fav)
(~(have am [now fox]) p.kyz q.kyz)
::
%hear
(~(gnaw am [now fox]) %good p.fav q.fav)
(~(gnaw am [now fox]) %good p.kyz q.kyz)
::
%hole
(~(gnaw am [now fox]) %dead p.fav q.fav)
(~(gnaw am [now fox]) %dead p.kyz q.kyz)
::
%junk
[~ fox(any.ton (shax (mix any.ton.fox p.fav)))]
[~ fox(any.ton (shax (mix any.ton.fox p.kyz)))]
::
%kick
(~(kick am [now fox(hop p.fav)]) hen)
(~(kick am [now fox(hop p.kyz)]) hen)
::
%make
=+ vun=(~(come am [now fox]) p.fav (bex q.fav) r.fav)
=+ vun=(~(come am [now fox]) p.kyz (bex q.kyz) r.kyz s.kyz)
[[[%beer p.vun] ~] q.vun]
::
%sith
(~(czar am [now fox]) p.fav q.fav)
(~(czar am [now fox]) p.kyz q.kyz r.kyz)
::
%want
(~(wise am [now fox]) p.fav hen q.fav r.fav)
(~(wise am [now fox]) p.kyz hen q.kyz r.kyz)
::
%wake
(~(wake am [now fox]) hen)
@ -1641,7 +1731,7 @@
|- ^- [p=(list move) q=_+>.^$]
?~ p.fuy
[(flop out) +>.^$]
=^ toe fox (clop wru now hen i.p.fuy)
=^ toe fox (clop now hen i.p.fuy)
$(p.fuy t.p.fuy, out (weld (flop toe) out))
::
++ perm
@ -1661,6 +1751,9 @@
=+ fod=(~(get by hoc.saf.u.gys) his)
?~ fod ~
(rick mar his lew.wod.u.fod)
?: ?=([%tick ~] tyl)
?. =(our (sein his)) ~
[~ (end 6 1 (shaf %tick (mix his (shax sec:ex:q:sen:u.gys))))]
~
?: ?=([%buck ~] tyl)
=+ muc=(rice mar sex:u.gys)
@ -1669,11 +1762,6 @@
[~ `buck`[u.muc u.luw]]
?: ?=([%code ~] tyl)
[~ (end 6 1 (shaf %code (shax sec:ex:q:sen:u.gys)))]
?: ?=([%tick @ ~] tyl)
=+ hur=(slaw %p i.t.tyl)
?~ hur ~
?. =(our (sein u.hur)) ~
[~ (end 6 1 (shaf %tick (mix u.hur (shax sec:ex:q:sen:u.gys))))]
?: ?=([%will ~] tyl)
(rick mar our law.saf.u.gys)
~
@ -1687,6 +1775,10 @@
?~ gys ~
=+ zet=zest:(ho:(~(um am [now fox]) our) his)
[~ ?:(=(%show i.tyl) >zet< zet)]
?: ?=([%pals ~] tyl)
?. =(our his)
~
[~ pals:(~(um am [now fox]) our)]
?. ?=([%life ~] tyl)
=+ muc=$(tyl [%life ~])
(perm our his ?~(muc 0 (,@ud u.muc)) tyl)

511
arvo/batz.hoon
View File

@ -2,12 +2,104 @@
:: batz (4b), shell
::
|= pit=vase
^- vane
=> =~
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4bA, shell models ::
::
|%
++ ghat :: out result <-$
$% [%crud p=@tas q=(list tank)] :: error with trace
[%hail ~] :: refresh
[%helo p=path q=prod] :: trigger prompt
[%init p=@p] :: report install
[%line p=@t] :: source line
[%logo p=@] :: logout
[%note p=@tD q=tank] :: show message
[%save p=path q=@] :: write atomic file
[%sage p=path q=*] :: write jamnoun
[%talk p=tank] :: show on console
[%tell p=(list ,@t)] :: dump lines
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: reboot by path
[%warn p=tape] :: syslog
== ::
++ kiss :: in request ->$
$% [%crud p=@tas q=(list tank)] :: error with trace
[%hail ~] :: refresh
[%hook ~] :: this term hung up
[%harm ~] :: all terms hung up
[%init p=@p] :: report install
[%kill p=~] :: kill a task
[%line p=@t] :: source line
[%ling ~] :: rotate interface
[%limn ~] :: rotate ship
[%make p=(unit ,@t) q=@ud r=@ s=?] :: wild license
[%noop ~] :: no operation
[%sith p=@p q=@uw r=?] :: imperial generator
[%wake ~] :: timer activate
[%wart p=sock q=@tas r=path s=*] :: network request
== ::
++ flog :: sent to %dill
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
== ::
++ hasp ,[p=ship q=term] :: see %gall
++ move ,[p=duct q=(mold newt ghat)] :: local move
++ newt ::
$% $: %a :: to %ames
$% [%cash p=@p q=buck] ::
[%make p=(unit ,@t) q=@ud r=@ s=?] ::
[%sith p=@p q=@uw r=?] ::
[%want p=sock q=path r=*] ::
== == ::
$: %b ::
$% [%hail ~] :: to %batz
[%line p=@t] ::
== == ::
$: %c :: to %clay
$% [%info p=@p q=@tas r=nori] ::
[%warp p=sock q=riff] ::
== == ::
$: %d :: to %dill
$% [%flog p=flog] ::
== == ::
$: %e :: to %eyre
$% [%band p=ship q=(list rout)] ::
[%that p=@ud q=love] ::
[%them p=(unit hiss)] ::
== == ::
$: %g :: to %gall
$% [%init p=ship] ::
[%mess p=hasp q=ship r=cage] ::
[%nuke p=hasp q=ship] ::
[%show p=hasp q=ship r=path] ::
[%wipe p=hasp] ::
== == == ::
++ rave :: see %clay
$% [& p=mood] :: single request
[| p=moat] :: change range
== ::
++ riff ,[p=desk q=(unit rave)] :: see %clay
++ sigh ,[@tas p=sign] :: sourced sign
++ sign :: in result $<-
$% [%crud p=@tas q=(list tank)] :: by any
[%hail ~] :: by any
[%helo p=path q=prod] :: by %ames
[%init p=@p] :: by %ames
[%mean p=(unit ,[p=term q=(list tank)])] :: by %gall
[%nice ~] :: by %gall
[%note p=@tD q=tank] :: by %clay
[%pipe p=(unit ,[p=tutu q=(list)])] :: by %batz
[%rush p=mark q=*] ::
[%rust p=mark q=*] ::
[%thou p=httr] :: by %eyre
[%waft p=sock q=*] :: by %ames
[%went p=ship q=cape] :: by %ames
[%writ p=riot] :: by %clay
== ::
--
|%
++ bard :: new session
|= who=ship ^- brad
%* . *brad
@ -18,6 +110,23 @@
p.sur 1
p.god 1
==
++ beau ,[p=(unit ,@ud) q=(map wire goal) r=boor] :: next/want/thread
++ beef :: raw product
$: p=(list gilt) :: actions
q=(list slip) :: requests
r=boar :: state
== ::
++ boar :: execution instance
$% [%n p=(unit coal) q=claw r=lath] :: new/ready
[%r p=(unit worm)] :: running/done
[%t p=coal] :: simple filter
== ::
++ boor :: new thread
$: p=(map ,@ud kite) :: dependencies
q=(qeu ,[p=wire q=?(sign kiss)]) :: waiting cards
r=(qeu ,[p=wire q=nose]) :: pending notes
s=boar :: execution
== ::
++ brad :: session/dynamic
$: fog=(list ,@ud) :: task consoles
fen=(map ,@tas ,@ud) :: named tasks
@ -72,6 +181,11 @@
==
++ brat ,[[who=ship bran] brad] :: don't ask why
++ brim (list ,[p=ship q=brad]) :: session
++ gyro ,[p=@ud q=wire r=prod] :: live prompt
++ task ::
$: paq=(qeu gyro) :: prompt queue
wip=[p=@ud q=(map ,@ud beau)] :: processes
== ::
-- ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4bB, session engine ::
@ -148,45 +262,68 @@
[r.fat (past:(fest p.fat hen) q.fat)]
::
++ lean :: lean:be
|= [tea=wire hen=duct fav=card] :: deliver card
|= [tea=wire hen=duct sin=sign] :: deliver card
^+ *fi
=+ lay=(lead tea hen)
?> ?=([%ma *] p.lay)
abet:(glob:q.lay t.p.lay fav)
abet:(glob:q.lay t.p.lay sin)
::
++ leap :: leap:be
|= [tea=wire hen=duct fav=card] :: handle event
|= [tea=wire hen=duct sin=sign] :: accept response
^- [p=(list move) q=brat]
?: ?=([%crud *] fav)
[[[[/d hen] [%flog fav]] ~] +<.^^$]
?+ -.fav
[[[hen fav] ~] +<.^^$]
%hail [[[hen [%helo prot]] ~] +<.^^$]
%line =+ gyp=?>(?=(^ fog) i.fog)
?: &(=(0 gyp) =(%$ p.fav)) $(fav [%hail ~])
=< abet
?: =(0 gyp)
lash:(gill:(fist hen) p.fav)
lash:(como:(fest gyp hen) p.fav)
%kill =+ gyp=?>(?=(^ fog) i.fog)
?: =(0 gyp) [[[hen [%logo ~]] ~] +<.^^$]
abet:kill:(fest gyp hen)
%ling ?> ?=(^ fog)
=> .(fog (weld t.fog `(list ,@ud)`[i.fog ~]))
[[[hen [%helo prot]] ~] +<.^^$]
%noop [~ +<.^^$]
:: %thee abet:lash:(lean tea hen fav)
?- -.sin
%crud [[[hen [%slip %d %flog sin]] ~] +<.^^$]
%hail [[[hen %give sin] ~] +<.^^$]
%helo [~ +<.^^$]
%init [[[hen %give sin] ~] +<.^^$]
%mean [~ +<.^^$]
%nice [~ +<.^^$]
%note [[[hen %give sin] ~] +<.^^$]
%pipe !!
%rush ?. (fear tea) :: legit
[~ +<.^^$]
abet:lash:(lean tea hen sin)
%rust ?. (fear tea) :: legit
[~ +<.^^$]
abet:lash:(lean tea hen sin)
%thou ?. (fear tea) :: legit
[~ +<.^^$]
abet:lash:(lean tea hen fav)
%waft :: ~& [%leap-waft fav]
abet:lash:(lean tea hen fav)
abet:lash:(lean tea hen sin)
%waft :: ~& [%leap-waft sin]
abet:lash:(lean tea hen sin)
%went ?. (fear tea)
~& [%went-fear tea]
[~ +<.^^$]
abet:lash:(lean tea hen fav)
%writ abet:lash:(loam tea hen +.fav)
%wart (lion hen +.fav)
abet:lash:(lean tea hen sin)
%writ abet:lash:(loam tea hen +.sin)
==
::
++ lear :: lear:be
|= [hen=duct kyz=kiss] :: handle request
^- [p=(list move) q=brat]
?- -.kyz
%crud [[[hen [%slip %d %flog kyz]] ~] +<.^^$]
%hail [[[hen [%give %helo prot]] ~] +<.^^$]
%harm [~ +<.^^$]
%hook ~&(%batz-hook [~ +<.^^$])
%line =+ gyp=?>(?=(^ fog) i.fog)
?: &(=(0 gyp) =(%$ p.kyz)) $(kyz [%hail ~])
=< abet
?: =(0 gyp)
lash:(gill:(fist hen) p.kyz)
lash:(como:(fest gyp hen) p.kyz)
%kill =+ gyp=?>(?=(^ fog) i.fog)
?. =(0 gyp)
abet:kill:(fest gyp hen)
?: =(~[/[%$]/term/1] ?>(?=(^ hen) t.hen)) :: XX gross
[[[hen [%give %logo ~]] ~] +<.^^$]
[~ +<.^^$]
%ling ?> ?=(^ fog)
=> .(fog (weld t.fog `(list ,@ud)`[i.fog ~]))
[[[hen [%give %helo prot]] ~] +<.^^$]
%noop [~ +<.^^$]
%wart (lion hen +.kyz)
?(%init %limn %make %sith %wake) !! :: handled earlier
==
::
++ leon :: leon:be
@ -204,7 +341,8 @@
:_ +<.^^$
=+ fom=(trip ((hard ,@) val))
^- (list move)
:~ :- [/d hen]
:~ :- hen
:+ %slip %d
:+ %flog %text
;: weld
pre
@ -254,7 +392,7 @@
::
++ fi :: fi:be
|= [gyp=@ud hen=duct gyr=task] :: process task
=| duv=(list ,[p=duct q=card])
=| duv=(list move)
|%
++ abet :: abet:fi:be
^- [(list move) brat] :: resolve
@ -270,8 +408,8 @@
==
:_ +<.^^$
%+ turn
(flop `_duv`?:(sam duv [[~ [%helo prot]] duv]))
|=([p=duct q=card] [(weld p hen) q])
(flop `_duv`?:(sam duv [[~ [%give %helo prot]] duv]))
|=([p=duct q=(mold newt ghat)] [(weld p hen) q])
::
++ bitt |=(lap=path [(scot %ud gyp) lap]) :: bitt:fi:be
++ como :: como:fi:be
@ -281,7 +419,6 @@
?~ ryg
+>.$
abet:abet:(pong:(ox:(past p.u.ryg) q.u.ryg) [%line lin])
::
++ gill :: gill:fi:be
|= lin=@t :: input line
^+ +>
@ -297,7 +434,7 @@
|= [lap=wire ted=@ud] :: XX ugly
^+ +>
%= +>
duv :_(duv [[/b ~] [%hail ~]])
duv :_(duv `move`[~ %pass ~ %b [%hail ~]])
paq.gyr
%- ~(gas to *(qeu gyro))
%+ skip
@ -309,7 +446,7 @@
|= [lap=wire ted=@ud pod=prod] :: install prompt
^+ +>
%_ +>
duv :_(duv [[/b ~] [%hail ~]])
duv :_(duv [~ %pass ~ %b [%hail ~]])
paq.gyr (~(put to paq.gyr) [ted lap pod])
==
::
@ -360,7 +497,7 @@
++ warn :: warn:fi:be
|= txt=tape :: send warning
^+ +>
+>(duv :_(duv [~ [%warn txt]]))
+>(duv :_(duv [~ [%give %warn txt]]))
::
++ ra :: ra:fi:be
|_ $: ted=@ud :: thread id
@ -445,9 +582,9 @@
%_(+> r.orb (~(put to r.orb) [lap nob]))
::
++ glob :: extern
|= [lap=wire fav=card]
|= [lap=wire sik=?(sign kiss)]
^+ +>
%_(+> q.orb (~(put to q.orb) [lap fav]))
%_(+> q.orb (~(put to q.orb) [lap sik]))
::
++ glum :: blocked thread
|= [gez=(list path) hog=boar]
@ -477,6 +614,7 @@
|= sik=skit
^+ +>
%+ gram ~
:- %give
:+ %note '^'
:- %leaf
;: weld
@ -508,11 +646,11 @@
[%clsg (turn pax |=(a=@ta [%dtzy %ta a]))]
::
++ gram :: add action
|= [hom=duct fav=card]
%_(+> duv [[hom fav] duv])
|= mov=move
%_(+> duv [mov duv])
::
++ gran :: add actions
|= vid=(list ,[p=duct q=card])
|= vid=(list move)
^+ +>
?~(vid +> $(vid t.vid, +> (gram i.vid)))
::
@ -522,7 +660,7 @@
?- -.ton
%0 [[~ p.ton] +>]
%1 [~ (glum ((list path) p.ton) s.orb)]
%2 [~ (gram(orb [~ ~ ~ %r ~]) ~ [%crud %exit p.ton])]
%2 [~ (gram(orb [~ ~ ~ %r ~]) ~ [%give %crud %exit p.ton])]
==
::
++ grid :: process result
@ -531,7 +669,7 @@
?- -.ton
%0 (fun p.ton)
%1 (glum ((list path) p.ton) s.orb)
%2 (gram(orb [~ ~ ~ %r ~]) ~ [%crud %exit p.ton])
%2 (gram(orb [~ ~ ~ %r ~]) ~ [%give %crud %exit p.ton])
==
::
++ grin :: process result
@ -540,7 +678,7 @@
?- -.ton
%0 (haul (fret p.ton))
%1 (glum ((list path) p.ton) hog)
%2 (gram(orb [~ ~ ~ %r ~]) ~ [%crud %exit p.ton])
%2 (gram(orb [~ ~ ~ %r ~]) ~ [%give %crud %exit p.ton])
==
::
++ grip :: step to completion
@ -694,7 +832,7 @@
::
++ gull :: request control
|= [tea=wire him=ship ryf=riff]
(gram ~[/c [%b tea]] [%warp [who him] ryf])
(gram ~ %pass tea %c [%warp [who him] ryf])
::
++ gulf :: stop request
|= [tea=wire kit=kite]
@ -735,11 +873,11 @@
^+ +>
?~ nex
?~ pun +>
(gran (turn q.u.pun |=(a=* [~ (gyve p.u.pun a)])))
(gran (turn q.u.pun |=(a=* [~ %give (gyve p.u.pun a)])))
+>.$(..ra abet:(glob:(past u.nex) ~ [%pipe pun]))
::
++ gyve :: print vase
|= [toy=tutu val=*] ^- card
|= [toy=tutu val=*] ^- ghat
=+ caf=((hard calf) (need (mang [felt:zu toy] sky)))
:: ?: =([~ [%atom %t]] caf)
:: [%tell ((hard ,@t) val) ~]
@ -772,32 +910,53 @@
+>.^$(loq p.gud)
%ck +>.^$(cwd p.gud)
%cs +>.^$(cws p.gud)
%de (gram ~ %note '#' q.gud)
%de (gram ~ %give %note '#' q.gud)
%ex =. +>.^$ guff
+>.^$(s.orb [%n p.gud *claw q.gud])
%ha (gram ~ %crud %soft [p.gud ~])
%ho (gram ~ %crud %soft p.gud)
%la (gram ~ %talk p.gud)
%lo (gran (turn p.gud |=(a=tank [~ %talk a])))
%ha (gram ~ %give %crud %soft [p.gud ~])
%ho (gram ~ %give %crud %soft p.gud)
%la (gram ~ %give %talk p.gud)
%lo (gran (turn p.gud |=(a=tank [~ %give %talk a])))
%mu !!
%mx |- ^+ +>.^^$
?~ p.gud +>.^^$
$(p.gud t.p.gud, +>.^^$ ^$(gud i.p.gud))
%ok (gram [/c ~] %info who p.gud q.gud)
%ok (gram ~ %pass ~ %c %info who p.gud q.gud)
%sc good:+>.^$(sac ?~(p.gud ?~(sac ~ +.sac) [u.p.gud sac]))
%sp !!
%sq =+ tea=(bist %ma r.gud)
%+ gram
[/a [%b tea] ~]
[%want [who p.gud] [%q q.gud %b tea] s.gud]
%sr (gram [/a /b ~] [%want [who p.gud] [%r q.gud] r.gud])
%te (gram ~ %tell p.gud)
%th (gram [/e ~] %that p.gud q.gud)
%+ gram ~
[%pass tea %a [%want [who p.gud] [%q q.gud %b tea] s.gud]]
%sr (gram ~ %pass ~ %a [%want [who p.gud] [%r q.gud] r.gud])
%te (gram ~ %give %tell p.gud)
%th (gram ~ %pass ~ %e %that p.gud q.gud)
%tq =+ tea=(bist %ma p.gud)
(gram [/e [%b tea] ~] [%them ~ q.gud])
(gram ~ %pass tea %e [%them ~ q.gud])
%va !!
%xx (gram ~ p.gud)
%xy (gram [p.gud /b ~] q.gud)
%xx =+ gah=((soft ghat) p.gud)
?~ gah
~& [%batz-xx (,@tas -.p.gud)]
!!
(gram ~ %give u.gah)
%xy ?. ?=([@ ~] p.gud)
~& [%batz-xyz p.gud]
!!
=+ hug=((soft newt) [i.p.gud q.gud])
?~ hug
~& [%batz-xy (,@tas -.q.gud)]
!!
(gram ~ %pass ~ u.hug)
%xz =+ tea=(bist %ma /chat/hi/hey)
(gram ~ %pass tea %g %mess p.gud q.gud r.gud !>(s.gud))
%zz =+ tea=(bist %ma q.gud)
?. ?=([@ ~] p.gud)
~& [%batz-zzz p.gud]
!!
=+ hug=((soft newt) [i.p.gud r.gud])
?~ hug
~& [%batz-zz (,@tas -.r.gud)]
!!
(gram ~ %pass tea u.hug)
==
==
::
@ -822,8 +981,9 @@
%eg (gulf (bist %ma lap) p.gal)
%es :: ~& %es-loss
(gull (bist %ma lap) p.gal q.gal ~)
%gr +>
%hp +>
%ht (gram [/e [%b (bist [%ma lap])] ~] [%band who ~])
%ht (gram ~ %pass (bist [%ma lap]) %e [%band who ~])
%lq (gump | p.gal gyp ted lap)
%ow +>
%rt +>
@ -840,8 +1000,9 @@
%eg (gulp (bist %ma lap) p.gal)
%es :: ~& %es-moor
(gull (bist %ma lap) p.gal q.gal [~ r.gal])
%gr +>
%hp +>
%ht (gram [/e [%b (bist [%ma lap])] ~] [%band who p.gal])
%ht (gram ~ %pass [%b (bist [%ma lap])] %e [%band who p.gal])
%lq (gump & p.gal [gyp ted lap])
%ow +>
%rt +>
@ -868,74 +1029,78 @@
++ pane |=(gal=goal %_(. lug [~ gal])) :: set goal
++ pang %_(. lug ~) :: delete goal
++ pong :: accept card
|= fav=card
|= sik=?(sign kiss)
^+ +>
?> ?=(^ lug)
?- -.u.lug
~
?> ?=(%pipe -.fav)
+>.$(+>.$ (glib lap [%$ p.fav]))
?> ?=(%pipe -.sik)
+>.$(+>.$ (glib lap [%$ p.sik]))
::
%do !!
::
%eg
?> ?=(%writ -.fav)
+>.$(lug ~, +>.$ (glib lap [%eg +.fav]))
?> ?=(%writ -.sik)
+>.$(lug ~, +>.$ (glib lap [%eg +.sik]))
::
%es
?> ?=(%writ -.fav)
?> ?=(%writ -.sik)
=+ ^= goh ^- (unit goal)
?~ p.fav `(unit goal)`~
?~ p.sik `(unit goal)`~
?- -.r.u.lug
%& ~
%|
^- (unit goal)
:- ~
?> ?=(%ud -.q.p.u.p.fav)
?> ?=(%ud -.q.p.u.p.sik)
%= u.lug
p.p.r
?> ?| !=(%ud -.p.p.r.u.lug)
=(p.p.p.r.u.lug p.q.p.u.p.fav)
=(p.p.p.r.u.lug p.q.p.u.p.sik)
==
[%ud +(p.q.p.u.p.fav)]
[%ud +(p.q.p.u.p.sik)]
==
==
=. loz ?~(goh (~(del by loz) lap) (~(put by loz) lap u.goh))
%= +>.$
lug goh
gul goh
+>.$ (glib lap [%eg +.fav])
+>.$ (glib lap [%eg +.sik])
==
::
%gr
?> ?=(?(%rush %rust) -.sik)
+>.$(+>.$ (glib lap [%gr +.sik]))
::
%hp
?> ?=(%thou -.fav)
+>.$(+>.$ (glib lap [%hp +.fav]))
?> ?=(%thou -.sik)
+>.$(+>.$ (glib lap [%hp +.sik]))
::
%ht !!
:: ?> ?=(%thee -.fav)
:: +>.$(+>.$ (glib lap [%ht +.fav]))
:: ?> ?=(%thee -.sik)
:: +>.$(+>.$ (glib lap [%ht +.sik]))
::
%lq
?> ?=(%wart -.fav)
+>.$(+>.$ (glib lap [%lq q.p.fav r.fav s.fav]))
?> ?=(%wart -.sik)
+>.$(+>.$ (glib lap [%lq q.p.sik r.sik s.sik]))
::
%rt
?: ?=(%went -.fav)
?. ?=(%dead q.fav) +>.$
?: ?=(%went -.sik)
?. ?=(%dead q.sik) +>.$
+>.$(+>.$ (glib lap [%rt ~]))
?> ?=(%waft -.fav)
+>.$(+>.$ (glib lap [%rt ~ q.fav]))
?> ?=(%waft -.sik)
+>.$(+>.$ (glib lap [%rt ~ q.sik]))
::
%up
?> ?=(%line -.fav)
+>.$(+>.$ (glib lap [%up +.fav]))
?> ?=(%line -.sik)
+>.$(+>.$ (glib lap [%up +.sik]))
::
%ow
?> ?=(%went -.fav)
+>.$(+>.$ (glib lap [%ow q.fav]))
?> ?=(%went -.sik)
+>.$(+>.$ (glib lap [%ow q.sik]))
::
%wa
?> ?=(%wake -.fav)
?> ?=(%wake -.sik)
+>.$(+>.$ (glib lap [%wa ~]))
==
--
@ -1144,20 +1309,33 @@
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4bC, shell vane ::
::
=| $: big=(unit ,@p) :: major ship
=| $: %0
big=(unit ,@p) :: major ship
dez=(map duct brim) :: state by ship
== ::
|= [now=@da eny=@ ska=$+(* (unit (unit)))] :: current invocation
|= [now=@da eny=@ ski=sled] :: current invocation
^? :: opaque core
|% :: poke/peek pattern
++ beat :: process move
|= [tea=wire hen=duct fav=card]
^- [p=(list move) q=vane]
:: ~& [%batz-beat -.fav [%tea tea] [%hen hen]]
++ call :: handle request
|= $: hen=duct
hic=(hypo (hobo kiss))
==
=> %= . :: XX temporary
q.hic
^- kiss
?: ?=(%soft -.q.hic)
:: ~& [%dill-call-soft (,@tas `*`-.p.q.hic)]
((hard kiss) p.q.hic)
?: (~(nest ut -:!>(*kiss)) | p.hic) q.hic
~& [%batz-call-flub (,@tas `*`-.q.hic)]
((hard kiss) q.hic)
==
^- [p=(list move) q=_..^$]
=+ ska=(slod ski)
=+ sky=|=(* `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a]))))
?: ?=([%crud *] fav)
[[[[/d hen] [%flog fav]] ~] ..^$]
?: ?=(%wake -.fav)
?: ?=([%crud *] q.hic)
[[[hen [%slip %d %flog q.hic]] ~] ..^$]
?: ?=(%wake -.q.hic)
=+ ^= fiy
=| fiy=(list ,[p=duct q=ship r=[p=@ud q=@ud r=wire]])
|- ^+ fiy
@ -1177,7 +1355,7 @@
[[p.n.dez p.i.q.n.dez p.n.tem.q.i.q.n.dez] fiy]
==
=| wam=(list move)
|- ^- [p=(list move) q=vane]
|- ^- [p=(list move) q=_..^^$]
?~ fiy [wam ..^^$]
=+ dos=(need (~(get by dez) p.i.fiy))
=+ suy=|-(`brad`?~(dos !! ?.(=(q.i.fiy p.i.dos) $(dos t.dos) q.i.dos)))
@ -1192,71 +1370,44 @@
wam (weld p.yub wam)
dez.^^$ (~(put by dez.^^$) p.i.fiy [[q.i.fiy +.q.yub] +.dos])
==
|- ^- [p=(list move) q=vane]
|- ^- [p=(list move) q=_..^^$]
=+ dus=(~(get by dez) hen)
?~ dus
?+ -.fav
~& [%beat-none -.fav tea hen]
~|([%beat-none -.fav] !!)
?+ -.q.hic
~& [%take-none -.q.hic ~ hen]
~|([%take-none -.q.hic] !!)
::
%hail
?~ big
~& [%beat-hail-soon hen]
~& [%call-hail-soon hen]
[~ ..^^$]
~& [%batz-hack-console hen]
$(dez (~(put by dez) hen [[u.big (bard u.big)] ~]))
::
%init
:: ~& [%beat-init p.fav hen]
:: ~& [%take-init p.q.hic hen]
=. big ?~ big
`p.fav
`(min p.fav u.big)
=+ bos=(sein p.fav)
=. bos ?.(=(bos p.fav) bos ~zod)
:- :- [hen fav]
?: =(bos p.fav) ~
`p.q.hic
`(min p.q.hic u.big)
=+ bos=(sein p.q.hic)
:- :- [hen [%give q.hic]]
?: =(bos p.q.hic) ~
:_ ~
[[/b hen] [%line (rap 3 ":{(scow %p bos)}/main=/bin/update")]]
..^^$(dez (~(put by dez) hen [[p.fav (bard p.fav)] ~]))
[hen [%slip %b %line (rap 3 ":{(scow %p bos)}/main=/bin/update")]]
..^^$(dez (~(put by dez) hen [[p.q.hic (bard p.q.hic)] ~]))
::
?(%loin %make %sith)
[[[[/a [%b tea] hen] fav] ~] ..^^$]
?(%make %sith)
[[[hen [%pass ~ %a q.hic]] ~] ..^^$]
==
?> ?=(^ u.dus)
?+ -.fav
=+ beg=`brat`[[p.i.u.dus bred] q.i.u.dus]
=+ yub=(leap:((be beg) now eny sky) tea hen fav)
:- p.yub
..^^$(dez (~(put by dez) hen [[p.i.u.dus +.q.yub] t.u.dus]))
::
%init
=+ bos=(sein p.fav)
=. bos ?.(=(bos p.fav) bos ~zod)
:- :* [hen fav]
[[[%b tea] hen] [%hail ~]]
?: =(bos p.fav) ~
:_ ~
[[/b hen] [%line (rap 3 ":{(scow %p bos)}/main=/bin/update")]]
==
..^^$(dez (~(put by dez) hen [[p.fav (bard p.fav)] u.dus]))
::
%limn
$(fav [%hail ~], dez (~(put by dez) hen (weld t.u.dus `brim`[i.u.dus ~])))
==
::
++ call :: process move
|= [hen=duct fav=card]
(beat ~ hen fav)
::
++ come
|= [sam=? old=vase]
^- vane
(load old)
=+ beg=`brat`[[p.i.u.dus bred] q.i.u.dus]
=+ yub=(lear:((be beg) now eny sky) hen q.hic)
:- p.yub
..^^$(dez (~(put by dez) hen [[p.i.u.dus +.q.yub] t.u.dus]))
::
++ doze
|= [now=@da hen=duct]
^- (unit ,@da)
=| doz=(unit ,@da)
=| doz=(unit ,@da)
|- ^+ doz
?~ dez doz
=. doz $(dez l.dez)
@ -1274,20 +1425,60 @@
==
::
++ load
|= old=vase
^- vane
~? !(~(nest ut -:!>(dez)) | p.old) %batz-reset
..^$(dez ((map duct brim) q.old))
::
++ raze
^- vane
..$(dez ~)
|= old=[%0 big=(unit ,@p) dez=(map duct brim)]
^+ ..^$
..^$(big big.old, dez dez.old)
::
++ scry
|= [our=ship ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit))
|= [fur=(unit (set monk)) ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit (pair mark ,*)))
~
::
++ stay `vase`!>(dez)
++ vern [164 0]
++ stay [%0 big dez]
++ take :: accept response
|= [tea=wire hen=duct hin=(hypo sigh)]
^- [p=(list move) q=_..^$]
:: ~& [%batz-take -.p.q.hin [%tea tea] [%hen hen]]
=+ ska=(slod ski)
=+ sky=|=(* `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a]))))
?: ?=([%crud *] p.q.hin)
[[[hen [%slip %d %flog p.q.hin]] ~] ..^$]
=+ dus=(~(get by dez) hen)
?~ dus
?+ -.p.q.hin
~&([%take-none -.p.q.hin] !!)
::
%hail
?~ big
~& [%take-hail-soon hen]
[~ ..^$]
:: ~& [%batz-take-console hen]
$(dez (~(put by dez) hen [[u.big (bard u.big)] ~]))
::
%init
:: ~& [%take-init p.p.q.hin hen]
=. big ?~ big
`p.p.q.hin
`(min p.p.q.hin u.big)
=+ bos=(sein p.p.q.hin)
:- :- [hen [%give p.q.hin]]
?: =(bos p.p.q.hin) ~
:_ ~
[hen [%slip %b %line (rap 3 ":{(scow %p bos)}/main=/bin/update")]]
..^$(dez (~(put by dez) hen [[p.p.q.hin (bard p.p.q.hin)] ~]))
==
?> ?=(^ u.dus)
?: ?=(%init -.p.q.hin)
=+ bos=(sein p.p.q.hin)
:- :* [hen %give p.q.hin]
[[[%b ~] hen] [%sick %hail ~]]
?: =(bos p.p.q.hin) ~
:_ ~
[[/b hen] [%sick %line (rap 3 ":{(scow %p bos)}/main=/bin/update")]]
==
..^$(dez (~(put by dez) hen [[p.p.q.hin (bard p.p.q.hin)] u.dus]))
=+ beg=`brat`[[p.i.u.dus bred] q.i.u.dus]
=+ yub=(leap:((be beg) now eny sky) tea hen p.q.hin)
:- p.yub
..^$(dez (~(put by dez) hen [[p.i.u.dus +.q.yub] t.u.dus]))
--

935
arvo/clay.hoon
View File

@ -2,498 +2,545 @@
:: clay (4c), revision control
::
|= pit=vase
^- vane
=>
=> |%
++ cult (map duct rave) :: subscriptions
++ dojo ,[p=cult q=dome] :: domestic desk state
++ gift :: out result <-$
$% [%ergo p=@p q=@tas r=@ud] :: version update
[%note p=@tD q=tank] :: debug message
[%writ p=riot] :: response
== ::
++ kiss :: in request ->$
$% [%info p=@p q=@tas r=nori] :: internal edit
[%ingo p=@p q=@tas r=nori] :: internal noun edit
[%init p=@p] :: report install
[%into p=@p q=@tas r=nori] :: external edit
[%invo p=@p q=@tas r=nori] :: external noun edit
[%wake ~] :: timer activate
[%wart p=sock q=@tas r=path s=*] :: network request
[%warp p=sock q=riff] :: file request
== ::
++ move ,[p=duct q=(mold note gift)] :: local move
++ note :: out request $->
$% $: %a :: to %ames
$% [%want p=sock q=path r=*] ::
== == ::
$: %c :: to %clay
$% [%warp p=sock q=riff] ::
== == ::
$: %d ::
$% [%flog p=[%crud p=@tas q=(list tank)]] :: to %dill
== == == ::
++ sign :: in result $<-
$? $: %a :: by %ames
$% [%waft p=sock q=*] ::
[%went p=ship q=cape] ::
== == ::
$: %c :: by %clay
$% [%writ p=riot] ::
== == ::
$: @tas :: by any
$% [%crud p=@tas q=(list tank)] ::
== == == ::
++ raft :: filesystem
$: fat=(map ship room) :: domestic
hoy=(map ship rung) :: foreign
== ::
++ rave :: general request
$% [& p=mood] :: single request
[| p=moat] :: change range
== ::
++ rede :: universal project
$: lim=@da :: complete to
qyx=cult :: subscribers
ref=(unit rind) :: outgoing requests
dom=dome :: revision state
== ::
++ riff ,[p=desk q=(unit rave)] :: request/desist
++ rind :: request manager
$: nix=@ud :: request index
bom=(map ,@ud ,[p=duct q=rave]) :: outstanding
fod=(map duct ,@ud) :: current requests
haw=(map mood (unit)) :: simple cache
== ::
++ room :: fs per ship
$: hun=duct :: terminal duct
hez=(unit duct) :: sync duct
dos=(map desk dojo) :: native desk
== ::
++ rung $: rus=(map desk rede) :: neighbor desks
== ::
-- =>
::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4cA, filesystem logic ::
::
|%
::
++ un :: per ship
::
|%
++ de :: per desk
|= [now=@da hun=duct hez=(unit duct)]
|= [[who=@p for=@p] syd=@ta rede]
=* red +<+>
=| yel=(list ,[p=duct q=gift])
=| byn=(list ,[p=duct q=riot])
=| vag=(list ,[p=duct q=gift])
=| say=(list ,[p=duct q=path r=ship s=[p=@ud q=riff]])
|%
++ abet
^- [(list move) rede]
:_ red
;: weld
%+ turn (flop yel)
|=([a=duct b=gift] [hun %give b])
::
%+ turn (flop byn)
|=([a=duct b=riot] [a %give [%writ b]])
::
%+ turn (flop vag)
|=([a=duct b=gift] [a %give b])
::
%+ turn (flop say)
|= [a=duct b=path c=ship d=[p=@ud q=riff]]
:- a
[%pass b %a %want [who c] [%q %re p.q.d (scot %ud p.d) ~] q.d]
==
::
++ aver :: read
|= mun=mood
^- (unit (unit ,*))
=+ ezy=?~(ref ~ (~(get by haw.u.ref) mun))
?^ ezy ezy
=+ nao=(~(aeon ze lim dom) q.mun)
:: ~& [%aver-mun nao [%from syd lim q.mun]]
?~(nao ~ [~ (~(avid ze lim dom) u.nao mun)])
::
++ balk :: read and send
|= [hen=duct oan=@ud mun=mood]
^+ +>
=+ vid=(~(avid ze lim dom) oan mun)
?~ vid (blob hen) (blab hen mun u.vid)
::
++ blab :: ship result
|= [hen=duct mun=mood dat=*]
^+ +>
+>(byn [[hen ~ [p.mun q.mun syd] r.mun dat] byn])
::
++ bleb :: ship sequence
|= [hen=duct ins=@ud hip=(list frog)]
^+ +>
?~ hip +>
%= $
hip t.hip
ins +(ins)
+> (blab hen [%w [%ud ins] ~] i.hip)
==
::
++ blob :: ship stop
|= hen=duct
%_(+> byn [[hen ~] byn])
::
++ doze :: sleep until
=+ xiq=(~(tap by qyx) ~)
^- (unit ,@da)
%+ roll xiq
|= [xaq=[p=duct q=rave] nex=(unit ,@da)]
%+ hunt nex
?- -.q.xaq
& ?.(?=(%da -.q.p.q.xaq) ~ [~ p.q.p.q.xaq])
::
|
=+ mot=`moat`p.q.xaq
%+ hunt
?. ?=(%da -.p.mot) ~
?.((lth now p.p.mot) ~ [~ p.p.mot])
?. ?=(%da -.q.mot) ~
?.((lth now p.q.mot) [~ now] [~ p.q.mot])
==
::
++ duce :: produce request
|= [hen=duct rav=rave]
^+ +>
=. qyx (~(put by qyx) hen rav)
?~ ref +>
|- ^+ +>+.$
=+ ^= vaw ^- rave
?. ?=([%& %v *] rav) rav
[%| [%ud let.dom] `case`q.p.rav]
=+ inx=nix.u.ref
%= +>+.$
say [[hen [(scot %ud inx) ~] for [inx syd ~ vaw]] say]
nix.u.ref +(nix.u.ref)
bom.u.ref (~(put by bom.u.ref) inx [hen vaw])
fod.u.ref (~(put by fod.u.ref) hen inx)
==
::
++ ease :: release request
|= hen=duct
^+ +>
=. qyx (~(del by qyx) hen)
?~ ref +>
|- ^+ +>+.$
=+ nux=(~(get by fod.u.ref) hen)
?~ nux +>+.$
%= +>+.$
say [[hen [(scot %ud u.nux) ~] for [u.nux syd ~]] say]
fod.u.ref (~(del by fod.u.ref) hen)
bom.u.ref (~(del by bom.u.ref) u.nux)
==
::
++ eave :: subscribe
|= [hen=duct rav=rave]
^+ +>
?- -.rav
&
=+ ver=(aver p.rav)
?~ ver
(duce hen rav)
?~ u.ver
(blob hen)
(blab hen p.rav u.u.ver)
::
|
=+ nab=(~(aeon ze lim dom) p.p.rav)
?~ nab
?> =(~ (~(aeon ze lim dom) q.p.rav))
(duce hen rav)
=+ huy=(~(aeon ze lim dom) q.p.rav)
?: &(?=(^ huy) |((lth u.huy u.nab) &(=(0 u.huy) =(0 u.nab))))
(blob hen)
=+ top=?~(huy let.dom u.huy)
=+ seb=(slag (sub let.dom top) hit.dom)
=+ wid=(sub top u.nab)
=+ fud=(flop (scag wid seb))
=. +>.$ (bleb hen u.nab fud)
?^ huy
(blob hen)
=+ ^= ptr ^- case
?: =(0 u.nab) [%da _@da]
=+(old=(slag wid seb) ?>(?=(^ old) `case`[%da p.i.old]))
(duce hen `rave`[%| ptr q.p.rav])
==
::
++ echo :: announce changes
|= [hen=duct wen=@da lem=nori]
^+ +>
=. lem (alas lem [who syd +(let.dom)])
%= +>
vag ?~(hez vag :_(vag [u.hez [%ergo who syd let.dom]]))
yel
=+ pre=`path`~[(scot %p for) syd (scot %ud let.dom)]
?- -.lem
| :_ yel
[hen %note '=' %leaf :(weld (trip p.lem) " " (spud pre))]
& |- ^+ yel
?~ q.q.lem yel
:_ $(q.q.lem t.q.q.lem)
:- hen
:+ %note
?-(-.q.q.i.q.q.lem %del '-', %ins '+', %mut ':')
[%leaf (spud (weld pre p.i.q.q.lem))]
==
==
::
++ edit :: apply changes
|= [wen=@da lem=nori]
^+ +>
=. lem (alas lem [who syd +(let.dom)])
+>(dom +<+:(~(axel ze lim dom) wen lem))
::
++ exec :: change and update
|= [hen=duct wen=@da lem=nori]
^+ +>
(echo:wake:(edit wen lem) hen wen lem)
::
++ knit :: external change
|= [inx=@ud rot=riot]
^+ +>
?> ?=(^ ref)
|- ^+ +>+.$
=+ ruv=(~(get by bom.u.ref) inx)
?~ ruv +>+.$
=> ?. |(?=(~ rot) ?=(& -.q.u.ruv)) .
%_ .
bom.u.ref (~(del by bom.u.ref) inx)
fod.u.ref (~(del by fod.u.ref) p.u.ruv)
==
?~ rot
=+ rav=`rave`q.u.ruv
%= +>+.$
lim
?.(&(?=(| -.rav) ?=(%da -.q.p.rav)) lim `@da`p.q.p.rav)
::
haw.u.ref
?. ?=(& -.rav) haw.u.ref
(~(put by haw.u.ref) p.rav ~)
==
?< ?=(%v p.p.u.rot)
=. haw.u.ref
(~(put by haw.u.ref) [p.p.u.rot q.p.u.rot q.u.rot] ~ r.u.rot)
?. ?=(%w p.p.u.rot) +>+.$
|- ^+ +>+.^$
=+ nez=[%w [%ud let.dom] ~]
=+ nex=(~(get by haw.u.ref) nez)
?~ nex +>+.^$
?~ u.nex +>+.^$ :: should never happen
%= $
haw.u.ref (~(del by haw.u.ref) nez)
+>+.^$ =+ roo=(edit ((hard frog) u.u.nex))
?>(?=(^ ref.roo) roo)
==
::
++ wake :: update subscribers
^+ .
=+ xiq=(~(tap by qyx) ~)
=| xaq=(list ,[p=duct q=rave])
|- ^+ ..wake
?~ xiq
..wake(qyx (~(gas by *cult) xaq))
?- -.q.i.xiq
&
=+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.q.i.xiq))
?^ cas
%= $
xiq t.xiq
..wake ?~ u.cas (blob p.i.xiq)
(blab p.i.xiq p.q.i.xiq u.u.cas)
==
=+ nao=(~(aeon ze lim dom) q.p.q.i.xiq)
?~ nao $(xiq t.xiq, xaq [i.xiq xaq])
$(xiq t.xiq, ..wake (balk p.i.xiq u.nao p.q.i.xiq))
::
|
=+ mot=`moat`p.q.i.xiq
=+ nab=(~(aeon ze lim dom) p.mot)
?~ nab
$(xiq t.xiq, xaq [i.xiq xaq])
=+ huy=(~(aeon ze lim dom) q.mot)
?~ huy
?: =(let.dom u.nab)
$(xiq t.xiq, xaq [i.xiq xaq])
?> ?=(^ hit.dom)
=+ ptr=[%da p.i.hit.dom]
=+ fud=(flop (scag (sub let.dom u.nab) `(list frog)`hit.dom))
%= $
xiq t.xiq
xaq [[p.i.xiq [%| ptr q.mot]] xaq]
..wake (bleb p.i.xiq let.dom fud)
==
=+ yad=(slag (sub let.dom u.huy) `(list frog)`hit.dom)
=+ fud=(flop (scag (sub u.huy u.nab) yad))
%= $
xiq t.xiq
..wake (blob:(bleb p.i.xiq +(u.nab) fud) p.i.xiq)
==
==
--
::
++ do
|= [now=@da [who=ship him=ship] syd=@tas ruf=raft]
=+ ^= rug ^- rung
=+ rug=(~(get by hoy.ruf) him)
?^(rug u.rug *rung)
=+ ^= red ^- rede
=+ yit=(~(get by rus.rug) syd)
?^(yit u.yit `rede`[~2000.1.1 ~ [~ *rind] *dome])
((de now ~ ~) [who him] syd red)
::
++ posh
|= [him=ship syd=desk red=rede ruf=raft]
^- raft
=+ ^= rug ^- rung
=+ rug=(~(get by hoy.ruf) him)
?^(rug u.rug *rung)
ruf(hoy (~(put by hoy.ruf) him rug(rus (~(put by rus.rug) syd red))))
::
++ un :: domestic ship
|= [who=@p now=@da ruf=raft]
=+ ^= yar ^- room
=+ yar=(~(get by fat.ruf) who)
?~(yar *room u.yar)
=| yel=(list ,[p=duct q=card])
=| byn=(list ,[p=duct q=riot])
=| vag=(list ,[p=duct q=card])
=| say=(list ,[p=duct q=ship r=[p=@ud q=riff]])
|%
++ abet
^- [(list move) raft]
:_ ruf(fat (~(put by fat.ruf) who yar))
;: weld
%+ turn (flop yel)
|=([a=duct b=card] [hun.yar b])
::
%+ turn (flop byn)
|=([a=duct b=riot] [a [%writ b]])
::
%+ turn (flop vag)
|=([a=duct b=card] [a b])
::
%+ turn (flop say)
|= [a=duct b=ship c=[p=@ud q=riff]]
:- [/a a]
[%want [who b] [%q %re p.q.c (scot %ud p.c) ~] q.c]
==
::
++ abet ruf(fat (~(put by fat.ruf) who yar))
++ doze
=+ saz=(turn (~(tap by dos.yar) ~) |=([a=@tas b=*] a))
=| nex=(unit ,@da)
|- ^+ nex
?~ saz nex
$(saz t.saz, nex (hunt nex doze:(di i.saz)))
^- (unit ,@da)
%+ roll (~(tap by dos.yar) ~)
|= [[saz=@tas *] nex=(unit ,@da)]
%+ hunt nex
doze:(di saz)
::
++ pish
|= [syd=@ta red=rede]
%_(+> dos.yar (~(put by dos.yar) syd [qyx.red dom.red]))
::
++ wake
^+ .
=+ saz=(turn (~(tap by dos.yar) ~) |=([a=@tas b=*] a))
|- ^+ ..wake
?~ saz ..wake
$(saz t.saz, ..wake abet:wake:(di i.saz))
::
++ zest
|= his=@p
:~ :- %load
=+ sim=(scot %p his)
=+ sod=(~(tap by dos.yar) ~)
|- ^- (list ,[p=@tas q=path q=rave])
?~ sod ~
=+ xiq=(~(tap by `cult`p.q.i.sod) ~)
|- ^- (list ,[p=@tas q=path r=rave])
?~ xiq ^$(sod t.sod)
=+ nex=$(xiq t.xiq)
?. ?& ?=([[%c @ *] *] p.i.xiq)
=(sim i.t.i.p.i.xiq)
== nex
[[p.i.sod t.t.i.p.i.xiq q.i.xiq] nex]
::
:- %know
=+ rob=(~(get by rid.yar) his)
?~ rob ~
=+ vob=(~(tap by u.rob) ~)
|-
?~ vob ~
:- p.i.vob
:~ [%lim lim.q.i.vob]
[%qyx qyx.q.i.vob]
?~ ref.q.i.vob
~
:~ [%nix nix.u.ref.q.i.vob]
[%bom bom.u.ref.q.i.vob]
[%fod fod.u.ref.q.i.vob]
==
==
==
::
++ zeta
|= [his=@p syd=@tas lok=case tyl=path]
^- (unit)
?. ?=([%da @] lok) ~
?. ?=(~ tyl) ~
?+ syd ~
%show [~ `tank`>(zest his)<]
%tell [~ (zest his)]
==
::
++ de :: per desk
|_ [for=@p syd=@ta rede]
++ abet
?: =(for who)
%_(..de dos.yar (~(put by dos.yar) syd qyx dom))
%_ ..de
rid.yar
=+ ^= rob ^- (map ,@tas rede)
=+ rob=(~(get by rid.yar) for)
?~(rob ~ u.rob)
(~(put by rid.yar) for (~(put by rob) syd `rede`+<+>.abet))
==
::
++ aver :: read
|= mun=mood
^- (unit (unit ,*))
=+ ezy=?~(ref ~ (~(get by haw.u.ref) mun))
?^ ezy ezy
=+ nao=(~(aeon ze lim dom) q.mun)
:: ~& [%aver-mun nao [%from syd lim q.mun]]
?~(nao ~ [~ (~(avid ze lim dom) u.nao mun)])
::
++ balk :: read and send
|= [hen=duct oan=@ud mun=mood]
^+ +>
=+ vid=(~(avid ze lim dom) oan mun)
?~ vid (blob hen) (blab hen mun u.vid)
::
++ blab :: ship result
|= [hen=duct mun=mood dat=*]
^+ +>
+>(byn [[hen ~ [p.mun q.mun syd] r.mun dat] byn])
::
++ bleb :: ship sequence
|= [hen=duct ins=@ud hip=(list frog)]
^+ +>
?~ hip +>
%= $
hip t.hip
ins +(ins)
+> (blab hen [%w [%ud ins] ~] i.hip)
==
::
++ blob :: ship stop
|= hen=duct
%_(+> byn [[hen ~] byn])
::
++ doze :: sleep until
=+ xiq=(~(tap by qyx) ~)
=| nex=(unit ,@da)
|- ^+ nex
?~ xiq nex
=+ ^= zis ^+ nex
?- -.q.i.xiq
& ?.(?=(%da -.q.p.q.i.xiq) ~ [~ p.q.p.q.i.xiq])
::
|
=+ mot=`moat`p.q.i.xiq
%+ hunt
?. ?=(%da -.p.mot) ~
?.((lth now p.p.mot) ~ [~ p.p.mot])
?. ?=(%da -.q.mot) ~
?.((lth now p.q.mot) [~ now] [~ p.q.mot])
==
$(xiq t.xiq, nex (hunt nex zis))
::
++ duce :: produce request
|= [hen=duct rav=rave]
^+ +>
=. qyx (~(put by qyx) hen rav)
?~ ref +>
|- ^+ +>+.$
=+ ^= vaw ^- rave
?. ?=([%& %v *] rav) rav
[%| [%ud let.dom] `case`q.p.rav]
=+ inx=nix.u.ref
%= +>+.$
say [[[[%c (scot %ud inx) ~] hen] for [inx syd ~ vaw]] say]
nix.u.ref +(nix.u.ref)
bom.u.ref (~(put by bom.u.ref) inx [hen vaw])
fod.u.ref (~(put by fod.u.ref) hen inx)
==
::
++ ease :: release request
|= hen=duct
^+ +>
=. qyx (~(del by qyx) hen)
?~ ref +>
|- ^+ +>+.$
=+ nux=(~(get by fod.u.ref) hen)
?~ nux +>+.$
%= +>+.$
say [[[[%c (scot %ud u.nux) ~] hen] for [u.nux syd ~]] say]
fod.u.ref (~(del by fod.u.ref) hen)
bom.u.ref (~(del by bom.u.ref) u.nux)
==
::
++ eave :: subscribe
|= [hen=duct rav=rave]
^+ +>
?- -.rav
&
=+ ver=(aver p.rav)
?~ ver
(duce hen rav)
?~ u.ver
(blob hen)
(blab hen p.rav u.u.ver)
::
|
=+ nab=(~(aeon ze lim dom) p.p.rav)
?~ nab
?> =(~ (~(aeon ze lim dom) q.p.rav))
(duce hen rav)
=+ huy=(~(aeon ze lim dom) q.p.rav)
?: &(?=(^ huy) |((lth u.huy u.nab) &(=(0 u.huy) =(0 u.nab))))
(blob hen)
=+ top=?~(huy let.dom u.huy)
=+ seb=(slag (sub let.dom top) hit.dom)
=+ wid=(sub top u.nab)
=+ fud=(flop (scag wid seb))
=. +>.$ (bleb hen u.nab fud)
?^ huy
(blob hen)
=+ ^= ptr ^- case
?: =(0 u.nab) [%da _@da]
=+(old=(slag wid seb) ?>(?=(^ old) `case`[%da p.i.old]))
(duce hen `rave`[%| ptr q.p.rav])
==
::
++ echo :: announce changes
|= [hen=duct wen=@da lem=nori]
^+ +>
%= +>
vag ?~(hez.yar vag :_(vag [u.hez.yar [%ergo who syd let.dom]]))
yel
=+ pre=`path`~[(scot %p for) syd (scot %ud let.dom)]
?- -.lem
| :_ yel
[hen %note '=' %leaf :(weld (trip p.lem) " " (spud pre))]
& |- ^+ yel
?~ q.q.lem yel
:_ $(q.q.lem t.q.q.lem)
:- hen
:+ %note
?-(-.q.i.q.q.lem %del '-', %ins '+', %mut ':')
[%leaf (spud (weld pre p.i.q.q.lem))]
==
==
::
++ edit :: apply changes
|= [wen=@da lem=nori]
^+ +>
+>(dom +<+:(~(axel ze lim dom) wen lem))
::
++ exec :: change and update
|= [hen=duct wen=@da lem=nori]
^+ +>
(echo:wake:(edit wen lem) hen wen lem)
::
++ knit :: external change
|= [inx=@ud rot=riot]
^+ +>
?> ?=(^ ref)
|- ^+ +>+.$
=+ ruv=(~(get by bom.u.ref) inx)
?~ ruv +>+.$
=> ?. |(?=(~ rot) ?=(& -.q.u.ruv)) .
%_ .
bom.u.ref (~(del by bom.u.ref) inx)
fod.u.ref (~(del by fod.u.ref) p.u.ruv)
==
?~ rot
=+ rav=`rave`q.u.ruv
%= +>+.$
lim
?.(&(?=(| -.rav) ?=(%da -.q.p.rav)) lim `@da`p.q.p.rav)
::
haw.u.ref
?. ?=(& -.rav) haw.u.ref
(~(put by haw.u.ref) p.rav ~)
==
?< ?=(%v p.p.u.rot)
=. haw.u.ref
(~(put by haw.u.ref) [p.p.u.rot q.p.u.rot q.u.rot] ~ r.u.rot)
?. ?=(%w p.p.u.rot) +>+.$
|- ^+ +>+.^$
=+ nez=[%w [%ud let.dom] ~]
=+ nex=(~(get by haw.u.ref) nez)
?~ nex +>+.^$
?~ u.nex +>+.^$ :: should never happen
%= $
haw.u.ref (~(del by haw.u.ref) nez)
+>+.^$ =+ roo=(edit ((hard frog) u.u.nex))
?>(?=(^ ref.roo) roo)
==
::
++ wake :: update subscribers
^+ .
=+ xiq=(~(tap by qyx) ~)
=| xaq=(list ,[p=duct q=rave])
|- ^+ ..wake
?~ xiq
..wake(qyx (~(gas by *cult) xaq))
?- -.q.i.xiq
&
=+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.q.i.xiq))
?^ cas
%= $
xiq t.xiq
..wake ?~ u.cas (blob p.i.xiq)
(blab p.i.xiq p.q.i.xiq u.u.cas)
==
=+ nao=(~(aeon ze lim dom) q.p.q.i.xiq)
?~ nao $(xiq t.xiq, xaq [i.xiq xaq])
$(xiq t.xiq, ..wake (balk p.i.xiq u.nao p.q.i.xiq))
::
|
=+ mot=`moat`p.q.i.xiq
=+ nab=(~(aeon ze lim dom) p.mot)
?~ nab
$(xiq t.xiq, xaq [i.xiq xaq])
=+ huy=(~(aeon ze lim dom) q.mot)
?~ huy
?: =(let.dom u.nab)
$(xiq t.xiq, xaq [i.xiq xaq])
?> ?=(^ hit.dom)
=+ ptr=[%da p.i.hit.dom]
=+ fud=(flop (scag (sub let.dom u.nab) `(list frog)`hit.dom))
%= $
xiq t.xiq
xaq [[p.i.xiq [%| ptr q.mot]] xaq]
..wake (bleb p.i.xiq let.dom fud)
==
=+ yad=(slag (sub let.dom u.huy) `(list frog)`hit.dom)
=+ fud=(flop (scag (sub u.huy u.nab) yad))
%= $
xiq t.xiq
..wake (blob:(bleb p.i.xiq +(u.nab) fud) p.i.xiq)
==
==
--
=| moz=(list move)
=< [moz ..wake]
|- ^+ +
?~ saz +
=+ sog=abet:wake:(di i.saz)
$(saz t.saz, moz (weld moz -.sog), ..wake (pish i.saz +.sog))
::
++ di
|= syd=@ta
=+ ^= saq ^- dojo
=+ saq=(~(get by dos.yar) syd)
?~(saq *dojo u.saq)
~(. de who syd now p.saq ~ q.saq)
::
++ do
|= [him=ship syd=@tas]
=+ ^= red ^- rede
=+ roy=(~(get by rid.yar) him)
=+ yit=?~(roy ~ (~(get by u.roy) syd))
?^(yit u.yit `rede`[~2000.1.1 ~ [~ *rind] *dome])
:: ~& [%do-qyx him syd qyx.red]
~(. de him syd red)
((de now hun.yar hez.yar) [who who] syd now p.saq ~ q.saq)
--
--
::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4cA, filesystem vane ::
:: ::
=| :: instrument state
$: ruf=raft :: revision tree
$: %0 :: vane version
ruf=raft :: revision tree
== ::
|= [now=@da eny=@ ska=$+(* (unit (unit)))] :: activate
|= [now=@da eny=@ ski=sled] :: activate
^? :: opaque core
|% ::
++ beat :: update
|= [tea=wire hen=duct fav=card]
^- [p=(list move) q=vane]
?+ -.fav [[[hen fav] ~] ..^$]
%crud
[[[[/d hen] %flog fav] ~] ..^$]
::
++ call :: handle request
|= $: hen=duct
hic=(hypo (hobo kiss))
==
=> %= . :: XX temporary
q.hic
^- kiss
?: ?=(%soft -.q.hic)
((hard kiss) p.q.hic)
?: (~(nest ut -:!>(*kiss)) | p.hic) q.hic
~& [%clay-call-flub (,@tas `*`-.q.hic)]
((hard kiss) q.hic)
==
^- [p=(list move) q=_..^$]
?- -.q.hic
%init
[~ ..^$(fat.ruf (~(put by fat.ruf) p.fav [hen ~ ~ ~]))]
[~ ..^$(fat.ruf (~(put by fat.ruf) p.q.hic [hen ~ ~]))]
::
?(%info %into)
?: =(%$ q.fav)
?. ?=(%into -.fav) [~ ..^$]
=+ yar=(need (~(get by fat.ruf) p.fav))
[~ ..^$(fat.ruf (~(put by fat.ruf) p.fav yar(hez [~ hen])))]
?: =(%$ q.q.hic)
?. ?=(%into -.q.hic) [~ ..^$]
=+ yar=(need (~(get by fat.ruf) p.q.hic))
[~ ..^$(fat.ruf (~(put by fat.ruf) p.q.hic yar(hez [~ hen])))]
=^ mos ruf
=+ ^= zot
abet:(exec:(di:wake:(un p.fav now ruf) q.fav) hen now r.fav)
abet:zot(hez.yar ?.(=(%into -.fav) hez.yar.zot [~ hen]))
=+ une=(un p.q.hic now ruf)
=+ zot=abet:(exec:(di:wake:une q.q.hic) hen now r.q.hic)
:- -.zot
=. une (pish:une q.q.hic +.zot)
abet:une(hez.yar ?.(=(%into -.q.hic) hez.yar.une [~ hen]))
[mos ..^$]
::
?(%ingo %invo) :: not yet used
?: =(%$ q.q.hic)
?. ?=(%invo -.q.hic) [~ ..^$]
=+ yar=(need (~(get by fat.ruf) p.q.hic))
[~ ..^$(fat.ruf (~(put by fat.ruf) p.q.hic yar(hez [~ hen])))]
=^ mos ruf
=+ une=(un p.q.hic now ruf)
=+ zot=abet:(exec:(di:wake:une q.q.hic) hen now r.q.hic)
:- -.zot
=. une (pish:une q.q.hic +.zot)
abet:une(hez.yar ?.(=(%invo -.q.hic) hez.yar.une [~ hen]))
[mos ..^$]
::
%warp
=^ mos ruf
?: =(p.p.q.hic q.p.q.hic)
=+ une=(un p.p.q.hic now ruf)
=+ wex=(di:une p.q.q.hic)
=+ ^= woo
?~ q.q.q.hic
abet:(ease:wex hen)
abet:(eave:wex hen u.q.q.q.hic)
[-.woo abet:(pish:une p.q.q.hic +.woo)]
=+ wex=(do now p.q.hic p.q.q.hic ruf)
=+ ^= woo
?~ q.q.q.hic
abet:(ease:wex hen)
abet:(eave:wex hen u.q.q.q.hic)
[-.woo (posh q.p.q.hic p.q.q.hic +.woo ruf)]
[mos ..^$]
::
%wart
?> ?=(%re q.q.hic)
=+ ryf=((hard riff) s.q.hic)
:_ ..^$
:~ :- hen
:^ %pass [(scot %p p.p.q.hic) (scot %p q.p.q.hic) r.q.hic]
%c
[%warp [p.p.q.hic p.p.q.hic] ryf]
==
::
%wake
=+ dal=(turn (~(tap by fat.ruf) ~) |=([a=@p b=room] a))
=| mos=(list move)
|- ^- [p=(list move) q=_..^^$]
?~ dal [mos ..^^$]
=+ une=(un i.dal now ruf)
=^ som une wake:une
$(dal t.dal, ruf abet:une, mos (weld som mos))
==
::
++ doze
|= [now=@da hen=duct]
^- (unit ,@da)
%+ roll (~(tap by fat.ruf) ~)
|= [[dal=@p *] nex=(unit ,@da)]
%+ hunt nex
doze:(un dal now ruf)
::
++ load
|= old=[%0 ruf=raft]
^+ ..^$
..^$(ruf ruf.old)
::
++ scry :: inspect
|= [fur=(unit (set monk)) ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit (pair mark ,*)))
=+ got=(~(has by fat.ruf) his)
=+ luk=?.(?=(%$ -.lot) ~ ((soft case) p.lot))
?~ luk [~ ~]
=+ une=(un his now ruf)
?: =(%$ ren)
[~ ~]
=+ run=((soft care) ren)
?~ run [~ ~]
%+ bind
%. [u.run u.luk tyl]
aver:?.(got (do now [his his] syd ruf) (di:une syd))
|=(a=(unit) (bind a |=(b=* [%noun b])))
::
++ stay [%0 ruf]
++ take :: accept response
|= [tea=wire hen=duct hin=(hypo sign)]
^- [p=(list move) q=_..^$]
?- -.+.q.hin
%crud
[[[hen %slip %d %flog +.q.hin] ~] ..^$]
::
%waft
?> ?=([@ @ ~] tea)
=+ syd=(need (slaw %tas i.tea))
=+ inx=(need (slaw %ud i.t.tea))
=^ mos ruf
=< abet
=< abet
=< wake
%. [inx ((hard riot) q.fav)]
knit:(do:(un p.p.fav now ruf) q.p.fav syd)
=+ ^= zot
=< abet =< wake
(knit:(do now p.+.q.hin syd ruf) [inx ((hard riot) q.+.q.hin)])
[-.zot (posh q.p.+.q.hin syd +.zot ruf)]
[mos ..^$]
::
%warp
=^ mos ruf
=< abet
=+ une=(un p.p.fav now ruf)
=+ wex=?.(=(p.p.fav q.p.fav) (do:une q.p.fav p.q.fav) (di:une p.q.fav))
?~ q.q.fav
abet:(ease:wex hen)
abet:(eave:wex hen u.q.q.fav)
[mos ..^$]
::
%wart
?> ?=(%re q.fav)
=+ ryf=((hard riff) s.fav)
:_ ..^$
:~ :- [/c [%c (scot %p p.p.fav) (scot %p q.p.fav) r.fav] hen]
`card`[%warp [p.p.fav p.p.fav] ryf]
==
::
%writ
?> ?=([@ @ *] tea)
=+ our=(need (slaw %p i.tea))
=+ him=(need (slaw %p i.t.tea))
:_ ..^$
:~ :- [/a [%c ~] hen]
`card`[%want [our him] [%r %re %c t.t.tea] p.fav]
:~ :- hen
[%pass ~ %a [%want [our him] [%r %re %c t.t.tea] p.+.q.hin]]
==
::
%went :: XX should actually propagate
?: =(%good q.fav) [~ ..^$]
~& [%clay-lost p.fav tea]
%went
?: =(%good q.+.q.hin) [~ ..^$]
~& [%clay-lost p.+.q.hin tea]
[~ ..^$]
::
%wake
=+ dal=(turn (~(tap by fat.ruf) ~) |=([a=@p b=room] a))
=| mos=(list move)
|- ^- [p=(list move) q=vane]
?~ dal [mos ..^^$(las.ruf now)]
=^ som ruf abet:wake:(un i.dal now ruf)
$(dal t.dal, mos (weld som mos))
==
::
++ call :: process move
|= [hen=duct fav=card]
(beat ~ hen fav)
::
++ come
|= [sam=? old=vase]
^- vane
(load old)
::
++ doze
|= [now=@da hen=duct]
=| nex=(unit ,@da)
=+ dal=(turn (~(tap by fat.ruf) ~) |=([a=@p b=room] a))
|- ^+ nex
?~ dal nex
$(dal t.dal, nex (hunt nex doze:(un i.dal now ruf)))
::
++ load
|= old=vase
^- vane
?. (~(nest ut -:!>(ruf)) & p.old)
~& %clay-reset
..^$
..^$(ruf (raft q.old))
::
++ raze
^- vane
..$(ruf *raft)
::
++ scry :: inspect
|= [our=ship ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit))
=+ ^= whu ^- (unit ,@p) :: XX HEINOUS!
?: (~(has by fat.ruf) his)
`his
=+ foo=`(list ,[p=ship q=room])`(~(tap by fat.ruf) ~)
|- ^- (unit ,@p)
?~ foo ~
?: (~(has by rid.q.i.foo) his) `p.i.foo
$(foo t.foo)
?~ whu ~
=. our u.whu
:: ~? !=(`our whu) [%clay-scry whu our ren his syd lot tyl]
=+ luk=?.(?=(%$ -.lot) ~ ((soft case) p.lot))
?~ luk [~ ~]
=+ une=(un our now ruf)
?: =(%$ ren)
[~ (zeta:une his syd u.luk tyl)]
=+ run=((soft care) ren)
?~ run [~ ~]
%. [u.run u.luk tyl]
=+ dud=?.(=(our his) (do:une his syd) (di:une syd))
:: ~& [%scry-at [our his] now lim.dud]
aver:dud
::
++ stay `vase`!>(ruf)
++ vern [164 0]
--

397
arvo/dill.hoon
View File

@ -2,36 +2,135 @@
:: dill (4d), terminal handling
::
|= pit=vase
^- vane :: kernel instrument
=| $: dug=(map duct yard)
== ::
|= [now=@da eny=@ ska=$+(* (unit (unit)))] :: current invocation
^? :: opaque core
|% :: poke/peek pattern
++ beat :: process move
|= [tea=wire hen=duct fav=card]
^- [p=(list move) q=vane]
?: ?=(%flog -.fav)
:_ ..^$
%+ turn (~(tap by dug) *(list ,[p=duct q=yard]))
|=([a=duct b=yard] [[/d a] p.fav])
=> |% :: interface tiles
++ gift :: out result <-$
$% [%bbye ~] :: reset prompt
[%blit p=(list blit)] :: terminal output
[%init p=@p] :: report install
[%logo p=@] :: logout
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: by %batz
==
++ kiss :: in request ->$
$% [%belt p=belt] :: terminal input
[%blew p=blew] :: terminal config
[%boot p=*] :: weird %dill boot
[%crud p=@tas q=(list tank)] :: error with trace
[%flog p=flog] :: wrapped error
[%hail ~] :: terminal refresh
[%hook ~] :: this term hung up
[%harm ~] :: all terms hung up
[%noop ~] :: no operation
[%talk p=tank] ::
[%text p=tape] ::
== ::
++ flog :: sent to %dill
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
== ::
++ move ,[p=duct q=(mold note gift)] :: local move
++ note :: out request $->
$% $: %b :: to %batz
$% [%hail ~] ::
[%harm ~] ::
[%hook ~] ::
[%kill p=~] ::
[%line p=@t] ::
[%ling ~] ::
[%make p=(unit ,@t) q=@ud r=@ s=?] ::
[%sith p=@p q=@uw r=?] ::
== == ::
$: %d :: to %dill
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
== == == ::
++ sign :: in result $<-
$? $: %b :: by %batz
$% [%hail ~] ::
[%helo p=path q=prod] ::
[%logo p=@] ::
[%save p=path q=@] ::
[%sage p=path q=*] ::
[%talk p=tank] ::
[%tell p=(list ,@t)] ::
[%text p=tape] ::
[%verb ~] ::
[%veer p=@ta q=path r=@t] ::
[%vega p=path] ::
[%warn p=tape] ::
== == ::
$: @tas :: by any
$% [%crud p=@tas q=(list tank)] ::
[%init p=@p] ::
[%note p=@tD q=tank] ::
== == == ::
:::::::: :: dill tiles
++ bein :: terminal control
$: $: bul=@ud :: buffer length
bus=@ud :: cursor in buffer
but=(list ,@c) :: buffer text
buy=prom :: input style
== ::
$: hiz=@ud :: history depth
hux=path :: history path
hym=(map ,@ud (list ,@c)) :: history overlay
hyt=hist :: history object
hyr=(unit (list ,@c)) :: history search
== ::
$: pol=@ud :: length of prompt
pot=tape :: prompt text
== ::
== ::
++ blew ,[p=@ud q=@ud] :: columns rows
++ belt :: raw console input
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%ctl p=@ud] :: control-key
[%del ~] :: true delete
[%met p=@ud] :: meta-key
[%ret ~] :: return
[%txt p=(list ,@c)] :: utf32 text
== ::
++ blit :: raw console output
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%lin p=(list ,@c)] :: set current line
[%mor ~] :: newline
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
== ::
++ blot :: kill ring
$: p=@ud :: length
q=@ud :: depth
r=(list (list ,@c)) :: kills
== ::
++ blur ,[p=@ud q=(unit bein) r=blot] :: columns, prompt
++ yard :: terminal state
$: p=? :: verbose
q=blur :: display state
r=(map path hist) :: history
== ::
-- =>
|%
++ dy
|= [hen=duct dug=(map duct yard)]
=+ ^= yar ^- yard
=+ yar=(~(get by dug) hen)
?^ yar u.yar
[& [80 ~ *blot] ~]
=+ yur=(~(get by dug) hen)
?^ yur u.yur
[& [80 ~ *blot] ~]
=| mos=(list move)
=+ wip=|
=< yerk:leap
|%
++ beep (curb [[%bel ~] ~]) :: send beep
++ curb :: send blits
|= wab=(list blit)
^+ +>
?~ wab +>
+>(mos [[hen [%blit (flop wab)]] mos])
+>(mos [[hen [%give %blit (flop wab)]] mos])
::
++ wod :: word forward
|= bed=bead
|= bed=bein
^- @ud
?: =(bul.bed bus.bed)
bus.bed
@ -46,7 +145,7 @@
$(bus.bed +(bus.bed))
::
++ wob :: word backward
|= bed=bead
|= bed=bein
^- @ud
?: =(0 bus.bed)
bus.bed
@ -61,7 +160,7 @@
$(bus.bed (dec bus.bed))
::
++ edit :: change the bed
|= bed=bead
|= bed=bein
^+ +>
=. q.q.yar [~ bed]
?> ?=(^ q.q.yar)
@ -158,15 +257,76 @@
(gore(hyr.u.q.q.yar [~ txt]) hup)
$(hup +(hup))
::
++ leap :: terminal event
|- ^+ +
?+ -.fav +(mos :_(mos [hen fav]))
%noop +
++ leap :: accept response
|= [tea=wire sih=sign]
^+ +>
?- -.+.sih
%crud :: error trace
=. q.+.sih [[%leaf (trip p.+.sih)] q.+.sih]
|- ^+ +>.^$
?~ q.+.sih +>.^$
(fume:$(q.+.sih t.q.+.sih) '!' `tank`i.q.+.sih)
::
%helo :: trigger prompt
%- edit
=| bed=bein
=+ ^= hyt ^- hist
=+ hyt=(~(get by r.yar) p.+.sih)
?~(hyt *hist u.hyt)
?: &(?=(^ q.q.yar) =(p.+.sih hux.u.q.q.yar))
%= u.q.q.yar
hyt [+(p.hyt) [%$ q.hyt]]
pot q.q.+.sih
pol (lent q.q.+.sih)
buy p.q.+.sih
==
=+ zon=(tuba r.q.+.sih)
=+ zow=(lent zon)
%= bed
bul zow
bus zow
but zon
buy p.q.+.sih
hux p.+.sih
hiz 0
hyt [+(p.hyt) [%$ q.hyt]]
pot q.q.+.sih
pol (lent q.q.+.sih)
==
::
?(%hail %make %sith)
+>.$(mos :_(mos [hen %pass ~ %b +.sih]))
::
%note ?.(p.yar +>.$ (fume p.+.sih q.+.sih)) :: debug message
%sage :: write a jamfile
%= +>.$
mos :_(mos [hen [%give %blit [%sag p.+.sih q.+.sih] ~]])
==
::
%save :: write a file
%= +>.$
mos :_(mos [hen [%give %blit [%sav p.+.sih q.+.sih] ~]])
==
::
%tell (furl (turn p.+.sih |=(a=@t (trip a)))) :: wall of text
%talk (furl (~(win re p.+.sih) 0 p.q.yar)) :: program output
%text $(+.sih [%talk %leaf p.+.sih]) :: simple message
%warn (fume '~' [%leaf p.+.sih]) :: system message
?(%init %logo %veer %vega %verb) :: drop-throughs
+>(mos :_(mos [hen %give +.sih]))
==
::
++ lear :: handle request
|= kyz=kiss
^+ +>
?- -.kyz
%flog !!
%noop +>
%belt :: terminal input
?~ q.q.yar
beep
?^ hyr.u.q.q.yar :: live search
?+ p.fav $(hiz.u.q.q.yar 0, hyr.u.q.q.yar ~)
?+ p.kyz $(hiz.u.q.q.yar 0, hyr.u.q.q.yar ~)
[%bac *]
?: =(~ u.hyr.u.q.q.yar)
(curb [[%bel ~] ~])
@ -175,16 +335,16 @@
hyr [~ (scag (dec (lent u.hyr.u.q.q.yar)) u.hyr.u.q.q.yar)]
==
::
[%txt *] (look hiz.u.q.q.yar (weld u.hyr.u.q.q.yar p.p.fav))
[%txt *] (look hiz.u.q.q.yar (weld u.hyr.u.q.q.yar p.p.kyz))
[%ctl %g] (edit u.q.q.yar(bul 0, bus 0, but ~, hiz 0, hyr ~))
[%ctl %r]
?: =(p.hyt.u.q.q.yar hiz.u.q.q.yar)
beep
(look +(hiz.u.q.q.yar) u.hyr.u.q.q.yar)
==
?- -.p.fav
?- -.p.kyz
%aro :: arrow
?- p.p.fav
?- p.p.kyz
%d :: down
?: =(0 hiz.u.q.q.yar)
beep
@ -208,7 +368,7 @@
==
::
%bac :: backspace
^+ +.$
^+ +>.$
?: =(0 bus.u.q.q.yar)
(curb `(list blit)`[[%bel ~] ~])
%- edit
@ -222,20 +382,20 @@
==
::
%ctl :: control
?+ p.p.fav
?+ p.p.kyz
beep
%a (edit u.q.q.yar(bus 0))
%b $(fav [%belt %aro %l])
%b $(kyz [%belt %aro %l])
%d ?: ?& =(0 bul.u.q.q.yar)
=(0 bus.u.q.q.yar)
==
+.$(mos :_(mos [[/b /d hen] [%kill ~]]))
$(fav [%belt %del ~])
+>.$(mos :_(mos [hen %pass ~ %b [%kill ~]]))
$(kyz [%belt %del ~])
%e (edit u.q.q.yar(bus bul.u.q.q.yar))
%f $(fav [%belt %aro %r])
%f $(kyz [%belt %aro %r])
%k ?: =(bul.u.q.q.yar bus.u.q.q.yar)
beep
=> .(+.$ (kill (slag bus.u.q.q.yar but.u.q.q.yar)))
=> .(+>.$ (kill (slag bus.u.q.q.yar but.u.q.q.yar)))
%- edit
?> ?=(^ q.q.yar)
%= u.q.q.yar
@ -262,12 +422,12 @@
~
(slag (add 2 pos) but.u.q.q.yar)
==
%l +.$(mos :_(mos [hen %blit [[%clr ~] ~]]))
%n $(fav [%belt %aro %d])
%p $(fav [%belt %aro %u])
%l +>.$(mos :_(mos [hen %give %blit [[%clr ~] ~]]))
%n $(kyz [%belt %aro %d])
%p $(kyz [%belt %aro %u])
%u ?: =(0 bus.u.q.q.yar)
beep
=> .(+.$ (kill (scag bus.u.q.q.yar but.u.q.q.yar)))
=> .(+>.$ (kill (scag bus.u.q.q.yar but.u.q.q.yar)))
%- edit
?> ?=(^ q.q.yar)
%= u.q.q.yar
@ -277,11 +437,11 @@
==
%r (edit u.q.q.yar(hyr [~ ~]))
:: TODO
:: %w +.$(mos :_(mos [[/b /d hen] [%limn ~]]))
%x +.$(mos :_(mos [[/b /d hen] [%ling ~]]))
:: %w +>.$(mos :_(mos [hen %pass ~ %b [%limn ~]]))
%x +>.$(mos :_(mos [hen %pass ~ %b [%ling ~]]))
%y ?: =(0 p.r.q.yar)
beep
$(fav [%belt %txt (snag q.r.q.yar r.r.q.yar)])
$(kyz [%belt %txt (snag q.r.q.yar r.r.q.yar)])
==
::
%del :: delete
@ -297,7 +457,7 @@
==
::
%met :: meta
?+ p.p.fav
?+ p.p.kyz
beep
%f
?: =(bul.u.q.q.yar bus.u.q.q.yar)
@ -337,7 +497,7 @@
%ret :: return
?: =(%none buy.u.q.q.yar) beep
=+ jab=(rap 3 (tufa but.u.q.q.yar))
%= +.$
%= +>.$
q.q.yar ~
r.yar
?: |(=(%$ jab) =(%pass buy.u.q.q.yar))
@ -347,17 +507,17 @@
[p.hyt.u.q.q.yar [jab ?~(q.hyt.u.q.q.yar ~ +.q.hyt.u.q.q.yar)]]
::
mos
:* [[/b /d hen] [%hail ~]]
[hen [%bbye ~]]
[[/b /d hen] [%line jab]]
[hen [%blit [[%mor ~] ~]]]
:* [hen %pass ~ %b [%hail ~]]
[hen %give [%bbye ~]]
[hen %pass ~ %b [%line jab]]
[hen %give [%blit [[%mor ~] ~]]]
mos
==
==
::
%txt :: text keys
?: =(%none buy.u.q.q.yar) beep
=+ let=(lent p.p.fav)
=+ let=(lent p.p.kyz)
%- edit
%= u.q.q.yar
bus (add let bus.u.q.q.yar)
@ -365,82 +525,75 @@
but
;: weld
(scag bus.u.q.q.yar but.u.q.q.yar)
p.p.fav
p.p.kyz
(slag bus.u.q.q.yar but.u.q.q.yar)
==
==
==
::
%blew +.$(p.q.yar p.p.fav) :: window size
%blew +>.$(p.q.yar p.p.kyz) :: window size
%boot
%= +.$
%= +>.$
mos
:_(mos [[[%b ~] [%d tea] hen] p.fav])
:_(mos [hen %pass ~ (note %b p.kyz)])
==
::
%crud :: error trace
=. q.fav [[%leaf (trip p.fav)] q.fav]
|- ^+ +.^$
?~ q.fav +.^$
(fume:$(q.fav t.q.fav) '!' i.q.fav)
=. q.kyz [[%leaf (trip p.kyz)] q.kyz]
|- ^+ +>.^$
?~ q.kyz +>.^$
(fume:$(q.kyz t.q.kyz) '!' `tank`i.q.kyz)
::
%helo :: trigger prompt
%- edit
=| bed=bead
=+ ^= hyt ^- hist
=+ hyt=(~(get by r.yar) p.fav)
?~(hyt *hist u.hyt)
?: &(?=(^ q.q.yar) =(p.fav hux.u.q.q.yar))
%= u.q.q.yar
hyt [+(p.hyt) [%$ q.hyt]]
pot q.q.fav
pol (lent q.q.fav)
buy p.q.fav
==
=+ zon=(tuba r.q.fav)
=+ zow=(lent zon)
%= bed
bul zow
bus zow
but zon
buy p.q.fav
hux p.fav
hiz 0
hyt [+(p.hyt) [%$ q.hyt]]
pot q.q.fav
pol (lent q.q.fav)
%hail :: refresh
+>.$(mos :_(mos [hen %pass ~ %b kyz]))
::
%harm :: all terms hung up
=+ nug=((map duct yard) [[hen (~(get by dug) hen)] ~ ~])
^+ +>.$
%= +>.$
dug nug
mos :_(mos [hen %pass ~ %b kyz])
==
::
?(%hail %make %loin %sith)
+.$(mos :_(mos [[/b /d hen] fav]))
%hook :: this term hung up
+>.$(dug (~(del by dug) hen), mos :_(mos [hen %pass ~ %b kyz]))
::
%note ?.(p.yar +.$ (fume p.fav q.fav)) :: debug message
%save :: write a file
%= +.$
mos :_(mos [hen `card`[%blit [%sav p.fav q.fav] ~]])
==
::
%tell (furl (turn p.fav |=(a=@t (trip a)))) :: wall of text
%text $(fav [%talk %leaf p.fav]) :: simple message
%talk (furl (~(win re p.fav) 0 p.q.yar)) :: program output
%warn (fume '~' [%leaf p.fav]) :: system message
%wipe +.$(wip &) :: delete old
%talk (furl (~(win re p.kyz) 0 p.q.yar)) :: program output
%text $(kyz [%talk %leaf p.kyz]) :: simple message
==
::
++ yerk :: complete core
^- [p=(list move) q=_..^$]
^- [p=(list move) q=(map duct yard)]
:- (flop mos)
..^$(dug ?.(wip (~(put by dug) hen yar) (~(del by dug) hen)))
(~(put by dug) hen yar)
--
::
++ call :: process move
|= [hen=duct fav=card]
(beat ~ hen fav)
::
++ come
|= [sam=? old=vase]
^- vane
(load old)
--
=| $: %0 ::
dug=(map duct yard) ::
== ::
|= [now=@da eny=@ ski=sled] :: current invocation
|% :: poke/peek pattern
++ call :: handle request
|= $: hen=duct
hic=(hypo (hobo kiss))
==
^- [p=(list move) q=_..^$]
=> %= . :: XX temporary
q.hic
^- kiss
?: ?=(%soft -.q.hic)
:: ~& [%dill-call-soft (,@tas `*`-.p.q.hic)]
((hard kiss) p.q.hic)
?: (~(nest ut -:!>(*kiss)) | p.hic) q.hic
~& [%dill-call-flub (,@tas `*`-.q.hic)]
((hard kiss) q.hic)
==
?: ?=(%flog -.q.hic)
:_ ..^$
%+ turn (~(tap by dug) *(list ,[p=duct q=yard]))
|=([a=duct b=yard] [a %slip %d p.q.hic])
=^ moz dug yerk:(lear:(dy hen dug) q.hic)
[moz ..^$]
::
++ doze
|= [now=@da hen=duct]
@ -448,23 +601,19 @@
~
::
++ load
|= new=vase
^- vane
?. (~(nest ut -:!>(dug)) & p.new)
~|(%load-type-fail !!)
%_ ..^$
dug ((map duct yard) q.new)
==
::
++ raze
^- vane
..$(dug ~)
|= old=[%0 dug=(map duct yard)]
^+ ..^$
..^$(dug dug.old)
::
++ scry
|= [our=ship ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit))
~
|= [fur=(unit (set monk)) ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit (pair mark ,*)))
[~ ~ [%tank >dug<]]
::
++ stay `vase`!>(dug)
++ vern [164 0]
++ stay [%0 dug]
++ take :: process move
|= [tea=wire hen=duct hin=(hypo sign)]
^- [p=(list move) q=_..^$]
=^ moz dug yerk:(leap:(dy hen dug) tea q.hin)
[moz ..^$]
--

1699
arvo/eyre.hoon
View File

File diff suppressed because it is too large Load Diff

950
arvo/ford.hoon
View File

File diff suppressed because it is too large Load Diff

1339
arvo/gall.hoon
View File

File diff suppressed because it is too large Load Diff

2017
arvo/hoon.hoon
View File

File diff suppressed because it is too large Load Diff

1496
arvo/zuse.hoon
View File

File diff suppressed because it is too large Load Diff

38
main/app/appbug-2/core.hoon Normal file
View File

@ -0,0 +1,38 @@
!:
::::::::: Appbug: a simple application.
::
|_ [hid=hide vat=[%0 p=@ud]]
++ poke
|= [ost=bone *]
:_ +>(p.vat +(p.vat))
:~ [ost %give %nice ~]
==
::
++ peek
|= [you=ship pax=path]
:- %hymn
^- manx
;html
;head
;title: Appbug!
;script: appl = '{(trip app.hid)}'
==
;body
;p: Dude, a better answer is {<p.vat>}.
;button(onclick "bump()"): (Bump.)
;script
; var mess = 0;
;
; function bump() {
; xhr = new XMLHttpRequest();
; xhr.onload = function() { mess++; }
; xhr.open("PUT", "/tim/" + [user, port, mess].join("/"));
; xhr.setRequestHeader("content-type", "text/json");
; xhr.send(JSON.stringify({oryx: oryx, xyro: {ship: ship, appl: appl, data: {}}}));
; }
==
==
==
--

103
main/app/foobug/core.hoon Normal file
View File

@ -0,0 +1,103 @@
!:
=> |%
++ axle
$% [%0 p=@ud]
==
++ gult
$% [%json p=json]
:: [%hymn p=manx]
==
++ gilt
$% :: [%json p=json]
[%hymn p=manx]
==
++ gift
$% [%rust gilt]
[%nice gult]
==
++ move ,[p=bone q=[%give p=gift]]
--
|_ [hid=hide vat=axle]
++ page
^- manx
;html
;head
;title: Foobug!
==
;body
;p: Word: {<p.vat>}.
;button(onclick "goof()"): Goof!
;script:'''
var c = 0;
var d = 1;
var x = 0;
function pickup() {
xhr = new XMLHttpRequest();
console.log("WTF???");
xhr.open("GET", "/zod/goe/foobug/"+port+"/frog/"+d);
xhr.onload = function() {
console.log("pickup");
console.log(this)
change(JSON.parse(this.responseText))
update();
d++;
pickup();
}
xhr.send();
}
function dude() {
xhr = new XMLHttpRequest();
xhr.open("POST", "/zod/pos/foobug/"+port+"/frog/goof");
xhr.setRequestHeader("content-type", "text/json")
xhr.onload = function() {
console.log("dude");
console.log(this)
change(JSON.parse(this.responseText))
update();
pickup();
}
xhr.send("{\"a\":1}")
}
dude();
function change(jon) {
x = jon.x;
}
function update() {
document.getElementsByTagName("p")[0].innerHTML = "WORD: " + x;
}
function goof() {
xhr = new XMLHttpRequest();
xhr.onload = function() {
console.log("hi");
console.log(arguments)
c++
}
xhr.open("POST",
"/zod/pom/foobug/"+port+"/"+c)
xhr.setRequestHeader("content-type", "text/json")
xhr.send("{\"a\":1}")
}
'''
==
==
::
++ peer
|= [ost=bone you=ship pax=path]
^- [(list move) _+>]
[[ost %give %rust %hymn page]~ +>]
::
++ poke-json
|= [ost=bone you=ship jon=json]
^- [(list move) _+>]
~& [%poke [%state p.vat] ost you jon]
:_ +>(p.vat +(p.vat))
:~ [ost %give %nice %json jon]
==
--

45
main/app/philbug/app.js Normal file
View File

@ -0,0 +1,45 @@
window.onload = function() {
var data = {}
change = function(_data) {
for(i in _data) {
data[i] = _data[i]
}
}
update = function() {
for (var i in data) {
if ($('#'+i).length < 1) {
var e = document.createElement('tr')
e.id = i
$('#cont tbody').append(e)
}
$('#'+i).html("<td>~"+i+"</td><td>"+data[i]+"</td>")
}
$('#cont tbody').append([].sort.call($('#cont tr'), function (a, b) {
return parseInt(b.childNodes[1].innerText) -
parseInt(a.childNodes[1].innerText)
}))
}
goof = function(e) {
d = $.map($(".sel"), function(el) {return el.id})
window.urb.send(d)
}
window.urb.send(null);
/*window.urb.subscribe("frog","goof",*/ function(err,res) {
if(err)
return console.log('cannot connect to frog/goof')
change(res.data)
update()
return true
})
$('#cont').on('click', 'tr', function (e) {
if (!e.ctrlKey) { $('.sel').removeClass('sel') }
$(this).addClass('sel')
})
}

116
main/app/philbug/core.hoon Normal file
View File

@ -0,0 +1,116 @@
!:
=> |%
++ axle
$% [%0 p=(map ,@p ,@ud)]
==
++ gilt
$% [%json p=json]
[%hymn p=manx]
==
++ gift
$% [%rust gilt]
[%nice gilt]
==
++ move ,[p=bone q=[%give p=gift]]
++ phil
$% [%new ~]
[%add p=(list ,@p)]
==
--
|_ [hid=hide vat=axle]
++ incl
|= wal=wall
%+ turn wal
|= tape ;script(type "text/javascript", src +<);
::
++ root
/(scot %p our.hid)/main/(scot %da lat.hid)/app/[app.hid]
::
++ respond :: respond to message
|= ost=bone
`move`[ost %give %nice %json *json]
::
++ update :: update subscribers
^- (list move)
%+ turn
^- (list bone)
%+ ~(rep by sup.hid) *(list bone)
|= [p=[p=bone q=[ship path]] q=(list bone)] ^- (list bone)
?. =(/goof +.q.p) q
[p.p q]
send-vat
::
++ render
^- manx
;html
;head
;title: Foobug!
;style
; .sel {background: lightgray}
; #cont {border-collapse: collapse}
==
;* %- incl :~
"//cdnjs.cloudflare.com/ajax/libs/jquery/2.1.1/jquery.min.js"
==
;script ;- (trip ;;(,@ .^(%cx (welp root /urb/js))))
==
;script ;- (trip ;;(,@ .^(%cx (welp root /app/js))))
==
==
;body
;p: Yo.
;table#cont:tbody;
;p: Select a ship
;button(onclick "goof()"): Give 5 points
==
==
::
++ peer
|= [ost=bone you=ship pax=path]
^- [(list move) _+>]
:_ +>
?: =(/ pax)
[ost %give %rust %hymn render]~
[(send-vat ost) ~]
::
++ poke-phil
|= [ost=bone you=ship pil=phil]
=. p.vat
?- -.pil
%new (~(put by p.vat) you (fall (~(get by p.vat) you) _@ud))
%add %- ~(urn by p.vat)
|= [u=@p n=@ud]
?. (lien p.pil |=(a=@p =(a u)))
n
(add 5 n)
==
[[(respond ost) update] +>.$]
::
++ poke-json
|= [ost=bone you=ship jon=json]
~& [%poke-json jon]
%^ poke-phil ost you
^- phil
?+ -.jon !!
%o [%new ~]
%a :- %add
%+ turn p.jon
|= a=json
?> ?=([%s *] a)
(slav %p (cat 3 '~' p.a))
==
::
++ send-vat
|= ost=bone
=+ luz=(~(tap by p.vat) ~)
^- move
:* ost %give %rust %json %o
^- (map ,@t jval)
%- mo
%+ turn luz
|= [a=@p b=@ud]
:- (rsh 3 1 (scot %p a))
:- %n
(rsh 3 2 (scot %ui b))
==
--

111
main/app/philbug/urb.js Normal file
View File

@ -0,0 +1,111 @@
window.urb = {
ship: ship,
port: port,
auto: auto,
oryx: oryx,
user: user,
appn: appn,
seqn: 0,
seqp: 1,
dely: 0,
req: function(method,url,data,json,cb) {
var xhr = new XMLHttpRequest()
xhr.open(method.toUpperCase(), url)
if(json)
xhr.setRequestHeader("content-type", "text/json")
if(data)
xhr.send(JSON.stringify(data))
else
xhr.send()
if(cb) {
xhr.onload = function() {
cb(null,{
"status":this.status,
"data":JSON.parse(this.responseText)
})
}
xhr.onerror = function() {
cb({
"status":this.status,
"data":this.responseText
})
}
}
},
subscribe: function(stream,path,cb) {
if(!cb)
throw new Error("You must supply a callback to urb.subscribe.")
var method, perm, url, $this
method = "post"
perm = "pis"
url = [this.ship,perm,this.user,this.appn,this.port]
if(stream) {
url.push(stream)
if(path)
url.push(path)
}
url = "/"+url.join("/")
$this = this
this.req(method,url,{},true,function(err,data) {
cb.apply(this,arguments)
if(!err) { $this.poll(stream,cb); }
})
},
send: function(data,cb) {
if(!data) { data = {}; }
if(!cb) { cb = function() {}; }
var method, perm, url, $this
method = "post"
perm = "pim"
url = [this.ship,perm,this.user,this.appn,this.port,this.seqn]
url = "/"+url.join("/")
this.seqn++
$this = this
this.req(method,url,data,true,function(err,data) {
if(err) { $this.seqn--; }
cb.apply(this,arguments)
})
},
poll: function(stream,cb) {
if(!stream)
throw new Error("You must supply a stream to urb.poll.")
if(!cb)
throw new Error("You must supply a callback to urb.poll.")
var method, perm, url, $this
method = "get"
perm = "gie"
if(!stream) { return false; }
url = [this.ship,perm,this.user,this.appn,this.port,stream,this.seqp]
url = "/"+url.join("/")
$this = this
this.req(method,url,null,false,function(err,data) {
if(cb.apply(this,arguments) === false) { return; }
if(err)
$this.dely += 1000
else {
$this.dely = 0
$this.seqp++
}
setTimeout(function() {
$this.poll(stream,cb)
},$this.dely)
})
}
}

139
main/app/radio/core.hoon Normal file
View File

@ -0,0 +1,139 @@
!:
=> |%
++ axle
$% [%0 p=(map path ,[p=(list zong) q=(map ship feel)])]
==
++ blitz
$% [%zong p=zong]
[%user p=user]
==
++ feel ,[liv=? tim=@da]
++ idad ,[p=@p q=@t]
++ iron
$% [%zongs p=(list zong)]
[%users p=(list idad)]
==
++ gift
$% [%rush blitz]
[%rust iron]
[%nice ~]
==
++ mess :: message
$% [%do p=@t] :: act
[%exp p=@t q=tank] :: code
[%say p=@t] :: speak
==
++ move ,[p=bone q=(mold note gift)]
++ note ,~
++ user
$% [%in p=idad]
[%out p=idad]
==
++ zing
$% [%backlog p=path q=?(%da %dr %ud) r=@]
[%hola p=path]
[%mess p=path q=mess]
==
++ zong
$% [%mess p=@da q=ship r=mess]
==
--
|_ [hid=hide vat=axle]
++ grab
|= sta=path
(fall (~(get by p.vat) sta) *[p=(list zong) q=(map ship feel)])
::
++ ident
|= you=ship
((hard ,@t) .^(%a (scot %p our.hid) %name (scot %da lat.hid) (scot %p you) ~))
::
++ since
|= [ya=p=(list zong) tim=@da]
%- flop
|- ^- (list zong)
?: |(?=(~ p.ya) (lth p.i.p.ya tim)) ~
[i.p.ya $(p.ya t.p.ya)]
::
++ peer
|= [ost=bone you=ship pax=path]
^- [(list move) _+>]
:_ +>.$
=+ sta=*path
|- ^- (list move)
?: ?=(~ pax)
~
?. ?=(~ +.pax)
$(sta `path`[-.pax sta], pax `path`+.pax)
=. sta (flop sta)
=+ ya=(grab sta)
?+ -.pax ~
%mensajes
:_ ~
[ost %give %rust %zongs (since p.ya tim:(fall (~(get by q.ya) you) *feel))]
%amigos
:_ ~
:* ost %give %rust %users
%+ turn
%+ skim (~(tap by q.ya))
|= [ship [p=? @da]] p
|= [p=ship [? @da]] [p (ident p)]
==
==
::
++ poke-zing
|= [ost=bone you=ship zig=zing]
^- [(list move) _+>]
?- -.zig
%backlog
=+ ya=(grab p.zig)
:_ +>.$
:- [ost %give %nice ~]
%^ yend you (welp p.zig /mensajes)
:* %give %rust %zongs
?: ?=(%ud q.zig)
%- flop
%+ scag r.zig
p.ya
=+ ^= tim ?-(q.zig %da r.zig, %dr (sub lat.hid r.zig))
(since p.ya tim)
==
%hola
=+ ya=(grab p.zig)
=^ outs q.ya
%+ ~(rib by q.ya) *(list move)
|= [p=[p=ship q=feel] q=(list move)]
=+ liv=(gth ~m3 (sub lat.hid tim.q.p))
:_ [p.p liv tim.q.p]
?: |(liv !liv.q.p) q
%- welp :_ q
(send (welp p.zig /amigos) %give %rush %user %out p.p (ident p.p))
=. p.vat (~(put by p.vat) p.zig [p.ya (~(put by q.ya) you [& lat.hid])])
:_ +>.$
:- [ost %give %nice ~]
=+ yel=(~(get by q.ya) you)
?. |(?=(~ yel) !liv.u.yel) outs
%+ welp outs
(send (welp p.zig /amigos) %give %rush %user %in you (ident you))
%mess
=+ zog=`zong`[%mess lat.hid you q.zig]
=+ ya=(grab p.zig)
=. p.vat (~(put by p.vat) p.zig [[zog p.ya] q.ya])
:_ +>.$
:- [ost %give %nice ~]
(send (welp p.zig /mensajes) %give %rush %zong zog)
==
::
++ send
|= [pax=path msg=(mold note gift)]
^- (list move)
%+ turn (~(tap in (~(get ju pus.hid) pax)))
|=(ost=bone [ost msg])
++ yend
|= [you=ship sta=path msg=(mold note gift)]
^- (list move)
%+ turn
%+ skim (~(tap in (~(get ju pus.hid) sta)))
|= b=bone =(you p:(fall (~(get by sup.hid) b) *(pair ship path)))
|= b=bone
:- b msg
--

10
main/bin/begin.hoon
View File

@ -4,7 +4,7 @@
=> .(-< `who=@p`-<)
=> .(+ =>(+ ^/===/lib/pony))
|= [est=time *]
|= arg=$|(~ [p=@p ~])
|= arg=$|(~ [p=@p q=$|(~ [p=@p ~])])
=- ^- bowl
?^ arg (fud p.arg)
%+ pomp ""
@ -65,8 +65,10 @@
%+ pomp ""
%+ pomp " -- Bunting, _Chomei at Toyama_"
%+ pogo (pond ^:@/===doc%/warning/txt)
%+ (polo %text "Your ticket: ~" ~ ~)
fed:ag
=- ?: ?=([@ @ ~] arg)
(- ~ p.q.arg)
%+ (polo %text "Your ticket: ~" ~ ~)
fed:ag -
|= [* tic=@p]
%+ pogo (pond ^:@/===doc%/entropy/txt)
%+ (polo %pass "Entropy: " ~ ~)
@ -188,6 +190,6 @@
:~ [%la %leaf "request rejected - invalid ticket"]
==
:~ [%la %leaf "request approved"]
[%xy /a `card`[%cash mig mac u.wil]]
[%xy /a [%cash mig mac u.wil]]
==
--

18
main/bin/cat.hoon
View File

@ -1,16 +1,10 @@
!:
:: /=main=/toy/cat/hoon
:: /=main=/bin/cat/hoon
::
|= *
|= ape=(list path)
:_ ~
:_ ~
^- gift
:- %te
=- |- ^- (list ,@t)
?~(foz ~ (weld i.foz $(foz t.foz)))
^= foz
=| foz=(list (list ,@t))
|- ^+ foz
?~ ape ~
[(lore ((hard ,@) .^(%cx i.ape))) $(ape t.ape)]
=- ~[-]~
^- gift :- %te
%- zing
%+ turn ape |= pax=path
(lore ;;(,@t .^(%cx pax)))

337
main/bin/chat.hoon
View File

@ -1,24 +1,77 @@
!:
:: /=main=/bin/tach/hoon
:: /=main=/bin/chat/hoon
::
=> %= .
+
=> +
=* sed .
=> ^/===/lib/pony
=> ^/===/lib/chat
=+ ^= flag
$? %leet
%monitor
%noob
%quiet
%time
[%tower p=@p]
[%s p=path]
==
=+ flags=*(list flag)
=> |%
++ chat :: user action
$% [%all p=mess] :: say
[%back p=?(%da %dr %ud) q=@] :: backlog
[%def p=mess] :: use current prompt
[%how ~] :: help
[%priv p=@p q=mess] :: private
[%who ~] :: who
== ::
++ idad ,[p=@p q=@t] :: identity
++ mess :: message
$% [%do p=@t] :: act
[%exp p=@t q=tank] :: code
[%say p=@t] :: say
== ::
++ prom :: prompt type
$% [%pub ~] :: public message
[%pri p=ship] :: private message
== ::
++ user :: amigos
$% [%in p=idad] :: coming on the air
[%out p=idad] :: signing off
== ::
++ station path ::
++ zing :: client to server
$% [%backlog p=path q=?(%da %dr %ud) r=@] ::
[%hola p=station] ::
[%mess p=station q=mess] ::
== ::
++ zong :: server to client
$% [%mess p=@da q=ship r=mess] ::
== ::
--
=> |%
++ chat
%+ cook |=(a=^chat a)
;~ pose
(cold [%how ~] wut)
(cold [%who ~] tis)
(cold [%out ~] zap)
;~(pfix pam (stag %all (stag %& mess)))
;~(pfix bar (stag %all (stag %| mess)))
(stag %say ;~(plug ;~(pfix sig fed:ag) ;~(pfix ace mess)))
(stag %back dat)
(stag %priv ;~(plug ;~(pfix sig fed:ag) ;~(pfix ace mess)))
(stag %all ;~(pfix pam mess))
(stag %def mess)
==
::
++ dat
%+ cook
|= p=coin
?. ?=(~ -.p) [%ud 5]
?+ p.p.p [%ud 5]
%da [%da q.p.p]
%dr [%dr q.p.p]
%ud [%ud q.p.p]
==
;~(pfix (jest '\\\\ ') nuck:so)
::
++ expn
%- sear
:_ text
@ -26,178 +79,238 @@
^- (unit ,[p=@t q=tank])
=+ hun=(rush a wide:vast)
?~ hun ~
?~(a ~ [~ a (sell (slap seed u.hun))])
?~(a ~ [~ a (sell (slap !>(sed) u.hun))])
::
++ mess
%+ cook |=(a=^mess a)
;~ pose
(stag %do ;~(pfix pat text))
(stag %ex ;~(pfix hax expn))
(stag %exp ;~(pfix hax expn))
(stag %do (full (easy '')))
(stag %qu text)
(stag %say text)
==
++ text (boss 256 (star ;~(pose (shim 32 126) (shim 128 255))))
::
++ text (boss 256 (star prn))
--
|%
++ idt
|= from=idad
?: |(!(lien flags |=(a=flag ?=(%noob a))) =("" q.from))
(scow %p p.from)
%- trip
%^ cat 3 %^ cat 3 (scot %p p.from) ' ' q.from
++ rend
|= [chr=tape nym=tape dum=^mess]
|= [from=idad msg=^mess pre=tape tim=@da] :: roo=^room
=+ tst=(lien flags |=(a=flag ?=(%time a)))
^- tank
?- -.dum
%do =+ msg=?:(=(0 p.dum) "remains quietly present" (trip p.dum))
[%leaf "{chr}{nym} {msg}"]
%ex [%rose [" " "" ""] [%leaf "{chr}{nym} {(trip p.dum)}"] q.dum ~]
%qu [%leaf "{chr}{nym}: {(trip p.dum)}"]
?- -.msg
%do
=+ mes=?:(=(0 p.msg) "remains quietly present" (trip p.msg))
:- %leaf
%+ weld
?. tst "" (timestamp tim)
"{pre}{(idt from)} {mes}"
%exp
:~ %rose
[" " "" ""]
:- %leaf
%+ weld
?. tst "" (timestamp tim)
"{pre}{(idt from)} {(trip p.msg)}"
q.msg
==
%say
:- %leaf
%+ weld
?. tst "" (timestamp tim)
"{pre}{(idt from)}: {(trip p.msg)}"
==
++ timestamp
|= t=@da
=+ da=(yell t)
"{?:((gth 10 h.da) "0" "")}{(scow %ud h.da)}:".
"{?:((gth 10 m.da) "0" "")}{(scow %ud m.da)} "
--
::
==
=> %= .
-
:- :* bud=(sein `@p`-<) :: chat server
oot=_@ud :: outstanding, server
tod=*(map ,@p ,@ud) :: outstanding, friend
giz=*(list gift) :: stuff to send
sad=`sand`[%& &] :: default state
wak=_@da :: next wakeup
:- :* ami=*(map ,@p ,@t) ::
bud=(sein `@p`-<) :: chat server
dun=| :: done
giz=*(list gift) :: stuff to send
mon=*? :: leet mode
nub=*? :: monitor mode
pro=`prom`[%pub ~] :: prompt state
sta=*station :: station
sub=*(list path) :: subscriptions
tod=*(map ,@p ,@ud) :: outstanding, friend
tst=| :: timestamp mode
wak=_@da :: next heartbeat
==
[who=`@p`-< how=`path`->]
==
|= [est=time *]
|= ~
|= args=(list flag)
=. flags args
=. wak est
=. bud
?: (lien args |=(a=flag &(?=(^ a) ?=(%tower -.a))))
(roll args |=([p=flag q=@p] ?:(&(?=(^ p) ?=(%tower -.p)) p.p q)))
bud
=. nub (lien args |=(a=flag ?=(%noob a)))
=. mon (lien args |=(a=flag ?=(%monitor a)))
=. sta
?: (lien args |=(a=flag &(?=(^ a) ?=(%s -.a))))
(roll args |=([p=flag q=station] ?:(&(?=(^ p) ?=(%s -.p)) p.p q)))
sta
=. tst (lien args |=(a=flag ?=(%time a)))
|- ^- bowl
=< abet:init
|%
++ abet `bowl`[(flop giz) ?:(dun ~ [~ hope vent(giz ~)])]
++ hope :: wait for events
=< apex
|% ++ apex ^- (list slip)
;: weld
buds
pals
regs
==
::
++ buds ^- (list slip)
?: =(0 oot) ~
[[/re [%ow ~]] ~]
::
++ pals ^- (list slip)
=| alx=(list slip)
|- ^+ alx
?~ tod alx
%= $
tod r.tod
alx %= $
tod l.tod
alx :_(alx [[%ra (scot %p p.n.tod) ~] [%ow ~]])
==
==
::
++ regs ^- (list slip)
:~ [/oy [%lq %oy]]
[/wa [%wa wak]]
[/ya [%lq %ya]]
^- slip
:- /up
:+ %up %text
:_ ""
=+ wyt=?:(?=(& -.sad) !=(0 oot) (~(has by tod) p.sad))
%+ weld
?:(?=(& -.sad) ?:(p.sad "&" "|") (scow %p p.sad))
?:(wyt "... " " ")
==
--
++ hope
:^ [/wa %wa wak]
[/ya %lq %ya]
:^ /up %up %text
:_ ""
?- -.pro
%pub "& "
%pri (weld (scow %p p.pro) " ")
==
%+ welp
(turn sub |=(pax=path [[%gr pax] [%gr ~]]))
%+ turn (~(tap by tod))
|= [p=@p q=@ud]
[[%ra (scot %p p) ~] [%ow ~]]
::
++ init (joke:(joke ~ [%who ~]) ~ [%ego est]) :: initial actions
++ joke :: send message
|= [hur=(unit ,@p) msg=*]
++ iden
|= her=@p
(fall (~(get by ami) her) *@t)
::
++ init (joke:(subs:(subs (welp sta /amigos)) (welp sta /mensajes)) %hola sta)
::
++ jake
|= [her=@p msg=^mess]
^+ +>
?~ hur
+>(oot +(oot), giz :_(giz [%sq bud %yo /re msg]))
%= +>
giz :_(giz [%sq u.hur %ya [%ra (scot %p u.hur) ~] msg])
tod =+ dut=(~(get by tod) u.hur)
(~(put by tod) u.hur ?~(dut 1 +(u.dut)))
%= +>.$
giz :_(giz [%sq her %ya [%ra (scot %p her) ~] msg])
pro [%pri her]
tod (~(put by tod) her +((fall (~(get by tod) her) 0)))
==
::
++ joke :: send message
|= msg=zing
^+ +>
+>(giz :_(giz [%xz [bud %radio] who %zing msg]))
::
++ join
|= you=user
^+ +>
?- -.you
%in
=. ami (~(put by ami) p.you)
?. mon +>.$
(show %leaf "{(idt p.you)} comes on the air")
%out
=. ami (~(del by ami) p.p.you)
?. mon +>.$
(show %leaf "{(idt p.you)} signs off")
==
++ joyn
|= yall=(list idad)
^+ +>
=. ami (~(gas by ami) yall)
?. mon +>.$
(shew (turn yall |=(you=idad [%leaf "{(idt you)} is on the air"])))
::
++ nice :: got response
|= [hur=(unit ,@p) kay=cape]
|= [her=@p kay=cape]
^+ +>
=. +>
?~ hur
+>(oot (dec oot))
=+ dyt=(need (~(get by tod) u.hur))
=+ dyt=(need (~(get by tod) her))
%_ +>.$
tod
?: =(1 dyt)
(~(del by tod) u.hur)
(~(put by tod) u.hur (dec dyt))
(~(del by tod) her)
(~(put by tod) her (dec dyt))
==
?- kay
%good +>
%dead (show %leaf "server {(scow %p ?~(hur bud u.hur))} choked")
%dead (show %leaf "server {(scow %p her)} choked")
==
::
++ priv :: private message
|= [her=@p mes=^mess]
++ priv
|= [now=@da her=@p mes=^mess]
^+ +>
(show (rend "" (trip (numb her est)) mes))
(show (rend [her (iden her)] mes "(private) " now))
::
++ said :: server message
|= [her=@p duz=(list zong)]
|= duz=(list zong)
^+ +>
?~ duz +>
%= $
duz t.duz
+>
%- show
?- -.i.duz
%all (rend ?:(=(%white p.i.duz) "& " "| ") (trip q.q.i.duz) r.i.duz)
%new [%leaf "{(trip q.p.i.duz)} is in the building"]
%out [%leaf "{(trip q.p.i.duz)} has left the building"]
%who [%rose [", " "" ""] (turn p.i.duz |=(a=user [%leaf (trip q.a)]))]
==
==
?- -.i.duz
%mess
?: =(who q.i.duz) +>
(show (rend [q.i.duz (iden q.i.duz)] r.i.duz "" p.i.duz))
== ==
::
++ shew |=(tax=(list tank) +>(giz [[%lo tax] giz])) :: print to screen
++ show |=(tan=tank +>(giz [[%la tan] giz])) :: print to screen
++ take :: alarm event
|- ^+ +
=. wak (add ~m1 (max wak est))
?.(=(0 oot) + (joke ~ `zing`[%ego est]))
::
++ toke :: user action
|= txt=@t
++ subs
|= pax=path
^+ +>
+>(sub [pax sub], giz :_(giz [%zz /g [%gr pax] %show [bud %radio] who pax]))
::
++ take (joke(wak (add ~m1 (max wak est))) %hola sta) :: beat heart
++ toke :: user action
|= [now=@da txt=@t]
^+ +>
?: =(0 txt) +>
=+ rey=(rush txt chat)
?~ rey
(show %leaf "invalid input")
|-
?- -.u.rey
%all (joke(sad [%& p.u.rey]) ~ `zing`u.rey)
%def %- joke
?: ?=(& -.sad)
[~ `zing`[%all p.sad p.u.rey]]
[[~ p.sad] `^mess`p.u.rey]
%how (shew (turn (lore ^:@/===doc%/help/txt) |=(a=@t [%leaf (trip a)])))
%out (show(dun &) %leaf "thanks for chatting yo")
%say (joke(sad [%| p.u.rey]) [~ p.u.rey] `^mess`q.u.rey)
%who (joke ~ `zing`u.rey)
%all (joke(pro [%pub ~]) %mess sta p.u.rey)
%back (joke %backlog sta p.u.rey q.u.rey)
%def $(u.rey ?-(-.pro %pub [%all p.u.rey], %pri [%priv p.pro p.u.rey]))
%how (shew (turn (lore ^:@/===doc%/help/txt) |=(a=@t [%leaf (trip a)])))
%priv (jake p.u.rey q.u.rey)
%who
%^ show %rose [", " "" ""]
%+ turn (~(tap by ami))
|= p=idad
:- %leaf
%- trip
%^ cat 3 %^ cat 3 (scot %p p.p) ' ' q.p
==
::
++ vent :: handle event
|= [now=@da pax=path nut=note]
^- bowl
:: ~& [%vent now pax nut]
=. est now
=< abet
?+ -.pax +>
%oy ?>(?=(%lq -.nut) (said p.nut ((hard (list zong)) r.nut)))
%re ?>(?=(%ow -.nut) (nice ~ p.nut))
?+ -.pax ~& [%chat-vent-unknown -.nut] +>.$
%gr ?> ?=(%gr -.nut)
?+ p.nut ~& %chat-vent-logo-fail +>.$
%user (join ((hard user) q.nut))
%users (joyn ((hard (list idad)) q.nut))
%zong (said [((hard zong) q.nut) ~])
%zongs (said ((hard (list zong)) q.nut))
==
%up ?>(?=(%up -.nut) (toke now p.nut))
%ra ?> &(?=(%ow -.nut) ?=(^ t.pax))
(nice [~ (need (slaw %p i.t.pax))] p.nut)
%up ?>(?=(%up -.nut) (toke p.nut))
(nice (need (slaw %p i.t.pax)) p.nut)
%wa ?>(?=(%wa -.nut) take)
%ya ?>(?=(%lq -.nut) (priv p.nut ((hard ^mess) r.nut)))
%ya ?> ?=(%lq -.nut)
=+ n=((soft ^mess) r.nut)
?~ n
~& %chat-mess-fail +>+
(priv now p.nut u.n)
==
--

265
main/bin/haus.hoon Normal file
View File

@ -0,0 +1,265 @@
!:
:: /=main=/bin/haus/hoon
::
=> %= .
+
=> +
=> ^/===/lib/pony
=> ^/===/lib/chat
=> |%
++ fool
$: nym=@t :: text name
sec=sect :: banner
elf=(map room ,[d=@da n=@ud]) :: ping/mess received
== ::
++ loft :: room log
$: num=@ud :: (lent meg)
meg=(list zong) :: messages backward
== ::
++ part :: party
$: lov=(map room loft) :: rooms
pod=(map ,@p fool) :: individual status
== ::
++ chub (list ,[p=@p q=(list zong)]) :: delivery report
-- ::
|%
++ fu
|_ [now=@da par=part]
++ of
|_ [her=@p ful=fool]
++ abet ..of(pod.par (~(put by pod.par) her ful))
++ call [her nym.ful]
++ push
^- [(list zong) _.]
:-
^- (list zong)
%- flop
^- (list zong)
%+ ~(rep by elf.ful) *(list zong)
|= [[r=room *] q=(list zong)]
=+ lov=(fall (~(get by lov.par) r) *loft)
=+ num=+:(fall (~(get by elf.ful) r) *[@da @ud])
%+ weld
%+ skim (scag (sub num.lov num) meg.lov)
|= a=zong
?< ?=(%who -.a)
?& (~(has by elf.ful) q.a)
?. ?=(%all -.a) &
&(!=(her p.s.a) |(=(%white r.a) =(sec.ful r.a)))
==
q
^- _.
%= .
elf.ful
%- ~(tur by elf.ful)
|= [r=room [d=@da n=@ud]]
=+ lov=(fall (~(get by lov.par) r) *loft)
[d num.lov]
==
--
::
++ rolf
^- [chub _.]
=^ zal pod.par
%+ ~(rib by pod.par) *chub
|= [[her=@p ful=fool] fug=chub]
^- [chub [@p fool]]
=+ lol=~(push of her ful)
[[[her -.lol] fug] [her ful.+.lol]]
[zal +]
::
++ tell
|= zog=(map room (list zong))
%= +>
lov.par
^- (map room loft)
=+ ^= m ^- (map room loft)
%+ ~(rep by lov.par)
*(map room loft)
|= [p=[p=room q=loft] q=(map room loft)]
=+ g=(~(get by zog) p.p)
=+ g=?~(g ~ u.g)
%+ ~(put by q) p.p
[(add (lent g) num.q.p) (weld (flop g) meg.q.p)]
%- ~(gas by m)
%+ turn
%+ skip (~(tap by zog) ~)
|= [p=room q=(list zong)]
(~(has by lov.par) p)
|= [p=room q=(list zong)]
^- [room loft]
[p [0 q]]
==
::
++ tilt
|= zew=(map room (list zong))
^- [chub part]
=. +>.$ (tell zew)
=^ yeq +>.$ rolf
[yeq par]
::
++ wake
^- [chub part]
=^ zew pod.par
%+ ~(rib by pod.par) *(map room (list zong))
|= [[her=@p ful=fool] fug=(map room (list zong))]
^- [(map room (list zong)) [@p fool]]
=+ ^= outs ^- (list room)
%+ ~(rep by elf.ful) *(list room)
|= [[r=room [d=@da n=@ud]] q=(list room)]
?. (gth now (add ~m2 d)) q
[r q]
=+ ^= outmes ^- (list ,[room (list zong)])
%+ turn outs
|= r=room
[r [%out now r [her nym.ful]]~]
=+ ^= f
|= [p=room q=(map room ,[@da @ud])] (~(del by q) p)
=+ ^= newelf ^- (map room ,[@da @ud])
%+ roll outs f(q elf.ful)
[(~(gas by fug) outmes) [her ful(elf newelf)]]
(tilt zew)
::
++ yelp
|= [our=@p her=@p zig=zing]
^- [chub part]
?: ?=(%who -.zig)
:_ par
:_ ~
:- her
^- (list zong)
:_ ~
:^ %who now p.zig
=+ ^= all ^- (map room (list user))
=< -
%+ ~(rib by pod.par) *(map room (list user))
|= [[her=@p ful=fool] fug=(map room (list user))]
^- [(map room (list user)) [@p fool]]
:_ [her ful]
%+ ~(rep by elf.ful) fug
|= [[r=room *] q=(map room (list user))]
%+ ~(put by q) r
[[her nym.ful] (fall (~(get by fug) r) ~)]
?~ q.zig
all
%- ~(gas by *(map room (list user)))
(turn u.q.zig |=(r=room [r (fall (~(get by all) r) ~)]))
=+ pof=(yowl our her)
=+ m=*(map room (list zong))
=^ zew +>.$
?- -.zig
%all
:_ abet:pof
%- ~(gas by m)
?. (~(has by elf.ful:pof) p.zig) ~
:_ ~
:- p.zig
~[[%all now p.zig ?:(q.zig %white sec.ful.pof) call:pof r.zig]]
::
%ego
=+ num=n:(fall (~(get by elf.ful.pof) p.zig) [_@ n=_@ud])
:_ abet:pof(elf.ful (~(put by elf.ful.pof) p.zig [now num]))
%- ~(gas by m)
=+ liv=(~(has by elf.ful.pof) p.zig)
=. elf.ful.pof (~(put by elf.ful.pof) p.zig [now num])
?: liv ~
[p.zig ~[[%new now p.zig call:pof]]]~
::
%out
:- ~ abet:pof
:: :_ abet:pof(elf.ful (~(del by elf.ful.pof) p.zig))
:: %- ~(gas by m)
:: ?. liv.ful.pof ~
:: (turn roo.ful:pof |=(c=room [c ~[[%out now c call:pof]]]))
==
(tilt zew)
::
++ yowl
|= [our=@p her=@p]
^+ of
=+ nog=(~(get by pod.par) her)
=+ ^= ful ^- fool
?^ nog u.nog
=+ ^= gos
%- (hard (unit gcos))
.^(%a (scot %p our) %gcos (scot %da now) (scot %p her) ~)
^- fool
:* ^- @t
=+ yow=(scot %p her)
=+ ^= woy
%- (hard ,@t)
.^(%a (scot %p our) %name (scot %da now) (scot %p her) ~)
?: =(%$ woy) yow
(cat 3 yow (cat 3 ' ' woy))
^- sect
?. &(?=(^ gos) ?=(%duke -.u.gos)) %white
?: ?=(?(%lord %lady) -.p.u.gos)
r.p.p.u.gos
?:(?=(%punk -.p.u.gos) p.p.u.gos %white)
*(map room ,[@da @ud])
==
~(. of her ful)
--
--
==
=> %= .
-
:- :* par=[(mo `(list ,[room loft])`~[[coci *loft]]) *(map ,@p fool)]
wak=_@da
==
[who=`@p`-< how=`path`->]
==
|= [est=time *]
|= ~
=. wak est
=< `bowl`[~ ~ hope vent]
|%
++ care
|= [you=@p meg=(list zong) mor=(list gift)]
=+ len=(lent meg)
|- ^- (list gift)
?: =(0 len) mor
=+ hob=(min len 256)
:- [%sq you %ob /re (scag hob meg)]
$(meg (slag hob meg), len (sub len hob))
::
++ cede
|= cub=chub
^- (list gift)
?~(cub ~ (care p.i.cub q.i.cub $(cub t.cub)))
::
++ hope
^- (list slip)
:~ [/bo [%lq %bo]]
[/wa [%wa wak]]
[/re [%ow ~]]
==
::
++ take
|- ^- [chub _+]
=^ cub par ~(wake fu est par)
[cub +.$]
::
++ talk
|= [her=@p zig=zing]
^- [chub _+>]
=^ cub par (~(yelp fu est par) who her zig)
[cub +>.$]
::
++ vent
|= [now=@da pax=path nut=note]
^- bowl
=. est now
=^ cub +>
?+ -.pax !!
%re ?>(?=(%ow -.nut) [~ +>])
%wa ?>(?=(%wa -.nut) take(wak (add ~m1 est)))
%bo
?> ?=(%lq -.nut)
=+ n=((soft zing) r.nut)
?~ n
~& %haus-zing-fail [~ +>+]
(talk p.nut u.n)
==
[(cede cub) ~ hope ..$]
--

2
main/bin/reboot.hoon
View File

@ -16,6 +16,8 @@
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
==
:_ ~
%+ turn vay

4
main/bin/report.hoon
View File

@ -6,6 +6,6 @@
|= [bud=@p ~]
^- bowl
:_ ~
:~ [%la ((hard tank) .^(%c /(scot %p bud)/show=))]
[%la ((hard tank) .^(%a /(scot %p bud)/show=))]
:~ :: [%la ((hard tank) .^(%c /(scot %p bud)/show=))]
[%la ((hard tank) .^(%a /(scot %p who)/show=/(scot %p bud)))]
==

2
main/bin/reset.hoon
View File

@ -21,6 +21,8 @@
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
==
%+ turn vay
|= [a=@tas b=@tas]

190
main/bin/room.hoon
View File

@ -1,190 +0,0 @@
!:
:: /=main=/bin/room/hoon
::
=> %= .
+
=> +
=> ^/===/lib/pony
=> ^/===/lib/chat
=> |%
++ fool
$: num=@ud :: number received
nym=@t :: text name
sec=sect :: banner
liv=? :: officially live
elf=@da :: last ping
== ::
++ loft ::
$: num=@ud :: (lent meg)
meg=(list zong) :: messages backward
pod=(map ,@p fool) :: individual status
== ::
++ chub (list ,[p=@p q=(list zong)]) :: delivery report
-- ::
|%
++ fu
|_ [now=@da lov=loft]
++ of
|_ [her=@p ful=fool]
++ abet ..of(pod.lov (~(put by pod.lov) her ful))
++ call [her nym.ful]
++ push
^- [(list zong) _.]
?. liv.ful [~ .]
:- %- flop
%+ skim (scag (sub num.lov num.ful) meg.lov)
|= a=zong
?. ?=(%all -.a) &
&(!=(her p.q.a) |(=(%white p.a) =(sec.ful p.a)))
.(num.ful num.lov)
--
::
++ rolf
^- [chub _.]
=^ zal pod.lov
%+ ~(rib by pod.lov) *chub
|= [[her=@p ful=fool] fug=chub]
^- [chub [@p fool]]
=+ lol=~(push of her ful)
[[[her -.lol] fug] [her ful.+.lol]]
[zal +]
::
++ tell
|= zog=(list zong)
^+ +>
%= +>
num.lov (add (lent zog) num.lov)
meg.lov (weld (flop zog) meg.lov)
==
::
++ tilt
|= zew=(list zong)
=. +>.$ (tell zew)
=^ yeq +>.$ rolf
[yeq lov]
::
++ wake
^- [chub loft]
=^ zew pod.lov
%+ ~(rib by pod.lov) *(list zong)
|= [[her=@p ful=fool] fug=(list zong)]
^- [(list zong) [@p fool]]
?. &(liv.ful (gth now (add ~m2 elf.ful))) [fug her ful]
[[`zong`[%out [her nym.ful]] fug] [her ful(liv |)]]
(tilt zew)
::
++ yelp
|= [her=@p zig=zing]
^- [chub loft]
?: ?=(%who -.zig)
:_ lov
:~ :- her
:~ :- %who
^- (list user)
=< -
%+ ~(rib by pod.lov) *(list user)
|= [[her=@p ful=fool] fug=(list user)]
^- [(list user) [@p fool]]
:_ [her ful]
?. liv.ful fug
[[her nym.ful] fug]
==
==
=+ pof=(yowl her)
=^ zew +>.$
?- -.zig
%all
:_ abet:pof
[[%all ?:(p.zig %white sec.ful.pof) call:pof q.zig] ~]
::
%ego
:_ abet:pof(liv.ful &, elf.ful now)
=. elf.ful.pof now
?:(liv.ful.pof ~ [[%new call:pof] ~])
::
%out
:_ abet:pof(liv.ful |)
?.(liv.ful.pof ~ [[%out call:pof] ~])
==
(tilt zew)
::
++ yowl
|= her=@p
^+ of
=+ nog=(~(get by pod.lov) her)
=+ ^= ful ^- fool
?^ nog u.nog
=+ ^= gos
%- (hard (unit gcos))
.^(%a (scot %p her) %gcos (scot %da now) ~)
^- fool
:* 0
(numb her now)
^- sect
?. &(?=(^ gos) ?=(%duke -.u.gos)) %white
?: ?=(?(%lord %lady) -.p.u.gos)
r.p.p.u.gos
?:(?=(%punk -.p.u.gos) p.p.u.gos %white)
|
now
==
~(. of her ful)
--
--
==
=> %= .
-
:- :* lov=*loft
wak=_@da
==
[who=`@p`-< how=`path`->]
==
|= [est=time *]
|= ~
=. wak est
=< `bowl`[~ ~ hope vent]
|%
++ care
|= [you=@p meg=(list zong) mor=(list gift)]
=+ len=(lent meg)
|- ^- (list gift)
?: =(0 len) mor
=+ hob=(min len 256)
:- [%sq you %oy /re (scag hob meg)]
$(meg (slag hob meg), len (sub len hob))
::
++ cede
|= cub=chub
^- (list gift)
?~(cub ~ (care p.i.cub q.i.cub $(cub t.cub)))
::
++ hope
^- (list slip)
:~ [/yo [%lq %yo]]
[/wa [%wa wak]]
[/re [%ow ~]]
==
::
++ take
|- ^- [chub _+]
=^ cub lov ~(wake fu est lov)
[cub +.$]
::
++ talk
|= [her=@p zig=zing]
^- [chub _+>]
=^ cub lov (~(yelp fu est lov) her zig)
[cub +>.$]
::
++ vent
|= [now=@da pax=path nut=note]
^- bowl
=. est now
=^ cub +>
?+ -.pax !!
%re ?>(?=(%ow -.nut) [~ +>])
%wa ?>(?=(%wa -.nut) take(wak (add ~m1 est)))
%yo ?>(?=(%lq -.nut) (talk p.nut ((hard zing) r.nut)))
==
[(cede cub) ~ hope ..$]
--

12
main/bin/solid.hoon
View File

@ -20,12 +20,13 @@
=+ all=.*(0 ken)
=+ ^= vay ^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%f %ford]
[%a %ames]
[%b %batz]
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
==
|- ^+ all
?~ vay all
@ -37,7 +38,8 @@
=+ nex=+:.*([-.gat [sam +>.gat]] -.gat)
$(vay t.vay, all nex)
:_ ~ :_ ~
~& %solid-jamming
=+ pac=(jam [ken all])
~& %solid-finished
[%xx %save [%urbit %pill ~] pac]
:: ~& %solid-jamming
:: =+ pac=(jam [ken all])
:: ~& %solid-finished
:: [%xx %save [%urbit %pill ~] pac]
[%xx %sage [%urbit %pill ~] [ken all]]

8
main/bin/tach.hoon
View File

@ -1,8 +0,0 @@
::
:: /=main=/bin/tach/hoon
::
|= *
|= ~
^- bowl
:_ ~ :_ ~
[%la %leaf "you probably meant to run :chat."]

2
main/bin/thumb.hoon
View File

@ -7,7 +7,7 @@
^- bowl
:_ ~
=+ dub=(scot %p bud)
=+ wyl=((hard will) .^(%a /[dub]/will=))
=+ wyl=((hard will) .^(%a /=will=/[dub]))
?~ wyl
[[%la %leaf "no will for {(trip dub)}"] ~]
[[%la >q.q.q.i.wyl<] ~]

48
main/bin/update.hoon
View File

@ -2,27 +2,39 @@
:: /=main=/bin/update/hoon
::
=> .(-< `who=@p`-<)
=> %= .
+
=> +
|%
++ merge
|= [gem=germ who=@p bos=@p est=time]
|= [der=dome owr=dome des=desk]
^- gift
=+ sab=`saba`[bos des [0 let.der] (flop (turn hit.der |=(a=frog q.a))) ang.der]
=+ lum=(~(auld ze est owr) gem who des sab)
?~ lum
^- gift
:^ %la %rose [": " "" ""]
:~
leaf/"{(trip des)} failed to apply, please rerun with a merge option"
(skol -:!>(_germ))
==
?~ u.lum
`gift`[%la %leaf "{(trip des)} is up to date"]
`gift`[%ok des u.u.lum]
--
==
|= [est=time eny=@uw]
|= ~
^- bowl
|= gem=$|([germ ~] ~)
=+ wen=(scot %da (need (slaw %da +>-:/===))) :: heinous
?: =(~zod who) [~ ~]
=+ bos==+(bos=(sein who) ?.(=(bos who) bos ~zod))
=+ ^= syn ^- (list ,@tas)
[%main %arvo %try ~]
:_ ~
^- (list gift)
:- [%la %leaf "updating..."]
=+ bos==+(bos=(sein who) ?:(=(bos who) ~zod bos))
=+ syn=`(list ,@tas)`~[%main %arvo %try]
=+ ^= desks
%+ turn syn
|= des=@tas
:: ~& [%reading `path`/(scot %p bos)/[des]/[wen]]
|= des=desk
=+ der=((hard dome) .^(%cv /(scot %p bos)/[des]/[wen]))
:: ~& [%reading `path`/(scot %p who)/[des]/[wen]]
=+ owr=((hard dome) .^(%cv /(scot %p who)/[des]/[wen]))
=+ sab=`saba`[bos des [0 let.der] (flop (turn hit.der |=(a=frog q.a)))]
=+ lum=(~(auld ze est owr) est %fine sab)
?~ lum
`gift`[%la %leaf "{(trip des)} failed to merge"]
?~ u.lum
`gift`[%la %leaf "{(trip des)} is up to date"]
`gift`[%ok des u.u.lum]
[der owr des]
=+ gifts=`(list gift)`(turn desks (merge ?~(gem %fine -.gem) who bos est))
`bowl`[[[%la %leaf "updating..."] gifts] ~]

8
main/bin/verb.hoon Normal file
View File

@ -0,0 +1,8 @@
!:
:: /=main=/bin/verb/hoon
::
=> .(-< `who=@p`-<)
|= [est=time *]
|= ~
^- bowl
[[%xx %verb ~]~ ~]

11
main/bin/wipe.hoon Normal file
View File

@ -0,0 +1,11 @@
!:
:: /=main=/bin/wipe/hoon
::
=* our -<
|= *
|= gon=[term (pole term)]
:_ ~
%+ turn `(list term)`gon
|= app=term
^- gift
[%xy /g %wipe [our app]]

34
main/doc/chat/help.txt
View File

@ -1,7 +1,29 @@
prompts (channels): types:
& broadcast message to room @ do an action (irc /me)
| banner message # evaluate expression
~ship private message to ship = show ships in channel
prompts:
& broadcast message to station
~ship private message to ship
type the prompt, then the message. ex: to send to ~hoclur-bicrel, type
"~hoclur-bicrel hello mars". prompt changes are persistent.
actions:
@ send message in third person (irc /me)
# evaluate expression (ex: "#(add 2 2)")
other:
= show ships in current station
\\ 5 show recent backlog (last n messages)
\\ ~m5 show recent backlog (using @dr syntax)
\\ ~2014.07.04 show recent backlog (using @da syntax)
command-line parameters:
[%tower ~hoclur-bicrel] select haus server (default: ticketing ship)
[%s /mars] select a station (default: /)
%monitor display entrance and exit notices
%quiet do not display entrance and exit notices
%leet only display ship names
%noob display ship and textual names
%time display timestamps for messages
only one of %monitor and %quiet may be specfied. default behavior is %quiet.
only one of %leet and %noob may be specified. default behavior is %leet.
to change prompt, type desired prompt. prompt changes preceding a message
will send message in new prompt. prompt changes and types may be combined.

37
main/doc/fancy/down.hoon Normal file
View File

@ -0,0 +1,37 @@
!:
:::::: /hoon/down/fancy/doc
::
=>
:::::: models
|%
++ down
$& [p=down q=down]
$% [%$ p=tape]
[%code p=tape]
[%inco p=tape]
[%head p=@ud q=down]
[%link p=tape q=tape r=(unit tape)]
[%lord p=(list down)]
[%lund p=(list down)]
[%parg p=down]
[%quot p=down]
[%rong p=down]
[%emph p=down]
[%hrul ~]
[%html p=tape]
==
--
:::::: generator
::
~& [%fank-hoon %path %]
%- (fest /fancy/doc %)
|= pic=epic
~& [%fank-hook-butt but.pic]
=+ unt=|=(a=cord (biff (~(get by qix.pic) a) |=(b=cord (slaw %ud b))))
~! unt
=+ moo=(both (unt %foo) (unt %bar))
?~ moo [%$ "Hello, world: usage: url?foo=x&bar=y"]
:* [%$ "Hello, "]
[%emph %$ "world"]
[%$ ": {<-.u.moo>} plus {<+.u.moo>} is {<(add u.moo)>}."]
==

1
main/doc/hello.md Normal file
View File

@ -0,0 +1 @@
This is a *markdown file*.

8780
main/doc/ref/doc-split-me.txt Normal file
View File

File diff suppressed because it is too large Load Diff

128
main/doc/ref/index.md Normal file
View File

@ -0,0 +1,128 @@
- Foreward
- Nock
- Preface
- volume 0, version stub
- volume 1, Hoon models
- volume 2, Hoon libraries and compiler
- chapter 2a, basic unsigned math
- chapter 2b, basic containers
- section 2bA, units
- section 2bB, lists
- chapter 2c, simple noun surgery
### Chapters 2a through 2eZ refactoring and second-pass.
### Dulin and Henry.
- section 2cA, bit surgery
- section 2cB, bit logic
- section 2cC, noun orders
- section 2cD, insecure hashing
- section 2cE, phonetic base
- section 2cF, signed and modular ints
- section 2cG, floating point
- section 2cH, urbit time
- section 2cI, almost macros
- chapter 2d, containers
- section 2dA, sets
- section 2dB, maps
- section 2dC, queues
- section 2dD, casual containers
- chapter 2e, miscellaneous libs
### Anton - virtualization
- section 2eA, packing
- section 2eB, parsing (tracing)
- section 2eC, parsing (custom rules)
- section 2eD, parsing (combinators)
- section 2eE, parsing (composers)
- section 2eF, parsing (ascii)
- section 2eG, parsing (whitespace)
- section 2eH, parsing (idioms)
- section 2eI, parsing (external)
- section 2eJ, formatting (basic text)
- section 2eK, formatting (layout)
- section 2eL, formatting (path)
- section 2eM, regular expressions
- section 2eN, psuedo-cryptography
- section 2eO, virtualization
- section 2eP, diff (move me)
- section 2eW, lite number theory
- section 2eX, jetted crypto (move)
- section 2eY, SHA-2564 (move me)
- section 2eZ, OLD rendering (kill me)
### Chapter 2f is Philip.
- chapter 2f, Hoon proper
- section 2fA, miscellaneous funs
- section 2fB, macro expansion
- section 2fC, compilation proper
- section 2fD, grammar
- volume 3, Arvo models and skeleton
- chapter 3a, Arvo core
- chapter 3b, Arvo libraries, zuse
### Anton - All of Chapter 3b except 3bE and 3bG.
- section 3bA, lite number theory
- section 3bB, cryptosuites
- section 3bC, UTC
- section 3bD, JSON and XML
- section 3bE, tree sync
- section 3bF, names etc
- section 3bG, Arvo models
- Volume 4, Arvo vanes
### Chapter 4a, %ames, is Philip. Possibly %ford nad %gall as well.
- chapter 4a, ames, networking
- section 4aA, structures
- section 4aB, identity logic
- section 4aC, packet format
- section 4aD, PKI engine
- section 4aE, packet pump
- section 4aF, protocol engine
- section 4aG, protocol vane
- chapter 4b, batz: shell
- section 4bA, shell models
- section 4bB, session engine
- section 4bC, shell vane
- chapter 4c, clay: revision control
- section 4cA, structures
- section 4cB, filesystem logic
- section 4cC, filesystem vane
### Anton Chapter 4d
- chapter 4d, dill: terminal handling
- chapter 4e, eyre: http servant
- chapter 4f, ford: execution control
- chapter 4g, gall: user-level applications
- Postface

618
main/doc/ref/nock.md Normal file
View File

@ -0,0 +1,618 @@
Nock Reference
==============
##What is Nock?
Nock is a homoiconic combinator algebra, not much fancier than SKI combinators.
The spec fits on a T-shirt and gzips to 340 bytes.
Think of Nock as a kind of functional assembly language. It's not like assembly
language in that it's directly executed by the hardware. It is like assembly
language in that (a) everything in Urbit executes as Nock; (b) you wouldn't want
to program directly in Nock; and (c) learning to program directly in Nock is a
great way to start understanding Urbit from the ground up.
Just as Unix runs C programs by compiling them to assembler, Urbit runs Hoon
programs by compiling them to Nock. You could try to learn Hoon without learning
Nock. But just as C is a thin wrapper over the physical CPU, Hoon is a thin
wrapper over the Nock virtual machine. It's a tall stack made of thin layers,
which is much easier to learn a layer at a time.
And unlike most fundamental theories of computing, there's really nothing smart
or interesting about Nock. Of course, in a strictly formal sense, all of
computing is math. But that doesn't mean it needs to feel like math. Nock is a
simple mechanical device and it's meant to feel that way.
##Nouns
1 :: A noun is an atom or a cell.
2 :: An atom is a natural number.
3 :: A cell is an ordered pair of nouns.
An **atom** is a natural number - ie, an unsigned integer. Nock does not limit
the size of **atoms**, or know what an **atom** means.
For instance, the **atom** `97` might mean the number `97`, or it might mean the
letter `a` (ASCII 97). A very large **atom** might be the number of grains of
sand on the beach - or it might be a GIF of your children playing on the beach.
Typically when we represent strings or files as **atoms**, the first byte is the
low byte. But even this is just a convention. An **atom** is an **atom**.
A **cell** is an ordered pair of any two **nouns** - **cell** or **atom**. We
group cells with square brackets:
[1 1]
[34 45]
[[3 42] 12]
[[1 0] [0 [1 99]]]
*Nouns* are the dumbest data model ever. **Nouns** make JSON look like XML and
XML look like ASN.1. It may also remind you of Lisp's S-expressions - you can
think of nouns as "S-expressions without the S."
To be exact, a *noun* is an S-expression, except that classic S-expressions have
multiple **atom** types ("S" is for "symbol"). Since Nock is designed to be
used with a higher-level type system (such as Hoon's), it does not need
low-level types. An **atom** is just an unsigned integer of any size.
For instance, it's common to represent strings (or even whole text files) as
atoms, arranging them LSB first - so "foo" becomes `0x6f6f66`. How do we know to
print this as "foo", not `0x6f6f66`? We need external information - such as a
Hoon type. Similarly, other common atomic types - signed integers, floating
point, etc
- are all straightforward to map into **atoms**.
It's also important to note that, unlike Lisp, Nock cannot create cyclical data
structures. It is normal and common for **nouns** in a Nock runtime system to
have acyclic structure - shared subtrees. But there is no Nock computation that
can make a child point to its parent. One consequence: Nock has no garbage
collector. (Nor can dag structure be detected, as with Lisp eq.)
There is also no single syntax for **nouns**. If you have **nouns** you have
Nock; if you have Nock you have Hoon; if you have Hoon, you can write whatever
parser you like.
##The Nock Function
5 :: nock(a) *a
Nock is a pure (stateless) function from **noun** to **noun**. In our pseudocode
(and only in our pseudocode) we express this with the prefix operator `*`.
A Nock program is given meaning by a process of reduction. To compute `nock(x)`,
where `x` is any **noun**, we step through the rules from the top down, find the
first left-hand side that matches `x`, and reduce it to the right-hand side (in
more mathematical notation, we might write line 5 as `nock(a) -> *a`, a style we
do use in documentation)
When we use variable names, like `a`, in the pseudocode spec, we simply mean
that the rule fits for any **noun** `a`.
So `nock(x)` is `*x`, for any **noun** `x`. And how do we reduce `*x`? Looking
up, we see that lines 23 through 39 reduce `*x` - for different patterns of `x`.
Normally `a` in `nock(a)` is a **cell** `[s f]`, or
[subject formula]
Intuitively, the formula is your function and the subject is its argument.
Hoon, or any other high-level language built on Nock, will build its own
function calling convention which does not map directly to `*[subject formula]`.
##Bracket Grouping
6 :: [a b c] [a [b c]]
Brackets associate to the right.
So instead of writing
[2 [6 7]]
[2 [6 [14 15]]]
[2 [6 [[28 29] [30 31]]]]
[2 [6 [[28 29] [30 [62 63]]]]]
we can write
[2 6 7]
[2 6 14 15]
[2 6 [28 29] 30 31]
[2 6 [28 29] 30 62 63]
While this notational convenience is hardly rocket science, it's surprising how
confusing it can be, especially if you have a Lisp background. Lisp's
"S-expressions" are very similar to **nouns**, except that Lisp has multiple
types of **atom**, and Lisp's syntax automatically adds list terminators to
groups.
For those with Lisp experience, it's important to note that Nock and Hoon use
tuples or "improper lists" much more heavily than Lisp. The list terminator,
normally 0, is never automatic. So the Lisp list
(a b c)
becomes the Nock **noun**
[a b c 0]
which is equivalent to
[a [b [c 0]]]
Note that we can and do use unnecessary brackets anyway, for emphasis.
##Axiomatic Functions
8 :: ?[a b] 0
9 :: ?a 1
10 :: +[a b] +[a b]
11 :: +a 1 + a
12 :: =[a a] 0
13 :: =[a b] 1
Here we define three of Nock's four axiomatic functions: **Cell-test**,
**Increment** and **Equals** (the fourth axiomatic function, called **Address**,
is defined in lines 16 through 21). These functions are just pseudocode, not
actual Nock syntax, and are only used to define the behaviour of certain Nock
operators.
We should note that in Nock and Hoon, `0` (pronounced "yes") is true, and `1`
("no") is false. This convention is the opposite of old-fashioned booleans, so
we try hard to say "yes" and "no" instead of "true" and "false."
###Cell-test: `?`
`?` (pronounced "wut") tests whether is a **noun** is a **cell**. Again, `0`
means "yes", `1` means "no":
8 :: ?[a b] 0
9 :: ?a 1
---
###Increment: `+`
`+` (pronounced "lus") adds `1` to an **atom**:
10 :: +[a b] +[a b]
11 :: +a 1 + a
---
###Equals: `=`
`=` (pronounced "tis") tests a cell for
equality. `0` means "yes", `1` means "no":
12 :: =[a a] 0
13 :: =[a b] 1
14 :: =a =a
Testing an **atom** for equality makes no sense and logically fails to
terminate.
---
Because `+` works only for **atoms**, whereas `=` works only for **cells**, the
error rules match first for `+` and last for `=`.
##Noun Address
16 :: /[1 a] a
17 :: /[2 a b] a
18 :: /[3 a b] b
19 :: /[(a + a) b] /[2 /[a b]]
20 :: /[(a + a + 1) b] /[3 /[a b]]
21 :: /a /a
We define a **noun** as a binary tree - where each node branches to a left and
right child - and assign an address, or **axis**, to every element in the tree.
The root of the tree is `/1`. The left child (**head**) of every node at `/a` is
`/2a`; the right child (**tail**) is `/2a+1`. (Writing `(a + a)` is just a
clever way to write `2a`, while minimizing the set of pseudocode forms.)
`1` is the root. The **head** of every **axis** `n` is `2n`; the **tail** is
`2n+1`. Thus a simple tree:
1
2 3
4 5 6 7
14 15
If the value of every leaf is its tree address, this tree is
[[4 5] [6 14 15]]
Let's use the example `[[97 2] [1 42 0]]`. So
/[1 [97 2] [1 42 0]] -> [[97 2] [1 42 0]]
because `/1` is the root of the tree, ie, the whole **noun**.
Its left child (**head**) is `/2` (i.e. `(1 + 1)`):
/[2 [97 2] [1 42 0]] -> [97 2]
And its right child (**tail**) is `/3` (i.e. `(1 + 1 + 1)`):
/[3 [97 2] [1 42 0]] -> [1 42 0]
And delving into `/3`, we see `/(3 + 3)` and `/(3 + 3 + 1)`:
/[6 [97 2] [1 42 0]] -> 1
/[7 [97 2] [1 42 0]] -> [42 0]
It's also fun to build nouns in which every atom is its own axis:
1
[2 3]
[2 6 7]
[[4 5] 6 7]
[[4 5] 6 14 15]
[[4 5] [12 13] 14 15]
[[4 [10 11]] [12 13] 14 15]
[[[8 9] [10 11]] [12 13] 14 30 31]
##Distribution
23 :: *[a [b c] d] [*[a b c] *[a d]]
The practical domain of the Nock function is always a **cell**. When `a` is an
**atom**, `*a`, or `nock(a)`, is always an error. Conventionally, Nock proper
is always a function of a **cell**. The **head** of this **cell** is the
**subject**, the **tail** is the **formula**
[subject formula]
and the result of passing a **noun** through the Nock function is called the
**product**.
nock([subject formula]) => product
or
*[subject formula] => product
The **subject** is your data and the **formula** is your code. And the
**product** is your code's output.
Notice that `a` in the Nock rules is always the **subject**, except line 39,
which is a crash default for malformed **nouns** that do not evaluate.
A **formula** is always a **cell**. But when we look inside that **cell**, we
see two basic kinds of **formulas**:
[operator operands]
[formula-x formula-y]
An **operator** is always an **atom** (`0` through `10`). A **formula** is
always a **cell**. Line 23 distinguishes these forms:
23 :: *[a [b c] d] [*[a b c] *[a d]]
If your code contains multiple **formulas**, the **subject** will distribute
over those **formulas**.
In other words, if you have two Nock **formulas** `x` and `y`, a **formula**
that computes the pair of them is just the **cell** `[x y]`.
*[subject [x y]] -> [*[subject x] *[subject y]]
No **atom** is a valid **formula**, and every **formula** that does not use line
23 has an atomic **head**.
Suppose you have two **formulas** `f` and `g`, each of which computes some
function of the **subject** `s`. You can then construct the **formula** `h` as
`[f g]`; and `h(s) = [f(s) g(s)]`.
For example:
*[[19 42] [0 3] 0 2]
The **subject** `s` is `[19 42]`. The **formula** `h` is `*[[0 3] 0 2]`.
*[s h]
The **head** of `h` is `f`, which is `[0 3]`. The **tail** of `h` is `g`, which
is `[0 2]`.
*[s [f g]]
by the distribution rule, `*[s [f g]]` is
[*[s f] *[s g]]
or
[*[[19 42] [0 3]] *[[19 42] 0 2]]
`*[s f]` is `f(s)` and produces `42`. `*[s g]` is `g(s)` and produces 19.
Since `h(s)` is `[f(s) g(s)]`, `h(s)` is `[42 19]`:
*[[19 42] [0 3] 0 2] -> [42 19]
##Operator 0: Axis
25 :: *[a 0 b] /[b a]
Operator 0 is Nock's tree address or **axis** operator, using the tree
addressing structure defined in lines 16 through 20. `*[a 0 b]` simply returns
the value of the part of `a` at **axis** `b`. For any subject `a`, the formula
`[0 b]` produces `/[b a]`.
For example,
*[[19 42] 0 3] -> /[3 19 42] -> 42.
##Operator 1: Just
26 :: *[a 1 b] b
`1` is the constant, or **Just operator**. It produces its operand `b` without
reference to the **subject**.
For example,
*[42 1 57] -> 57
**Operator 1** is named **Just** because it produces "just" its operand.
##Operator 2: Fire
27 :: *[a 2 b c] *[*[a b] *[a c]]
**Operator 2** is the **Fire operator**, which brings us the essential magic of
recursion. Given the **formula** `[2 b c]`, `b` is a **formula** for generating
a new **subject**; `c` is a **formula** for generating a new **formula**. To
compute `*[a 2 b c]`, we evaluate both `b` and `c` against the current
**subject** `a`.
A common use of **Fire** is to evaluate data inside the **subject** as code.
For example:
*[[[40 43] [4 0 1]] [2 [0 4] [0 3]]] -> 41
*[[[40 43] [4 0 1]] [2 [0 5] [0 3]]] -> 44
**Operator 2** is called **Fire** because it "fires" Nock **formulas** at its
(possibly modified) **subject**.
##Operator 3: Depth
28 :: *[a 3 b] ?*[a b]
**Operator 3** applies the **Cell-test** function defined in lines 8 and 9 to
the product of `*[a b]`.
###Cell-test: `?`
`?` (pronounced "wut") tests whether is a noun is a cell. Again, 0 means yes, 1
means no:
8 :: ?[a b] 0
9 :: ?a 1
---
**Operator 3** is called **Depth** because it tests the "depth" of a noun.
**Cell-test** properly refers to the pseudocode function `?`.
##Operator 4: Bump
29 :: *[a 4 b] +*[a b]
**Operator 4** applies the **Increment** function defined in lines 10 and
11 to the product of `*[a b]`.
###Increment: +
`+` (pronounced "lus) adds 1 to an **atom**:
10 :: +[a b] +[a b]
11 :: +a 1 + a
---
**Operator 4** is called **Bump** because it "bumps" the atomic product `*[a b]`
up by 1. **Increment** properly refers to the pseudocode function `+`.
##Operator 5: Same
30 :: *[a 5 b] =*[a b]
**Operator 5** applies the Equals function defined in lines 12, 13 and 14 to the
product of *[a b].
###Equals: =
= (pronounced "tis", or sometimes "is") tests a cell for equality. 0 means yes,
1 means no:
12 :: =[a a] 0
13 :: =[a b] 1
14 :: =a =a
Testing an atom for equality makes no sense and logically fails to terminate.
---
**Operator 5** is called the **Same** operator, because it tests if the head and
tail of the product of `*[a b]` are the same. "Equals" properly refers to the
pseudocode function "=".
##Operator 6: If
32 :: *[a 6 b c d] *[a 2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b]
**Operator 6** is a primitive known to every programmer - **If**. Its operands, a
**test formula** `b`, a **then formula** `c` and an **else formula** `d`.
If the **test** `b` applied to the **subject** evaluates to `0` ("yes"),
*[a b] -> 0
then **If** produces the result of `c`, the **then formula**, applied to
the **subject**,
*[a c]
Else, if applying the **test** to the **subject** produces `1` ("no"),
*[a b] -> 1
**Operator 6** produces the result of `d`, the **else formula**, applied to the
**subject**,
*[a d]
If `*[a b]` produces any value other than `0` ("yes") or `1` ("no"), **If**
crashes.
Let's examine the internals of **Operator 6**:
**If** could have been defined as a built-in pseudocode function, like
**Increment**:
:: $[0 b c] b
:: $[1 b c] c
Then **Operator 6** could have been restated quite compactly:
:: *[a 6 b c d] *[a $[*[a b] c d]]
However, this is unnecessary complexity. **If** can be written as a macro using the
primitive operators:
32 :: *[a 6 b c d] *[a 2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b]
Reducing the right-hand side (an excellent exercise for the reader) produces:
*[a *[[c d] [0 *[[2 3] [0 ++*[a b]]]]]]
Which is the reduced pseudocode form of **Operator 6**.
Additionally, we could simplify the semantics of **If**, at the
expense of breaking the system, by creating a macro that works as
if and only if `*[a b]` produces either `0` or `1`.
This simpler **If** would be:
:: *[a 6 b c d] *[a 2 [0 1] 2 [1 c d] [1 0] [4 4 b]]
which reduces to:
*[a *[[c d] [0 ++*[a b]]]]
Let's examine the internals of this macro with a test example:
*[[40 43] [6 [3 0 1] [4 0 2] [4 0 1]]]
Fitting this to the reduced form:
*[[40 43] *[[4 0 2] [4 0 3]] [0 ++*[[40 43] [3 0 1]]]]]
Our test:
*[[40 43] [3 0 1]]
produces a 0,
*[[40 43] *[[[4 0 2] [4 0 3]] [0 ++0]]]]
which gets incremented twice
*[[40 43] *[[[4 0 2] [4 0 3]] [0 2]]]
and is used as an axis to select the head of [[4 0 2] [4 0 3]]
*[[40 43] [4 0 2]]
which increments `40` to produce `41`. Had the **test** produced a "no" instead of a
"yes", **If** would have incremented the **tail** of the subject instead of the
**head**.
The real **If** is only slightly more complicated:
:: *[a 6 b c d] *[a *[[c d] [0 *[[2 3] [0 ++*[a b]]]]]]
There is an extra step in the real **If** to prevent unexpected behaviour if the
test produces a value other than 0 ("yes") or 1 ("no"). The real **If** will
crash if this happens and the naive **If** may not (the reader will find it a
useful exercise to figure out why).
It's worth noting that practical, compiler-generated Nock never does anything as
funky as these **Operator 6** macro internals.
##Operator 7: Compose
33 :: *[a 7 b c] *[a 2 b 1 c]
**Operator 7** implements function composition. To use a bit of math
notation, if we define the formula `[7 b c]` as a function `d(x)`:
d(a) == c(b(a))
This is apparent from the reduced pseudocode form of **Operator 7**:
*[*[a b] c]
As an example,
*[[42 44] [7 [4 0 3] [3 0 1]]] -> 1
The above sequentially applies the **formulas** `[4 0 3]` and `[3 0 1]`
to our subject `[42 44]`, first incrementing the **head**, then testing
the **depth**.
##Operator 8: Push
34 :: *[a 8 b c] *[a 7 [[7 [0 1] b] 0 1] c]
**Operator 8** pushes a new **noun** onto our **subject**, not at all unlike
pushing a new variable onto the stack.
The internals of **Operator 8** are similar to **Operator 7**, except
that the **subject** for `c` is not simply the **product** of `b`, but the
ordered pair of the **product** of `b` and the original **subject**.
This is apparent from the reduced pseudocode form of **Operator 8**:
*[[*[a b] a] c]
**Operator 8** evaluates the **formula** `c` with the **cell** of `*[a b]` and
the original **subject** `a`. In math notation, if we define `[8 b c]` as
`d(x)`:
d(a) == c([b(a) a])
Suppose, for the purposes of the **formula** `c`, we need not just the
**subject** `a`, but some intermediate **noun** computed from the **subject**
that will be useful in the calculation of `c`. **Operator 8** applies
**formula** `c` to a new **subject** that is the pair of the intermediate value
and the old **subject**.
In higher-level languages that compile to Nock, variable declarations are likely
to generate an **Operator 8**, because the variable is computed against the
present **subject**, and used in a calculation which depends both on the
original **subject** and the new variable.
##Op 9: Call
35 :: *[a 9 b c] *[a 7 c 2 [0 1] 0 b]
##Op 10: Hint
36 :: *[a 10 [b c] d] *[a 8 c 7 [0 3] d]
37 :: *[a 10 b c] *[a c]
##Crash default
39 :: *a *a

36
main/doc/synth/down.hood Normal file
View File

@ -0,0 +1,36 @@
/? 314
!:
:::::: /hoon/down/synth/doc
::
=>
:::::: models
|%
++ down
$& [p=down q=down]
$% [%$ p=tape]
[%code p=tape]
[%inco p=tape]
[%head p=@ud q=down]
[%link p=tape q=tape r=(unit tape)]
[%lord p=(list down)]
[%lund p=(list down)]
[%parg p=down]
[%quot p=down]
[%rong p=down]
[%emph p=down]
[%hrul ~]
[%html p=tape]
==
--
:::::: generator
::
~& [%hood-at %]
%- (fest /synth/doc %)
|= pic=epic
=+ unt=|=(a=cord (biff (~(get by qix.pic) a) |=(b=cord (slaw %ud b))))
=+ moo=(both (unt %foo) (unt %bar))
?~ moo [%$ "Hoop, world: usage: url?foo=x&bar=y"]
:* [%$ "Hoop, "]
[%emph %$ "world"]
[%$ ": {<-.u.moo>} plus {<+.u.moo>} is {<(add u.moo)>}."]
==

7
main/doc/synth/down.hook Normal file
View File

@ -0,0 +1,7 @@
!:
:::::: /hook/down/synth/doc
::
%- (folk /down/synth/doc %)
|= [bem=beam but=path]
:+ %ride [%reef ~]
[%drag bem but]

35
main/doc/synth/down.hoon Normal file
View File

@ -0,0 +1,35 @@
!:
:::::: /hoon/down/synth/doc
::
=>
:::::: models
|%
++ down
$& [p=down q=down]
$% [%$ p=tape]
[%code p=tape]
[%inco p=tape]
[%head p=@ud q=down]
[%link p=tape q=tape r=(unit tape)]
[%lord p=(list down)]
[%lund p=(list down)]
[%parg p=down]
[%quot p=down]
[%rong p=down]
[%emph p=down]
[%hrul ~]
[%html p=tape]
==
--
:::::: generator
::
~& [%choon-at %]
%- (fest /synth/doc %)
|= pic=epic
=+ unt=|=(a=cord (biff (~(get by qix.pic) a) |=(b=cord (slaw %ud b))))
=+ moo=(both (unt %foo) (unt %bar))
?~ moo [%$ "Hm, world: usage: url?foo=x&bar=y"]
:* [%$ "Hm, "]
[%emph %$ "world"]
[%$ ": {<-.u.moo>} plus {<+.u.moo>} is {<(add u.moo)>}."]
==

23
main/lib/chat.hoon
View File

@ -3,12 +3,14 @@
::
|%
++ chat :: user action
$% [%all p=? q=mess] :: broadcast
$% [%all p=room q=? r=mess] :: broadcast
[%def p=mess] :: default
[%how ~] :: help
[%out ~] :: log out
[%say p=@p q=mess] :: private
[%who ~] :: query users
[%who p=?(%tis %ttt %tcc) q=(list room)] :: query users
[%kil p=(list ,@p)] :: kill user(s)
[%res p=(list ,@p)] :: resuscitate(s)
== ::
++ mess :: message
$% [%do p=@t] :: action
@ -20,16 +22,19 @@
[| p=@p] :: private
== ::
++ user ,[p=@p q=@t] :: downstream identity
++ room ,@tas :: room
++ coci %mars :: default room
++ zing :: client to server
$% [%all p=? q=mess] :: broadcast
[%ego p=@da] :: ping / last active
$% [%all p=room q=? r=mess] :: broadcast
[%ego p=room q=@da] :: ping / last active
[%out ~] :: log out
[%who ~] :: query users
[%who p=room q=(unit (list room))] :: query users
== ::
++ zong :: server to client
$% [%all p=sect q=user r=mess] :: broadcast
[%new p=user] :: user joined
[%out p=user] :: user left
[%who p=(list user)] :: users
$% [%all p=@da q=room r=sect s=user t=mess] :: broadcast
[%new p=@da q=room r=user] :: user joined
[%out p=@da q=room r=user] :: user left
[%who p=@da q=room r=(map room (list user))] :: users
== ::
--

187
main/lib/urb.js Normal file
View File

@ -0,0 +1,187 @@
window.urb = {
ship: ship,
port: port,
auto: auto,
oryx: oryx,
user: user,
seqn_h: 0,
seqn_u: 0,
seqn_s: 0,
dely: 0,
puls: 0,
perms: {
pol:"gie",
sub:"tis",
uns:"tiu",
mes:"tim",
heb:"tih"
},
cabs: {},
req: function(method,url,params,json,cb) {
var xhr = new XMLHttpRequest()
xhr.open(method.toUpperCase(), url)
if(json)
xhr.setRequestHeader("content-type", "text/json")
_data = {}
if(params.data) { _data.data = params.data; }
if(params.ship) { _data.ship = params.ship; }
if(params.path) { _data.path = params.path; }
if(params.appl) { _data.appl = params.appl; }
__data = {oryx: oryx, xyro: _data}
xhr.send(JSON.stringify(__data))
if(cb) {
xhr.onload = function() {
cb(null,{
"status":this.status,
"data":JSON.parse(this.responseText)
})
}
xhr.onerror = function() {
cb({
"status":this.status,
"data":this.responseText
})
}
}
},
send: function(params,cb) {
if(!params)
throw new Error("You must supply params to urb.send.")
if(!params.appl)
throw new Error("You must specify an appl for urb.send.")
if(!params.data) { params.data = {}; }
var method, perm, url, $this
type = params.type ? params.type : "mes"
perm = this.perms[type]
params.ship = params.ship ? params.ship : this.ship
method = "put"
url = [perm,this.user,this.port,this.seqn_s]
url = "/"+url.join("/")
this.seqn_s++
$this = this
this.req(method,url,params,true,function(err,data) {
if(err) { $this.seqn_s--; }
if(cb) { cb.apply(this,arguments); }
})
},
subscribe: function(params,cb) {
if(!cb)
throw new Error("You must supply a callback to urb.subscribe.")
if(!params)
throw new Error("You must supply params to urb.subscribe.")
if(!params.appl)
throw new Error("You must specify an appl for urb.subscribe.")
if(!params.path)
throw new Error("You must specify a path for urb.subscribe.")
params.ship = params.ship ? params.ship : this.ship
var method, perm, url, $this
params.type = "sub"
params.incs = function() {
window.urb.seqn_u++
}
this.cabs[params.appl+","+params.path.replace(/[^\x00-\x7F]/g, "")+","+params.ship] = cb
url = [this.perms["sub"],this.user,this.port]
url = "/"+url.join("/")
method = "put"
$this = this
this.req(method,url,params,true,function(err,data) {
if(cb) { cb.call(this,err,{status: data.status, data: data.data.data})}
if(!err && $this.puls == 0) {
params.type = "pol"
$this.poll(params)
}
})
},
unsubscribe: function(params,cb) {
if(!params)
throw new Error("You must supply params to urb.unsubscribe.")
if(!params.appl)
throw new Error("You must specify an appl for urb.unsubscribe.")
if(!params.path)
throw new Error("You must specify a path for urb.unsubscribe.")
params.ship = params.ship ? params.ship : this.ship
method = "put"
type = "uns"
url = [this.perms[type],this.user,this.port]
url = "/"+url.join("/")
var $this = this
this.req(method,url,params,true,function(err,data) {
fn = params.appl+","+params.path.replace(/[^\x00-\x7F]/g, "")+","+params.ship
$this.cabs[fn]('subscription closed')
})
},
heartbeat: function() {
this.poll({
type:"heb",
ship:this.ship,
incs:function() {
window.urb.seqn_h++
}
},function() {
console.log('heartbeat.')
})
},
poll: function(params,cb) {
if(!params)
throw new Error("You must supply params to urb.poll.")
var method, perm, url, $this
method = "get"
type = params.type ? params.type : "pol"
perm = this.perms[type]
url = [perm,this.user,this.port,this.seqn_u]
url = "/"+url.join("/")
this.puls = 1
$this = this
this.req(method,url,params,false,function(err,data) {
console.log(data)
if(cb) {
cb.call(this,err,{status: data.status, data: data.data.data})
} else if (data.data.reload) {
document.location.reload()
} else {
fn = data.data.appl+","+data.data.path.replace(/[^\x00-\x7F]/g, "")
+","+data.data.ship
$this.cabs[fn].call(this,err,
{status: data.status, data: data.data.data})
}
if(err)
$this.dely += 1000
else {
$this.dely = 0
params.incs()
}
setTimeout(function() {
$this.poll(params,cb)
},$this.dely)
})
}
}
auto = false

336
main/pro/down/core.hoon Normal file
View File

@ -0,0 +1,336 @@
::
:::: /hoon/core/down/pro
::
/? 314
/- markdown
=+ markdown
!:
::::
::
|_ don=down
++ grab :: convert from
|%
++ md :: convert from %md
|= src=@t
=< (mark (trip src))
|%
++ mark
|= p=tape
(scan p apex)
::
++ apex :: markdown parser
|= tub=nail
^- (like down)
=+ sep=(sepa tub)
?~ q.sep [p.sep ~]
:- p.sep
%- some :_ [p.sep ~]
(turn p.u.q.sep |=(a=tape (scan a blos)))
::
++ base %+ stag %par
;~ plug
(stag %tex (plus ;~(pose prn eol)))
(easy ~)
==
::
++ blos :: block element
%+ knee *barb |. ~+
;~ pose
head quot lasd horz
code codf html para base
==
::
++ brek (stag %cut (cold ~ ;~(plug fas fas))) :: line break
++ chrd ;~(pose escp prn (cold ' ' eol)) :: shin character data
++ code :: code block
%+ stag %pre
%- full
%- plus
;~ pfix (stun [4 4] ace)
;~ pose
%+ cook welp
;~(plug (plus prn) (cold "\0a" eol))
(full (plus prn))
==
==
::
++ codf :: fenced code block
%+ stag %pre
%- full
%+ ifix
[;~(plug tec tec tec eol) ;~(plug tec tec tec)]
%- plus
;~ pose
%+ cook welp
;~(plug (plus prn) (cold "\0a" eol))
(full (plus ;~(less ;~(plug tec tec tec) prn)))
==
::
++ cods :: code shin
%+ stag %cod
=+ chx=;~(pose (cold ' ' eol) prn)
;~ pose
%+ ifix [(jest '```') (jest '```')]
(plus ;~(less (jest '```') chx))
%+ ifix [(jest '``') (jest '``')]
(plus ;~(less (jest '``') chx))
(ifix [tec tec] (plus ;~(less tec chx)))
==
::
++ dont :: control chars
;~ pose tar tec cab sel
;~(plug sig sig)
;~(plug fas fas)
==
++ spas :: all shin elements
|* res=_rule
%- plus
;~ pose emph stri link
brek cods (text res)
==
::
++ eol (just `@`10) :: newline
++ emph :: emphasis
%+ knee *shin |. ~+
%+ stag %emp
=+ inn=(plus ;~(pose cods stri link (text fail)))
;~ pose
(ifix [(jest '***') (jest '***')] (stag %both inn))
(ifix [(jest '**_') (jest '_**')] (stag %both inn))
(ifix [(jest '*__') (jest '__*')] (stag %both inn))
(ifix [(jest '_**') (jest '**_')] (stag %both inn))
(ifix [(jest '__*') (jest '*__')] (stag %both inn))
(ifix [(jest '___') (jest '___')] (stag %both inn))
(ifix [(jest '**') (jest '**')] (stag %bold inn))
(ifix [(jest '__') (jest '__')] (stag %bold inn))
(ifix [tar tar] (stag %bent inn))
(ifix [cab cab] (stag %bent inn))
==
::
++ escp :: escapable chars
;~ pose
(cold '`' (jest '\\`'))
(cold '*' (jest '\\*'))
(cold '#' (jest '\\#'))
(cold '-' (jest '\\-'))
(cold '.' (jest '\\.'))
(cold '{' (jest '\\{'))
(cold '}' (jest '\\}'))
(cold '[' (jest '\\['))
(cold ']' (jest '\\]'))
(cold '\\' (jest '\\\\'))
==
::
++ head :: header
%+ stag %had
=+ ^= hed
;~ pose
;~ plug
;~(pfix wits (spas hax))
(cook some (ifix [;~(plug (star hax) sel hax) ser] (plus alp)))
==
(ifix [wits (star hax)] ;~(plug (spas hax) (easy ~)))
==
=+ ^= sed
;~ pose
;~ plug
(spas ;~(pose eol sel))
(cook some (ifix [;~(plug sel hax) ser] (plus alp)))
==
;~(plug (spas eol) (easy ~))
==
%- full
;~ pose
;~ pfix (jest '######') (stag 6 hed) ==
;~ pfix (jest '#####') (stag 5 hed) ==
;~ pfix (jest '####') (stag 4 hed) ==
;~ pfix (jest '###') (stag 3 hed) ==
;~ pfix (jest '##') (stag 2 hed) ==
;~ pfix (jest '#') (stag 1 hed) ==
(stag 1 (ifix [wits ;~(plug eol (plus tis))] sed))
(stag 2 (ifix [wits ;~(plug eol (plus hep))] sed))
==
::
++ horz :: horizontal rule
%+ stag %hot
%+ cold ~
%- full
;~ pose
;~(plug (stun [0 3] ace) hep wits hep wits hep (star ;~(pose hep wite)))
;~(plug (stun [0 3] ace) tar wits tar wits tar (star ;~(pose tar wite)))
;~(plug (stun [0 3] ace) cab wits cab wits cab (star ;~(pose cab wite)))
==
::
++ html (stag %hem apex:xmlp) :: html barb
++ lasd :: top level list
%+ stag %lit
%- full
;~ pose
(stag & (lisd ;~(plug (star nud) dot)))
(stag | (lisd hep))
(stag | (lisd tar))
(stag | (lisd lus))
==
::
++ lisd :: list funk
|* bus=_rule
|= tub=nail
^- (like down)
=+ chx=;~(plug (plus prn) (cold "\0a" eol))
=- ?~ q.pre pre
:- p.pre %- some
[(turn `wall`p.u.q.pre |=(a=tape [%lie (scan a apex)])) [p.pre ~]]
^= pre %. tub
%+ most ;~(pose ;~(plug wits eol) (easy ~))
%+ cook |=(a=wall `tape`(zing a)) :: XX core dump w/o cast
;~ plug
%+ cook zing
;~ pose
(full ;~(pfix bus ace ;~(plug (plus prn) (easy ~))))
;~(pfix bus ace ;~(plug (plus prn) (cold "\0a" eol) (easy ~)))
==
%- star
;~ pose
;~(plug ;~(sfix eol ace ace) (cook welp chx))
;~(pfix ace ace (cook welp chx))
(full ;~(pfix ace ace (plus prn)))
==
==
::
++ link :: link element
%+ knee *shin |. ~+
%+ stag %lin
;~ plug
(ifix [sel ser] (plus ;~(pose emph stri cods (text ser))))
;~ pose
%+ ifix [pel per]
;~ plug
;~(sfix (cook zing (most eol (plus ;~(less ace prn)))) ace)
(cook some (ifix [doq doq] (plus ;~(less doq ;~(pose prn eol)))))
==
%+ ifix [pel per]
;~(plug (cook zing (most eol (plus ;~(less per prn)))) (easy ~))
==
==
::
++ para (stag %par (full (spas fail))) :: paragraph
++ quot :: blockquotes
%+ stag %quo
%- full
|= tub=nail
^- (like down)
=- ?~ q.pre
[p.pre ~]
(apex [[1 1] (welp p.u.q.pre q.q.u.q.pre)])
^= pre %. tub
%+ cook |=(a=wall `tape`(zing a))
%- plus
;~ pfix ;~(pose ;~(plug gar ace) gar)
;~ pose
(cook welp ;~(plug (star prn) (cold "\0a" eol)))
(full (star prn))
==
==
::
++ sepa :: separate barbs
%+ knee *wall |. ~+
=+ lin=;~(plug eol wits eol)
%+ ifix [(star whit) (star whit)]
%+ more ;~(plug eol wits (more wits eol))
;~ pose
(sepl (cold "-" hep))
(sepl (cold "*" tar))
(sepl (cold "+" lus))
(sepl (cook welp ;~(plug (star nud) (cold "." dot))))
(plus ;~(less lin ;~(pose prn ;~(simu ;~(plug eol prn) eol))))
==
::
++ sepl :: separate list
|* bus=_rule
%+ cook zing
%+ most ;~(pose ;~(plug wits eol) (easy ~))
%+ cook |=(a=wall `tape`(zing a))
;~ plug
%+ cook |=(a=wall `tape`(zing a))
;~ pose
;~(plug bus (cold " " ace) (plus prn) (cold "\0a" eol) (easy ~))
(full ;~(plug bus (cold " " ace) (plus prn) (easy ~)))
==
%- star
;~ pose
;~ pfix wits
;~ plug eol ace ace
(cook welp ;~(plug (plus prn) (cold "\0a" eol)))
==
==
;~(plug ace ace (cook welp ;~(plug (plus prn) (cold "\0a" eol))))
(full ;~(plug ace ace (plus prn)))
==
==
::
++ stri :: strikethrough text
%+ stag %ike
%+ ifix [(jest '~~') (jest '~~')]
(plus ;~(pose emph cods link (text fail)))
::
++ text |*(res=_rule (stag %tex (plus ;~(less ;~(pose res dont) chrd))))
++ whit (mask ~[`@`0x20 `@`0x9 `@`0xa]) :: whitespace w/nl
++ wite (mask ~[`@`0x20 `@`0x9]) :: whitespace
++ wits (star wite)
--
::
++ noun :: convert from %noun
|= src=*
^+ +>+
+>+(don (down src))
--
::
++ grow :: convert into
|%
++ html :: convert into %heml
=< :(appd '<html><body>' (abet don) '</body></html>')
|%
++ abet
|=(don=down (crip (xmll | (apex don) ~)))
++ appd
|= [p=@ q=@]
^- @
(cat 3 p q)
::
++ apex |=(don=down (turn don |=(bol=barb (blok bol))))
++ blok
|= bol=barb
^- manx
?- bol
[%had *]
:_ (turn q.bol sank)
[(cat 3 'h' (scot %ud p.bol)) ?~(r.bol ~ [[%id u.r.bol] ~])]
[%par *] [[%p ~] (turn p.bol sank)]
[%hot *] [[%hr ~] ~]
[%pre *] [[%pre ~] ~[[[%$ [[%$ (zing p.bol)] ~]] ~]]]
[%quo *] [[%blockquote ~] (apex p.bol)]
[%lie *] [[%li ~] (apex p.bol)]
[%lit *] ?: =(& p.bol) [[%ol ~] (apex q.bol)]
[[%ul ~] (apex q.bol)]
[%hem *] p.bol
==
::
++ sank
|= san=shin
^- manx
?- san
[%tex *] [[%$ [[%$ p.san] ~]] ~]
[%cut *] [[%br ~] ~]
[%ike *] [[%del ~] (turn p.san ..$)]
[%cod *] [[%pre ~] ~[[[%$ [[%$ p.san] ~]] ~]]]
[%emp *]
?: =(%bent p.san) [[%em ~] (turn q.san ..$)]
?: =(%bold p.san) [[%strong ~] (turn q.san ..$)]
[[%em ~] ~[[[%strong ~] (turn q.san ..$)]]]
[%lin *]
?~ r.san [[%a ~[[%href q.san]]] (turn p.san ..$)]
[[%a ~[[%href q.san] [%title u.r.san]]] (turn p.san ..$)]
==
--
--
--

16
main/pro/html/core.hoon Normal file
View File

@ -0,0 +1,16 @@
::
:::: /hoon/core/html/pro
::
/? 314
::
:::: compute
::
|_ htm=@t
::
++ grow :: convert to
|%
++ mime :: convert to %mime
[/text/html (met 3 htm) htm]
--
--

17
main/pro/hymn/core.hoon Normal file
View File

@ -0,0 +1,17 @@
::
:::: /hoon/core/hymn/pro
::
/? 314
::
:::: compute
::
|_ man=manx
::
++ grow :: convert to
|%
++ mime :: convert to %mime
=+ htm=(crip (xmlt | man ~))
[/text/html (taco htm)]
--
--

17
main/pro/json/core.hoon Normal file
View File

@ -0,0 +1,17 @@
::
:::: /hoon/core/hymn/pro
::
/? 314
::
:::: compute
::
|_ jon=json
::
++ grow :: convert to
|%
++ mime :: convert to %mime
=+ htm=(crip (pojo jon))
[/text/html (taco htm)]
--
--

7
main/pro/md/core.hoon Normal file
View File

@ -0,0 +1,7 @@
::
:::: /hoon/core/md/pro
::
/? 314
|_ mud=@t
++ garb [%down ~]
--

15
main/pro/user/core.hoon Normal file
View File

@ -0,0 +1,15 @@
::
:::: /hoon/core/user/pro
::
/? 314
/- user
|_ use=user
::
++ grab :: convert from
|%
++ noun :: convert from %noun
|= src=*
^+ +>+
+>+(use (user src))
--
--

15
main/pro/users/core.hoon Normal file
View File

@ -0,0 +1,15 @@
::
:::: /hoon/core/users/pro
::
/? 314
/- users
|_ use=users
::
++ grab :: convert from
|%
++ noun :: convert from %noun
|= src=*
^+ +>+
+>+(use (users src))
--
--

15
main/pro/zing/core.hoon Normal file
View File

@ -0,0 +1,15 @@
::
:::: /hoon/core/zing/pro
::
/? 314
/- zing
|_ zig=zing
::
++ grab :: convert from
|%
++ noun :: convert from %noun
|= src=*
^+ +>+
+>+(zig (zing src))
--
--

15
main/pro/zong/core.hoon Normal file
View File

@ -0,0 +1,15 @@
::
:::: /hoon/core/zong/pro
::
/? 314
/- zong
|_ zog=zong
::
++ grab :: convert from
|%
++ noun :: convert from %noun
|= src=*
^+ +>+
+>+(zog (zong src))
--
--

47
main/pro/zongs/core.hoon Normal file
View File

@ -0,0 +1,47 @@
::
:::: /hoon/core/zing/pro
::
/? 314
/- zong
|_ zos=(list zong)
::
++ grab :: convert from
|%
++ noun :: convert from %noun
|= src=*
^+ +>+
+>+(zos ((list zong) src))
--
::
++ grow :: convert to
|%
++ hymn :: convert to %hymn
^- manx
;html
;head
;title: Zongs!
==
;body ;table
;* %+ turn zos
|= zog=zong
=. p.zog (lsh 6 1 (rsh 6 1 p.zog)) :: round off subsecond
;tr ;td: {<p.zog>}
;td: {<q.zog>}
;+ ?- -.r.zog
%do
;td: {(trip p.r.zog)}
%say
;td: & {(trip p.r.zog)}
%exp
;td
;code:"{(trip p.r.zog)}"
; \a0 {~(ram re q.r.zog)}
== ==
== ==
== ==
++ html
(crip (xmlt | hymn ~))
++ mime
[/text/html (taco html)]
--
--

1
main/sur/foobar/gate.hoon Normal file
View File

@ -0,0 +1 @@
,@

21
main/sur/markdown/gate.hoon Normal file
View File

@ -0,0 +1,21 @@
|%
++ down (list barb) :: markdown structure
++ barb :: block elements
$% [%had p=@ud q=(list shin) r=(unit tape)] :: depth, contents, id
[%hem p=manx] :: html tag
[%hot ~] :: horizontal rule
[%lie p=down] :: list element
[%lit p=? q=down] :: list
[%par p=(list shin)] :: paragraph
[%pre p=wall] :: preformatted text
[%quo p=down] :: blockquote
== ::
++ shin :: span elements
$% [%cod p=tape] :: inline code
[%cut ~] :: break
[%emp p=?(%bent %bold %both) q=(list shin)] :: emphasis
[%ike p=(list shin)] :: strikethrough
[%lin p=(list shin) q=tape r=(unit tape)] :: link
[%tex p=tape] :: text
== ::
--

3
main/sur/user/gate.hoon Normal file
View File

@ -0,0 +1,3 @@
$% [%in p=[p=@p q=@t]]
[%out q=[p=@p q=@t]]
==

1
main/sur/users/gate.hoon Normal file
View File

@ -0,0 +1 @@
(list ,[p=@p q=@t])

8
main/sur/zing/gate.hoon Normal file
View File

@ -0,0 +1,8 @@
$% [%backlog p=path q=?(%da %dr %ud) r=@]
[%hola p=path]
$: %mess p=path
$= q
$% [%do p=@t]
[%exp p=@t q=tank]
[%say p=@t]
== == ==

6
main/sur/zong/gate.hoon Normal file
View File

@ -0,0 +1,6 @@
$% $: %mess p=@da q=ship
$= r
$% [%do p=@t]
[%exp p=@t q=tank]
[%say p=@t]
== == ==

1
main/sys/asset/ref/gate.hoon Normal file
View File

@ -0,0 +1 @@
,[p=ship q=@uwK]

3
main/sys/asset/tan/json/gate.hoon Normal file
View File

@ -0,0 +1,3 @@
|= [p=ship q=@udK]
^- json
a/~[(jape <p>) (jape <q>)]

22
main/sys/down/ref/gate.hoon Normal file
View File

@ -0,0 +1,22 @@
::
::::::::: /sys/down/ref/gate
::
=< down
|%
++ down
$& [p=down q=down]
$% [%$ p=tape]
[%code p=tape]
[%inco p=tape]
[%head p=@ud q=down]
[%link p=tape q=tape r=(unit tape)]
[%lord p=(list down)]
[%lund p=(list down)]
[%parg p=down]
[%quot p=down]
[%rong p=down]
[%emph p=down]
[%hrul ~]
[%html p=tape]
==
--

75
main/sys/down/tan/html/gate.hoon Normal file
View File

@ -0,0 +1,75 @@
!:
::::::::: /sys/down/tan/html/gate
::
=> |%
++ down
$& [p=down q=down]
$% [%$ p=tape]
[%code p=tape]
[%emph p=down]
[%inco p=tape]
[%head p=@ud q=down]
[%link p=tape q=tape r=(unit tape)]
[%lord p=(list down)]
[%lund p=(list down)]
[%parg p=down]
[%quot p=down]
[%rong p=down]
[%hrul ~]
[%html p=tape]
==
--
=> |%
++ appd
|= [p=@ q=@]
^- @
(cat 3 p q)
::
++ hark
|= a=down
^- @
?- a
[%$ *] (rap 3 p.a)
[%code *] (wtag 'pre' (wtag 'code' (rap 3 p.a)))
[%inco *] (wtag 'code' (rap 3 p.a))
[%head *] (wtag (cat 3 'h' (add '0' p.a)) (hark q.a))
[%link *]
?~ r.a
:(appd '<a ' (sett 'href' q.a) '>' (rap 3 p.a) '</a>')
;: appd
'<a '
(sett 'href' q.a)
' '
(sett 'title' u.r.a)
'>'
(rap 3 p.a)
'</a>'
==
::
[%lord *]
(wtag 'ol' (reel (turn p.a |=(a=down (wtag 'li' (hark a)))) appd))
::
[%lund *]
(wtag 'ul' (reel (turn p.a |=(a=down (wtag 'li' (hark a)))) appd))
::
[%parg *] (wtag 'p' (hark p.a))
[%quot *] (wtag 'blockquote' (hark p.a))
[%rong *] (wtag 'strong' (hark p.a))
[%emph *] (wtag 'em' (hark p.a))
[%hrul *] '<hr>'
[%html *] (rap 3 p.a)
^ (cat 3 (hark p.a) (hark q.a))
==
::
++ wtag
|= [a=@ b=@]
^- @
:(appd '<' a '>' b '</' a '>')
::
++ sett
|= [a=@ b=tape]
^- @
:(appd a '="' (rap 3 b) '"')
--
|= a=down
:(appd '<html><body>' (hark a) '</body></html>')

1
main/sys/hoon/ref/gate.hoon Normal file
View File

@ -0,0 +1 @@
,@

1
main/sys/html/ref/gate.hoon Normal file
View File

@ -0,0 +1 @@
,@

4
main/sys/html/tan/mime/gate.hoon Normal file
View File

@ -0,0 +1,4 @@
!:
|= htm=@
[/text/html (met 3 htm) htm]

1
main/sys/hymn/ref/gate.hoon Normal file
View File

@ -0,0 +1 @@
manx

3
main/sys/hymn/tan/html/gate.hoon Normal file
View File

@ -0,0 +1,3 @@
!:
|= man=manx
(crip (xmlt | man ~))

3
main/sys/hymn/tan/mime/gate.hoon Normal file
View File

@ -0,0 +1,3 @@
|= man=manx
=+ htm=(crip (xmlt | man ~))
[/text/html (met 3 htm) htm]

1
main/sys/json/ref/gate.hoon Normal file
View File

@ -0,0 +1 @@
json

3
main/sys/json/tan/mime/gate.hoon Normal file
View File

@ -0,0 +1,3 @@
|= jon=json
=+ txt=(crip (pojo jon))
[/text/json (met 3 txt) txt]

1
main/sys/md/ref/gate.hoon Normal file
View File

@ -0,0 +1 @@
,@

4
main/sys/md/tan/down/gate.hoon Normal file
View File

@ -0,0 +1,4 @@
!:
::::::::: /sys/md/tan/down/gate
::
=>

4
main/sys/user/ref/gate.hoon Normal file
View File

@ -0,0 +1,4 @@
$% [%in p=[p=@p q=@t]]
[%out q=[p=@p q=@t]]
==

1
main/sys/users/ref/gate.hoon Normal file
View File

@ -0,0 +1 @@
(list ,[p=@p q=@t])

14
main/sys/zing/ref/gate.hoon Normal file
View File

@ -0,0 +1,14 @@
=< zing
|%
++ mess :: message
$% [%do p=@t] :: act
[%exp p=@t q=tank] :: code
[%say p=@t] :: speak
==
++ zing
$% [%backlog p=path q=?(%da %dr %ud) r=@]
[%hola p=path]
[%mess p=path q=mess]
==
--

23
main/sys/zing/tan/hymn/gate.hoon Normal file
View File

@ -0,0 +1,23 @@
=> |%
++ mess :: message
$% [%do p=@t] :: act
[%exp p=@t q=tank] :: code
[%say p=@t] :: speak
==
++ zing
$% [%backlog p=path q=?(%da %dr %ud) r=@]
[%hola p=path]
[%mess p=path q=mess]
==
--
|= zig=zing
^- manx
;html
;head
;title: Zing!
==
;body
;p: {<zig>}
==
==

12
main/sys/zong/ref/gate.hoon Normal file
View File

@ -0,0 +1,12 @@
=< zong
|%
++ mess :: message
$% [%do p=@t] :: act
[%exp p=@t q=tank] :: code
[%say p=@t] :: speak
==
++ zong
$% [%mess p=@da q=ship r=mess]
==
--

21
main/sys/zong/tan/hymn/gate.hoon Normal file
View File

@ -0,0 +1,21 @@
=> |%
++ mess :: message
$% [%do p=@t] :: act
[%exp p=@t q=tank] :: code
[%say p=@t] :: speak
==
++ zong
$% [%mess p=@da q=ship r=mess]
==
--
|= zog=zong
^- manx
;html
;head
;title: Zong!
==
;body
;p: {<zog>}
==
==

13
main/sys/zongs/ref/gate.hoon Normal file
View File

@ -0,0 +1,13 @@
!:
=< (list zong)
|%
++ mess :: message
$% [%do p=@t] :: act
[%exp p=@t q=tank] :: code
[%say p=@t] :: speak
==
++ zong
$% [%mess p=@da q=ship r=mess]
==
--

29
main/sys/zongs/tan/hymn/gate.hoon Normal file
View File

@ -0,0 +1,29 @@
=> |%
++ mess :: message
$% [%do p=@t] :: act
[%exp p=@t q=tank] :: code
[%say p=@t] :: speak
==
++ zong
$% [%mess p=@da q=ship r=mess]
==
--
|= zos=(list zong)
^- manx
;html
;head
;title: Zongs!
==
;body
;table
;* %+ turn zos
|= zog=zong
;tr
;td:"{<p.zog>}"
;td:"{<q.zog>}"
;td:"{<r.zog>}"
==
==
==
==

14
main/sys/zongs/tan/json/gate.hoon Normal file
View File

@ -0,0 +1,14 @@
=> |%
++ mess :: message
$% [%do p=@t] :: act
[%exp p=@t q=tank] :: code
[%say p=@t] :: speak
==
++ zong
$% [%mess p=@da q=ship r=mess]
==
--
|= zos=(list zong)
^- json
[%s (crip <zos>)]

17
try/bin/app.hoon
View File

@ -10,8 +10,19 @@
==
|= *
|= ~
^- bowl
^- bowl
:_ ~ :_ ~
:- %$
!>
[word "world"]
!> :_ %- turn :_ trip %- lore %- crip
"""
This quote don't need no extra ws
But further indents are preserved
and {<%inter %polation>} is possible
Yay.
"""
%- lore
'''
Ph'nglui mglw'nafh \ ::no comments etc.
Heredoc R'lyeh wgah'nahgl fhtagn
'''

103
try/bin/bootque.hoon Normal file
View File

@ -0,0 +1,103 @@
!:
:: /=main=/bin/app/hoon
::
=> %= .
+
=> +
=> ^/===/bin/pque
|%
:: efficient priority queue
:: possibly empty
++ pque |* [a=_,* b=_,*]
(unit (rque a b))
:: internal - nonempty pque
++ rque |* [a=_,* b=_,*]
$: k=a
n=b
q=(bque a (rque a b))
==
:: maximally optimal priority queue
:: O(1) insert, meld, peek
:: O(log n) pop
::
:: lte -> min priority queue
:: gte -> max priority queue
::
:: bootstrapped off of ++pr
::
:: to create, use something like
:: ~zod/try=> ((qu ,@ ,@) lte)
::
:: example operations
::
:: =+ pri=((qu ,@ ,@) lte)
:: =+ q=~
:: =. q (insert.pri q 3 2)
:: =^ r q (pop.pri q)
++ qu !:
|* [key=$+(* *) val=$+(* *)]
|= cmp=$+([key key] ?)
=+ bt=((pr key (rque key val)) cmp)
|%
++ insert
|= [q=(pque key val) k=key n=val]
^- (pque key val)
(meld [~ [k=k n=n q=~]] q)
++ meld
|= [q=(pque key val) p=(pque key val)]
^- (pque key val)
?~ p q
?~ q p
?: (cmp k.u.p k.u.q)
[~ [k=k.u.p n=n.u.p q=(insert.bt q.u.p [k=k.u.q n=[k.u.q n=n.u.q q=q.u.q]])]]
[~ [k=k.u.q n=n.u.q q=(insert.bt q.u.q [k=k.u.p n=[k=k.u.p n=n.u.p q=q.u.p]])]]
:: errors on empty pque, sigcheck first
++ peek
|= q=(pque key val)
^- [k=key n=val]
?~ q ~|(%empty-pque-peek !!)
[k=k.u.q n=n.u.q]
:: errors on empty pque, sigcheck first
++ pop
|= q=(pque key val)
^- [r=[k=key n=val] q=(pque key val)]
?~ q ~|(%empty-pque-pop !!)
?~ q.u.q
[r=(peek q) q=~] :: queue is now empty
=+ s=(pop.bt q.u.q) :: [r=[k=key n=rque] q=bque]
~! s
[r=(peek q) q=[~ [k=k.r.s n=n.n.r.s q=(meld.bt q.n.r.s q.s)]]]
--
--
==
|= *
|= ~
^- bowl
:_ ~ :_ ~
:- %$
!>
=+ pri=((qu ,@ ,@) lte)
=+ pq=(insert.pri ~ 6 302)
=. pq (insert.pri pq 5 3.897)
=. pq (insert.pri pq 2 1)
=+ pq2=(insert.pri ~ 508 542)
=. pq2 (insert.pri pq2 42 89)
=. pq2 (insert.pri pq2 325 325)
=. pq2 (insert.pri pq2 41 37)
=. pq (meld.pri pq pq2)
~& pq
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
pq

38
try/bin/flopp.hoon Normal file
View File

@ -0,0 +1,38 @@
!:
:: /=main=/bin/app/hoon
::
=> %= .
+
=> +
|%
++ sii !:
=| *
|%
+- $
?~ +<
+<
$(+< +<+)
--
++ flopp
=| *
=| *
|%
+- $
?~ +<
?~ +>- ~
+>-
?~ +>-
$(+< +<+, +>- [+<- +<+(. ~)])
$(+< +<+, +>- [+<- +<+(. +>-)])
--
--
==
|= *
|= ~
^- bowl
:_ ~ :_ ~
:- %$
!>
=+ x=[i=1 t=[i=2 t=[i=3 t=[i=4 t=~]]]]
=+ y=(limo [1 2 3 4 ~])
(flopp x)

27
try/bin/fptest.hoon Normal file
View File

@ -0,0 +1,27 @@
::
:: /=try=/bin/aestest/hoon
::
|= [est=time eny=@uw]
|= ~
:_ ~ :_ ~
=+ i=0
:- %$
!>
|- ^- @
?: =(1.000.000 i) 0
=+ n=`@rd`(end 6 1 (en:aesc eny i))
=+ m=`@rd`(rsh 6 1 (en:aesc +(eny) i))
:: ~& [%try `@ux`n `@ux`m]
~| $(i +(i))
=+ a=(add:rd n m)
=+ b=(sub:rd n m)
=+ c=(mul:rd n m)
=+ d=(div:rd n m)
=+ suc=%.y
?. suc
~| [%fail i `@ux`n `@ux`m]
!!
?: &(!=(0 i) =(0 (mod i 2)))
~& [%try i `@ux`n `@ux`m]
$(i +(i))
$(i +(i))

2
try/bin/honk.hoon
View File

@ -4,4 +4,4 @@
:- %$ ::
!> != ::
::::::::::::::::: Replace this with your code
|=(b=@ |=(c=@ [b c]]))
|=(b=@ |=(c=@ [b c]))

269
try/bin/klay.hoon Normal file
View File

@ -0,0 +1,269 @@
!:
:: /=main=/bin/app/hoon
::
=> %= .
+
=> +
|%
++ blob $% [%delta q=blob r=udon]
[%direct q=* r=umph]
[%indirect q=* r=udon]
==
++ yaki ,[p=(list yaki) q=(map path blob) r=@ t=@ud] :: later t=@da
::
:: database helpers
::
++ hash-blob
|= p=*
^- blob
[%direct p %c]
++ hash-yaki
|= [p=(list yaki) q=(map path blob) t=@ud] :: later t=@da
^- yaki
[p q (mug [(roll (turn p |=(p=yaki r.p)) add) q t]) t] :: later quicksort?
++ grab
|= p=blob
?- -.p
%delta (lump r.p $(p q.p))
%direct q.p
%indirect q.p
==
++ prep
|= p=blob
^- umph
?- -.p
%delta p.r.p
%direct r.p
%indirect p.r.p
==
::
:: utils
::
++ lath
|= [p=(map path ,*) s=(set path)]
^- (set path)
%+ roll (~(tap by p) ~)
|= [[p=path *] q=_s]
%. p %~ put in q
::
++ luth
|= [p=(map path ,*) q=(map path ,*)]
^- (list path)
%. ~
%~ tap in
%+ lath p
%+ lath q
_(set path)
::
:: graph logic
::
++ zule :: reachable
|= p=yaki :: pretty much a |=
^- (set yaki)
=+ t=(~(put in _(set yaki)) p)
%+ roll p.p
|= [q=yaki s=_t]
?: (~(has in s) q) :: already done
s :: hence skip
(~(uni by s) ^$(p q)) :: otherwise traverse
::
++ zeal :: merge points
|= [p=yaki q=yaki]
=+ r=(zule p)
|- ^- (set yaki)
?: (~(has in r) q) (~(put in _(set yaki)) q) :: done
%+ roll p.q
|= [t=yaki s=(set yaki)]
?: (~(has in r) t)
(~(put in s) t) :: found
(~(uni in s) ^$(q t)) :: traverse
::
:: diff logic
::
++ zerg
|= [p=yaki q=yaki]
^- (map path miso)
%+ roll (luth q.p q.q)
|= [pat=path yeb=(map path miso)]
=+ leb=(~(get by q.p) pat)
=+ lob=(~(get by q.q) pat)
?~ leb (~(put by yeb) pat [%ins (grab (need lob))])
?~ lob (~(put by yeb) pat [%del (grab (need leb))])
=+ zeq=(grab u.leb)
=+ zoq=(grab u.lob)
?: =(zeq zoq)
yeb
%+ ~(put by yeb) pat
:- %mut
((diff (prep u.leb)) zeq zoq)
::
:: merge logic
::
++ qael :: clean
|= wig=(urge)
^- (urge)
?~ wig ~
?~ t.wig wig
?: ?=(%& -.i.wig)
?: ?=(%& -.i.t.wig)
$(wig [[%& (add p.i.wig p.i.t.wig)] t.t.wig])
[i.wig $(wig t.wig)]
[i.wig $(wig t.wig)]
::
++ qaul :: check no delete
|= wig=(urge)
^- ?
?~ wig %.y
?- -.i.wig
%& %.n
%| ?: =(p.i.wig 0)
$(wig t.wig)
%.n
==
::
++ qeal :: merge p,q
|= [p=miso q=miso]
^- miso
~| %qeal-fail
?> ?=(%mut -.p)
?> ?=(%mut -.q)
?> ?=(%c -.q.p.p)
?> ?=(%c -.q.p.q)
=+ s=(qael p.q.p.p)
=+ t=(qael p.q.p.q)
:- %mut
:- %c :: todo is this p.p.p?
:- %c
|- ^- (urge)
::?~ s ?: (qual t) t
:: ~| %qail-conflict !!
::?~ t ?: (qual s) s
:: ~| %qail-conflict !!
?~ s t
?~ t s
?- -.i.s
%&
?- -.i.t
%&
?: =(p.i.s p.i.t)
[i.s $(s t.s, t t.t)]
?: (gth p.i.s p.i.t)
[i.t $(t t.t, p.i.s (sub p.i.s p.i.t))]
[i.s $(s t.s, p.i.t (sub p.i.t p.i.s))]
%|
?: =(i.s (lent p.i.t))
[i.t $(s t.s, t t.t)]
?: (gth p.i.s (lent p.i.t))
[i.t $(t t.t, p.i.s (sub p.i.s (lent p.i.t)))]
~| %quil-conflict !!
==
%|
?> ?=(%& -.i.t)
?: =(i.t (lent p.i.s))
[i.s $(s t.s, t t.t)]
?: (gth p.i.t (lent p.i.s))
[i.s $(s t.s, p.i.t (sub p.i.t (lent p.i.s)))]
~| %quil-conflict !!
==
++ quil :: merge p,q
|= [p=(unit miso) q=(unit miso)]
^- (unit miso)
?~ p q :: trivial
?~ q p :: trivial
?. ?=(%mut -.u.p)
~| %quil-conflict !!
?. ?=(%mut -.u.q)
~| %quil-conflict !!
%- some
%+ qeal u.p :: merge p,q'
u.q
::
++ meld :: merge p,q from r
|= [p=yaki q=yaki r=yaki]
^- (map path blob)
=+ s=(zerg r p)
=+ t=(zerg r q)
~& [%diff-s s]
~& [%diff-t t]
%+ roll (luth s t)
|= [pat=path res=(map path blob)]
=+ ^= v
%- need
%+ quil
(~(get by s) pat)
(~(get by t) pat)
?- -.v
%del res :: no longer exists
%ins :: new file
%+ ~(put by res) pat
%- hash-blob
p.v
%mut :: patch from r
~& [%patch p.v [%orig (~(get by q.r) pat)]]
%+ ~(put by res) pat
%- hash-blob
%+ lump p.v
%- grab
%- need
%- ~(get by q.r) pat
==
::
:: merge types
::
++ mate :: merge p,q
|= [p=yaki q=yaki] :: %mate/%meld
^- (map path blob)
=+ r=(~(tap in (zeal p q)) ~)
?~ r
~|(%mate-no-ancestor !!)
?: =(1 (lent r))
(meld p q i.r)
~|(%mate-criss-cross !!)
::
++ keep :: %this
|= [p=yaki q=yaki]
^- (map path blob)
q.p
++ drop :: %that
|= [p=yaki q=yaki]
^- (map path blob)
q.q
++ forge :: %forge
|= [p=yaki q=yaki]
^- (map path blob)
=+ r=(~(tap in (zeal p q)) ~)
?~ r
~|(%forge-no-ancestor !!)
%^ meld p q
%+ roll t.r :: fake ancestor
|= [par=yaki for=_i.r]
(hash-yaki [par for ~] (forge par for) 0) :: fake yaki
::
:: actual merge
::
++ merge
|= [p=yaki q=yaki r=@ud s=$+([yaki yaki] (map path blob))]
^- yaki
(hash-yaki [p q ~] (s p q) r)
::
--
==
|= *
|= ~
^- bowl
:_ ~ :_ ~
:- %$
!>
=| b=(map path blob)
=+ n1=(hash-yaki ~ (~(put by b) ~['test'] (hash-blob 'hi\0ahello\0a')) 1)
=+ n2=(hash-yaki [n1 ~] (~(put by b) ~['test'] (hash-blob 'hi\0ahello\0abye\0a')) 2)
=+ n3=(hash-yaki [n1 ~] (~(put by b) ~['test'] (hash-blob 'help\0ahi\0ahello\0a')) 3)
=+ n4=(hash-yaki [n1 ~] b 4)
=+ n5=(hash-yaki [n3 n4 ~] b 5) :: merge n3/n4
=+ n6=(hash-yaki [n5 ~] b 6)
=+ n7=(hash-yaki [n3 ~] b 7)
::(zeal n6 n7)
::(zerg n1 n2)
::(mate n2 n3)
:- [%result ((hard ,@t) (grab (need (~(get by q:(merge n3 n2 8 mate)) ~['test'])))) (merge n2 n3 9 forge)]
[%result ((hard ,@t) (grab (need (~(get by q:(merge n3 n2 8 mate)) ~['test'])))) (merge n3 n2 9 forge)]

344
try/bin/markdown.hoon Normal file
View File

@ -0,0 +1,344 @@
!:
:: /=main=/bin/app/hoon
::
=> %= .
+
=> +
|%
:::: markdown parser
::
++ down (list bloc) :: markdown model
++ bloc :: block elements
$% [%head p=@ud q=(list span) r=(unit tape)]
[%para p=(list span)]
[%lise p=down]
[%list p=? q=down]
[%quot p=down]
[%horz ~]
[%code p=wall]
[%html p=manx]
==
::
++ span :: span elements
$% [%text p=tape]
[%emph p=term q=(list span)]
[%stri p=(list span)]
[%brek ~]
[%link p=(list span) q=tape r=(unit tape)]
[%cods p=tape]
==
::
++ apex :: markdown parser
|= tub=nail
^- (like down)
=+ sep=(sepa tub)
?~ q.sep [p.sep ~]
[p.sep (some [(turn p.u.q.sep |=(a=tape (scan a blos))) [p.sep ~]])]
::
++ base (stag %para ;~(plug (stag %text (plus ;~(pose prn eol))) (easy ~)))
++ blos :: block element
(knee *bloc |.(~+(;~(pose head quot lasd horz code codf html para base))))
::
++ brek (stag %brek (cold ~ ;~(plug fas fas))) :: line break
++ chrd ;~(pose escp prn (cold ' ' eol)) :: span character data
++ code :: code block
%+ stag %code
%- full
%- plus
;~ pfix (stun [4 4] ace)
;~(pose (cook welp ;~(plug (plus prn) (cold "\0a" eol))) (full (plus prn)))
==
::
++ codf :: fenced code block
%+ stag %code
%- full
%+ ifix [;~(plug tec tec tec eol) ;~(plug tec tec tec)]
%- plus
;~ pose
(cook welp ;~(plug (plus prn) (cold "\0a" eol)))
(full (plus ;~(less ;~(plug tec tec tec) prn)))
==
::
++ cods :: code span
%+ stag %cods
=+ chx=;~(pose (cold ' ' eol) prn)
;~ pose
%+ ifix [(jest '```') (jest '```')] (plus ;~(less (jest '```') chx))
%+ ifix [(jest '``') (jest '``')] (plus ;~(less (jest '``') chx))
%+ ifix [tec tec] (plus ;~(less tec chx))
==
::
++ dont ;~(pose tar tec cab ;~(plug sig sig) ;~(plug fas fas) sel)
++ spas :: all span elements
|* res=_rule
(plus ;~(pose emph stri link brek cods (text res)))
::
++ eol (just `@`10) :: newline
++ emph :: emphasis
%+ knee *span |. ~+
%+ stag %emph
=+ inn=(plus ;~(pose cods stri link (text fail)))
;~ pose
(ifix [(jest '***') (jest '***')] (stag %both inn))
(ifix [(jest '**_') (jest '_**')] (stag %both inn))
(ifix [(jest '*__') (jest '__*')] (stag %both inn))
(ifix [(jest '_**') (jest '**_')] (stag %both inn))
(ifix [(jest '__*') (jest '*__')] (stag %both inn))
(ifix [(jest '___') (jest '___')] (stag %both inn))
(ifix [(jest '**') (jest '**')] (stag %bold inn))
(ifix [(jest '__') (jest '__')] (stag %bold inn))
(ifix [tar tar] (stag %ital inn))
(ifix [cab cab] (stag %ital inn))
==
::
++ escp :: escapable chars
;~ pose
(cold '`' (jest '\\`'))
(cold '*' (jest '\\*'))
(cold '#' (jest '\\#'))
(cold '-' (jest '\\-'))
(cold '.' (jest '\\.'))
(cold '{' (jest '\\{'))
(cold '}' (jest '\\}'))
(cold '[' (jest '\\['))
(cold ']' (jest '\\]'))
(cold '\\' (jest '\\\\'))
==
::
++ head :: header
%+ stag %head
=+ ^= hed
;~ pose
;~ plug
;~(pfix wits (spas hax))
(cook some (ifix [;~(plug (star hax) sel hax) ser] (plus alp)))
==
(ifix [wits (star hax)] ;~(plug (spas hax) (easy ~)))
==
=+ ^= sed
;~ pose
;~ plug
(spas ;~(pose eol sel))
(cook some (ifix [;~(plug sel hax) ser] (plus alp)))
==
;~(plug (spas eol) (easy ~))
==
%- full
;~ pose
;~ pfix (jest '######') (stag 6 hed) ==
;~ pfix (jest '#####') (stag 5 hed) ==
;~ pfix (jest '####') (stag 4 hed) ==
;~ pfix (jest '###') (stag 3 hed) ==
;~ pfix (jest '##') (stag 2 hed) ==
;~ pfix (jest '#') (stag 1 hed) ==
(stag 1 (ifix [wits ;~(plug eol (plus tis))] sed))
(stag 2 (ifix [wits ;~(plug eol (plus hep))] sed))
==
::
++ horz :: horizontal rule
%+ stag %horz
%+ cold ~
%- full
;~ pose
;~(plug (stun [0 3] ace) hep wits hep wits hep (star ;~(pose hep wite)))
;~(plug (stun [0 3] ace) tar wits tar wits tar (star ;~(pose tar wite)))
;~(plug (stun [0 3] ace) cab wits cab wits cab (star ;~(pose cab wite)))
==
::
++ html (stag %html apex:xmlp) :: html bloc
++ lasd :: top level list
%+ stag %list
%- full
;~ pose
(stag & (lisd ;~(plug (star nud) dot)))
(stag | (lisd hep))
(stag | (lisd tar))
(stag | (lisd lus))
==
::
++ lisd :: list funk
|* bus=_rule
|= tub=nail
^- (like down)
=+ chx=;~(plug (plus prn) (cold "\0a" eol))
=- ?~ q.pre
pre
:- p.pre
(some (turn `wall`p.u.q.pre |=(a=tape [%lise (scan a apex)])) [p.pre ~])
^= pre %. tub
%+ most ;~(pose ;~(plug wits eol) (easy ~))
%+ cook |=(a=wall `tape`(zing a)) ::XX core dumps w/o cast
;~ plug
%+ cook zing
;~ pose
(full ;~(pfix bus ace ;~(plug (plus prn) (easy ~))))
;~(pfix bus ace ;~(plug (plus prn) (cold "\0a" eol) (easy ~)))
==
%- star
;~ pose
;~(plug ;~(sfix eol ace ace) (cook welp chx))
;~(pfix ace ace (cook welp chx))
(full ;~(pfix ace ace (plus prn)))
==
==
::
++ link :: link element
%+ knee *span |. ~+
%+ stag %link
;~ plug
(ifix [sel ser] (plus ;~(pose emph stri cods (text ser))))
;~ pose
%+ ifix [pel per]
;~ plug
;~(sfix (cook zing (most eol (plus ;~(less ace prn)))) ace)
(cook some (ifix [doq doq] (plus ;~(less doq ;~(pose prn eol)))))
==
%+ ifix [pel per]
;~(plug (cook zing (most eol (plus ;~(less per prn)))) (easy ~))
==
==
::
++ para (stag %para (full (spas fail))) :: paragraph
++ quot :: blockquotes
%+ stag %quot
%- full
|= tub=nail
^- (like down)
=- ?~ q.pre
[p.pre ~]
(apex [[1 1] (welp p.u.q.pre q.q.u.q.pre)])
^= pre %. tub
%+ cook |=(a=wall `tape`(zing a))
%- plus
;~ pfix ;~(pose ;~(plug gar ace) gar)
;~(pose (cook welp ;~(plug (star prn) (cold "\0a" eol))) (full (star prn)))
==
::
++ sepa :: separate blocs
%+ knee *wall |. ~+
=+ lin=;~(plug eol wits eol)
%+ ifix [(star whit) (star whit)]
%+ more ;~(plug eol wits (more wits eol))
;~ pose
(sepl (cold "-" hep))
(sepl (cold "*" tar))
(sepl (cold "+" lus))
(sepl (cook welp ;~(plug (star nud) (cold "." dot))))
(plus ;~(less lin ;~(pose prn ;~(simu ;~(plug eol prn) eol))))
==
::
++ sepl :: separate list
|* bus=_rule
%+ cook zing
%+ most ;~(pose ;~(plug wits eol) (easy ~))
%+ cook |=(a=wall `tape`(zing a))
;~ plug
%+ cook |=(a=wall `tape`(zing a))
;~ pose
;~(plug bus (cold " " ace) (plus prn) (cold "\0a" eol) (easy ~))
(full ;~(plug bus (cold " " ace) (plus prn) (easy ~)))
==
%- star
;~ pose
;~ pfix wits
;~(plug eol ace ace (cook welp ;~(plug (plus prn) (cold "\0a" eol))))
==
;~(plug ace ace (cook welp ;~(plug (plus prn) (cold "\0a" eol))))
(full ;~(plug ace ace (plus prn)))
==
==
::
++ stri :: strikethrough text
%+ stag %stri
(ifix [(jest '~~') (jest '~~')] (plus ;~(pose emph cods link (text fail))))
::
++ text |*(res=_rule (stag %text (plus ;~(less ;~(pose res dont) chrd))))
++ whit (mask ~[`@`0x20 `@`0x9 `@`0xa]) :: whitespace w/nl
++ wite (mask ~[`@`0x20 `@`0x9]) :: whitespace
++ wits (star wite)
::
:::::: down to manx
++ dank
|%
++ apex
|= don=down
^- marl
(turn don |=(bol=bloc (blok bol)))
++ blok
|= bol=bloc
^- manx
?- bol
[%head *]
:_ (turn q.bol sank)
[(cat 3 'h' (scot %ud p.bol)) ?~(r.bol ~ [[%id u.r.bol] ~])]
[%para *] [[%p ~] (turn p.bol sank)]
[%horz *] [[%hr ~] ~]
[%code *] [[%pre ~] ~[[[%$ [[%$ (zing p.bol)] ~]] ~]]]
[%quot *] [[%blockquote ~] (apex p.bol)]
[%lise *] [[%li ~] (apex p.bol)]
[%list *] ?: =(& p.bol) [[%ol ~] (apex q.bol)]
[[%ul ~] (apex q.bol)]
[%html *] p.bol
==
++ sank
|= san=span
^- manx
?- san
[%text *] [[%$ [[%$ p.san] ~]] ~]
[%brek *] [[%br ~] ~]
[%stri *] [[%del ~] (turn p.san ..$)]
[%cods *] [[%code ~] ~[[[%$ [[%$ p.san] ~]] ~]]]
[%emph *]
?: =(%ital p.san) [[%em ~] (turn q.san ..$)]
?: =(%bold p.san) [[%strong ~] (turn q.san ..$)]
[[%em ~] ~[[[%strong ~] (turn q.san ..$)]]]
[%link *]
?~ r.san [[%a ~[[%href q.san]]] (turn p.san ..$)]
[[%a ~[[%href q.san] [%title u.r.san]]] (turn p.san ..$)]
==
--
::
++ samp
"""
An h1 header
============
Paragraphs are separated by a blank line.
2nd paragraph. *Italic*, **bold**, ***both*** and `monospace`.
Hard line//break
Links: [link](foo.com "title")
Strikethrough text: ~~foo~~
> Block quotes are
> written like so.
>
> They can span multiple paragraphs,
> if you like.
Itemized lists
look like:
* this one
* that one
* the other one
---
"""
--
==
|= *
|= ~
^- bowl
:_ ~ :_ ~
:- %$
!>
(xmll | (apex:dank (scan samp apex)) ~)

34
try/bin/merge.hoon Normal file
View File

@ -0,0 +1,34 @@
!:
:: /=try=/bin/merge/hoon
:: Call with two desks and an optional germ as a merge option
::
=> .(-< `who=@p`-<)
|= [est=time eny=@uw]
|= $: pes=[ses=span des=span cas=span ~]
pen=[sen=span den=span can=span ~]
gem=$|([germ ~] ~)
==
^- bowl
:_ ~
^- (list gift)
:_ ~
=+ vsr=((hard dome) .^(%cv pes))
=+ ves=((hard dome) .^(%cv pen))
=+ ^= sab ^- saba :*
(need (slaw 'p' ses.pes))
des.pes
[0 let.vsr]
(flop (turn hit.vsr |=(a=frog q.a)))
ang.vsr
==
=+ ^= lum
%- ~(auld ze est ves)
[?~(gem %fine -.gem) (need (slaw 'p' sen.pen)) den.pen sab]
?~ lum
^- gift
:* %la %leaf
"{(trip des.pes)} failed to apply, please rerun with a merge option"
==
?~ u.lum
`gift`[%la %leaf "{(trip den.pen)} is up to date"]
`gift`[%ok den.pen u.u.lum]

148
try/bin/pque.hoon Normal file
View File

@ -0,0 +1,148 @@
!:
:: /=main=/bin/app/hoon
::
=> %= .
+
=> +
!:
|%
++ bqno |* [a=_,* b=_,*] :: binary skew queno
$: r=@u :: rank/depth
k=a :: priority
n=b :: value
c=(bque a b) :: children
== ::
++ bque |* [a=_,* b=_,*] :: binary skew que
(list (bqno a b)) ::
++ pr !: :: priority queue
|* [key=$+(* *) val=$+(* *)]
|= cmp=$+([key key] ?) :: lte=min, gte=max
|%
++ link
|= [p=(bqno key val) q=(bqno key val)] :: link eq rank
^- (bqno key val)
?> =(r.p r.q)
?: (cmp k.p k.q)
[r=+(r.p) k=k.p n=n.p c=[i=q t=c.p]]
[r=+(r.q) k=k.q n=n.q c=[i=p t=c.q]]
++ slink :: skew link
|= [p=(bqno key val) q=(bqno key val) r=(bqno key val)]
^- (bqno key val)
~! p
~! q
~! r
?: &((cmp k.q k.p) (cmp k.q k.r))
[r=+(r.q) k=k.q n=n.q c=[i=p t=[i=r t=c.q]]]
?: &((cmp k.r k.p) (cmp k.r k.q))
[r=+(r.r) k=k.r n=n.r c=[i=p t=[i=q t=c.r]]]
[r=+(r.q) k=k.p n=n.p c=[i=q t=[i=r t=~]]]
++ ins :: internal ins op
|= [p=(bqno key val) q=(bque key val)]
^- (bque key val)
?~ q [p ~]
?> (lte r.p r.i.q)
?: (lth r.p r.i.q)
[i=p t=q]
$(p (link p i.q), q t.q)
++ uniq :: remove init dup
|= q=(bque key val)
?~ q ~
(ins i.q t.q)
++ meuq :: unique meld
|= [p=(bque key val) q=(bque key val)]
^- (bque key val)
?~ p q
?~ q p
?: (lth r.i.p r.i.q)
[i.p $(p t.p)]
?: (lth r.i.q r.i.p)
[i.q $(q t.q)]
(ins (link i.p i.q) $(p t.p, q t.q))
++ gmi :: getmin
|= q=(bque key val)
^- [i=(bqno key val) t=(bque key val)]
?~ q ~|(%fatal-gmi-empty !!)
?~ t.q [i=i.q t=~]
=+ r=$(q t.q)
?: (cmp k.i.q k.i.r)
[i=i.q t=t.q]
[i=i.r t=[i.q t.r]]
++ spli :: split
::|* p=(bque) q=(list ,[k=,_+<-.cmp n=*]) r=(bque)
|= [p=(bque key val) q=(list ,[k=key n=val]) r=(bque key val)]
^- [t=(bque key val) x=(list ,[k=key n=val])]
?~ r
[t=p x=q]
?: =(0 r.i.r)
$(q [[k=k.i.r n=n.i.r] q], r t.r)
$(p [i.r p], r t.r)
++ insl :: insert list
::|* [p=(list, [k=,_+<-.cmp n=*]) q=(bque)]
|= [p=(list ,[k=key n=val]) q=(bque key val)]
^- (bque key val)
?~ p q
?~ q p
$(p t.p, q (insert q i.p))
::
:: :: public interface
::
++ insert :: real ins
|= [q=(bque key val) k=key n=val]
^- (bque key val)
?~ q [i=[r=0 k=k n=n c=~] t=~]
?~ t.q [i=[r=0 k=k n=n c=~] t=q]
?: =(r.i.q r.i.t.q)
[i=(slink [r=0 k=k n=n c=~] i.q i.t.q) t=t.t.q]
[i=[r=0 k=k n=n c=~] t=q]
++ meld :: concat
|= [p=(bque key val) q=(bque key val)]
^- (bque key val)
(meuq (uniq p) (uniq q))
++ peek :: find min/max
|= q=(bque key val)
^- [k=key n=val]
?~ q ~|(%empty-bque-peek !!)
?~ t.q [k=k.i.q n=n.i.q]
=+ m=$(q t.q)
?: (cmp k.i.q k.m) [k=k.i.q n=n.i.q] m
++ pop :: delete min/max
|= q=(bque key val)
^- [r=[k=key n=val] q=(bque key val)]
::^- [q=(bque key val) r=[k=key n=val]]
?~ q ~|(%empty-bque-pop !!)
=+ m=(gmi q)
=+ s=(spli ~ ~ c.i.m)
[q=[k=k.i.m n=n.i.m] r=(insl x.s (meld t.m t.s))]
::[q=(insl x.s (meld t.m t.s)) r=[k=k.i.m n=n.i.m]]
--
--
==
|= *
|= ~
^- bowl
:_ ~ :_ ~
:- %$
!>
!:
=+ pri=((pr ,@ ,@) lte)
=+ pq=(insert.pri ~ 6 3)
=. pq (insert.pri pq 5 2)
=. pq (insert.pri pq 2 5)
=+ pq2=(insert.pri ~ 508 1.084)
=. pq2 (insert.pri pq2 42 75)
=. pq2 (insert.pri pq2 325 562)
=. pq2 (insert.pri pq2 41 822)
=. pq (meld.pri pq pq2)
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
=^ r pq (pop.pri pq)
~& r
pq