merge test

This commit is contained in:
Henry Ault 2015-05-07 14:34:49 -07:00
commit 4c117a9418
21 changed files with 5592 additions and 60 deletions

122
base/ape/acto/core.hook Normal file
View File

@ -0,0 +1,122 @@
:: :: ::
:::: /hook/core/acto/ape :: ::
:: :: ::
/- *sole :: structures
/+ sole :: libraries
:: ::
:::: ::
!: ::
=> |% :: board logic
++ board ,@ :: one-player bitfield
++ point ,[x=@ y=@] :: coordinate
++ bo :: board core
|_ bud=board :: state
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ get |=(point =(1 (cut 0 [(off +<) 1] bud))) :: get point
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) :: with bitmasks
-- ::
-- ::
=> |% :: game logic
++ game ,[tun=? box=board boo=board] :: game state
++ go :: game core
|_ game ::
++ pro ": {?:(tun "X" "O")} to move (x/y): " :: prompt
++ say |= point :: point value
?: (~(get bo box) +<) 'X'
?: (~(get bo boo) +<) 'O' '.'
::
++ mov :: move at
|= point
^- [bean game]
?: |((~(get bo box) +<) (~(get bo boo) +<))
[| +>+<]
:- & ?: tun
+>+<(tun |, box (~(set bo box) +<))
+>+<(tun &, boo (~(set bo boo) +<))
::
++ res ^- (unit tape) :: result
?: ~(win bo box) `"X wins!"
?: ~(win bo boo) `"O wins!"
?: =(511 (con boo box)) `"X and O tied." ~
::
++ ray :: render row
|= y=@ ^- tape
:~ (add y '1')
' ' (say y 0)
' ' (say y 1)
' ' (say y 2)
==
++ red ~["+ 1 2 3" (ray 0) (ray 1) (ray 2)] :: render board
--
--
=> |% :: arvo tools
++ card ,[%diff %sole-effect sole-effect] ::
++ move (pair bone card)
++ room (pair sole-share game)
--
|_ $: hid=hide :: system state
hoc=(map bone room)
==
++ yo
|_ [[ost=bone moz=(list move)] rom=room]
++ abet :: resolve
^- (quip move +>)
[(flop moz) +>(hoc (~(put by hoc) ost rom))]
::
++ emit :: produce move
|= fec=sole-effect
^+ +>
+>(moz [[ost %diff %sole-effect fec] moz])
::
++ emil :: emit multiple
|= fex=(list sole-effect)
?~(fex +> $(fex t.fex, +> (emit i.fex)))
::
++ show :: update ui
%+ emil [%pro & %toe ~(pro go q.rom)]
(turn ~(red go q.rom) |=(a=tape [%txt a]))
::
++ wipe :: clear input line
=^ cal p.rom (~(transmit cs p.rom) [%set ~])
(emit %det cal)
::
++ numb (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row/column
++ come ;~(plug numb ;~(pfix fas numb)) :: command
++ good |=(a=(list ,@c) -:(rose (tufa a) come)) :: validate
++ work ::
|= act=sole-action
^+ +>
?- -.act
%det
=^ cul p.rom (~(remit cs p.rom) +.act good)
?~(cul +>.$ (emit ~[%mor bel/~ det/u.cul]))
::
%ret
=+ dur=(rust (tufa buf.p.rom) come)
?~ dur (emit %bel ~)
=^ dud q.rom (~(mov go q.rom) u.dur)
?. dud (emit %bel ~)
=+ rus=~(res go q.rom)
=< show
?~ rus wipe
wipe:(emit(q.rom *game) %txt u.rus)
==
--
++ peer-sole :: console-subscribe
|= [from pax=path]
^- (quip move +>)
?> =(src our.hid)
abet:~(show yo [ost ~] *room)
::
++ poke-sole-action :: console command
|= [from act=sole-action]
^- (quip move +>)
?> =(src our.hid)
abet:(~(work yo [ost ~] (~(got by hoc) ost)) act)
::
++ pull :: stop subscription
|= then
[~ +>(hoc (~(del by hoc) ost))]
--

744
base/ape/dojo/core.hook Normal file
View File

@ -0,0 +1,744 @@
:: :: ::
:::: /hook/core/dojo/app :: ::::
:: :: ::
/? 314 :: arvo kelvin
/- *sole :: console structures
/+ sole :: console library
:: :: ::
:::: :: ::::
!: :: ::
=> |% :: external structures
++ house :: all state
$: hoc=(map bone session) :: conversations
== ::
++ session :: per conversation
$: say=sole-share :: command-line state
syd=desk :: active desk
luc=(unit case) :: special case
poy=(unit dojo-project) :: working
var=(map term cage) :: variable state
old=(set term) :: used TLVs
== ::
++ dojo-command ::
$% [%flat p=path q=dojo-source] :: noun to unix atom
[%pill p=path q=dojo-source] :: noun to unix pill
:: [%tree p=path q=dojo-source] :: noun to unix tree
[%poke p=goal q=dojo-source] :: make and poke
[%show p=dojo-source] :: print
[%verb p=term q=dojo-source] :: store variable
== ::
++ dojo-source :: construction node
$: p=@ud :: assembly index
q=dojo-build :: general build
== ::
++ dojo-build :: one ford step
$% [%ex p=twig] :: hoon expression
[%di p=dojo-model] :: dialog
[%dv p=path] :: gate from source
[%fi p=dojo-filter q=dojo-source] :: filter
[%ge p=dojo-model] :: generator
[%sc p=dojo-model] :: script
[%tu p=(list dojo-source)] :: tuple
[%va p=term] :: dojo variable
== ::
++ dojo-filter :: pipeline filter
$% [%a p=twig] :: function gate
[%b p=mark] :: simple transmute
[%c p=dojo-model] :: formal filter
== ::
++ dojo-model :: data construction
$: p=dojo-server :: core source
q=dojo-config :: configuration
== ::
++ dojo-server :: numbered device
$: p=@ud :: assembly index
q=path :: gate path
== ::
++ dojo-config :: configuration
$: p=(list dojo-source) :: by order
q=(map term (unit dojo-source)) :: by keyword
== ::
++ dojo-project :: construction state
$: mad=dojo-command :: operation
num=@ud :: number of tasks
cud=(unit dojo-source) :: now solving
pux=(unit path) :: ford working
pro=(unit vase) :: prompting loop
per=(unit sole-edit) :: pending reverse
job=(map ,@ud dojo-build) :: problems
rez=(map ,@ud cage) :: results
== ::
++ bead ,[p=(set beam) q=cage] :: computed result
++ goal ,[p=ship q=term] :: flat application
++ note :: general note
$% [%exec @p (unit silk)] ::
[%deal sock term club] ::
== ::
++ clap :: action, user
$% [%peer p=path] :: subscribe
[%poke p=term q=*] :: apply
[%pull ~] :: unsubscribe
== ::
++ club :: action, system
$% [%peer p=path] :: subscribe
[%poke p=cage] :: apply
[%pull ~] :: unsubscribe
== ::
++ card :: general card
$% [%diff %sole-effect sole-effect] ::
[%send wire [ship term] clap] ::
[%exec wire @p (unit silk)] ::
[%deal wire sock term club] ::
== ::
++ move (pair bone card) :: user-level move
++ hapt ,[p=ship q=path] ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%diff p=cage] :: subscription output
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
== ::
++ hood :: assembly plan
$: zus=@ud :: zuse kelvin
sur=(list hoot) :: structures
lib=(list hoof) :: libraries
fan=(list horn) :: resources
src=(list hoop) :: program
== ::
++ hoof (pair term (unit (pair case ship))) :: resource reference
++ hoot (pair bean hoof) :: structure gate/core
++ hoop :: source in hood
$% [%& p=twig] :: direct twig
[%| p=beam] :: resource location
== ::
++ horn :: resource tree
$% [%ape p=twig] :: /~ twig by hand
[%arg p=twig] :: /$ argument
[%day p=horn] :: /| list by @dr
[%dub p=term q=horn] :: /= apply face
[%fan p=(list horn)] :: /. list
[%for p=path q=horn] :: /, descend
[%hel p=@ud q=horn] :: /% propagate heel
[%hub p=horn] :: /@ list by @ud
[%man p=(map span horn)] :: /* hetero map
[%nap p=horn] :: /_ homo map
[%now p=horn] :: /& list by @da
[%saw p=twig q=horn] :: /; operate on
[%see p=beam q=horn] :: /: relative to
[%sic p=tile q=horn] :: /^ cast
[%toy p=mark] :: /mark/ static
== ::
++ silk :: construction layer
$& [p=silk q=silk] :: cons
$% [%bake p=mark q=beam r=path] :: local synthesis
[%boil p=mark q=beam r=path] :: general synthesis
[%call p=silk q=silk] :: slam
[%cast p=mark q=silk] :: translate
[%done p=(set beam) q=cage] :: literal
[%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit cage)] :: unit literal
[%mute p=silk q=(list (pair wing silk))] :: mutant
[%plan p=beam q=spur r=hood] :: structured assembly
[%reef ~] :: kernel reef
[%ride p=twig q=silk] :: silk thru twig
[%vale p=mark q=ship r=*] :: validate [our his]
== ::
++ sign ::
$% [%made p=@uvH q=(each cage tang)] ::
[%unto p=cuft] ::
== ::
-- ::
:: ::
:::: ::
:: ::
|_ $: hid=hide :: system state
house :: program state
== ::
++ he :: per session
|_ [[ost=bone moz=(list move)] session] ::
++ dp :: dojo parser
|%
++ dp-command :: ++dojo-command
%+ knee *dojo-command |. ~+
;~ pose
%+ stag %poke
;~ pfix col
%+ cook
|= [a=goal b=(each dojo-source (trel term path dojo-config))]
^- (pair goal dojo-source)
:- a
?- -.b
%& p.b
%| ?+ p.p.b !!
%di [0 %di [0 [%dog q.a q.p.b]] r.p.b]
%ge [0 %ge [0 [%cat q.a q.p.b]] r.p.b]
%sc [0 %sc [0 [%pig q.a q.p.b]] r.p.b]
==
==
;~ plug
dp-goal
;~ pose
(stag %& ;~(pfix ace dp-source))
%+ stag %|
;~ plug
;~ pose
(cold %di wut)
(cold %ge lus)
(cold %sc pam)
==
(most fas sym)
dp-config
==
==
==
==
::
%+ stag %verb
;~ pfix tis
;~(plug sym ;~(pfix ace dp-source))
==
::
%+ stag %flat
;~ pfix pat
;~(plug (most fas sym) ;~(pfix ace dp-source))
==
::
%+ stag %pill
;~ pfix dot
;~(plug (most fas sym) ;~(pfix ace dp-source))
==
::
(stag %show dp-source)
==
++ dp-source (stag 0 dp-build) :: ++dojo-source
++ dp-build :: ++dojo-build
%+ knee *dojo-build |. ~+
;~ pose
;~(pfix lus (stag %ge dp-model-cat))
;~(pfix wut (stag %di dp-model-dog))
;~(pfix pam (stag %sc dp-model-pig))
;~(pfix buc (stag %va sym))
(stag %ex dp-twig)
(ifix [sel ser] (stag %tu (most ace dp-source)))
==
::
++ dp-goal :: ++goal
%+ cook |=(a=goal a)
;~ pose
;~ plug
;~(pfix sig fed:ag)
;~(pfix fas sym)
==
(cook |=(a=term `goal`[our.hid a]) sym)
(easy [our.hid %helm])
==
++ dp-model-cat ;~(plug dp-server-cat dp-config) :: ++dojo-model
++ dp-model-dog ;~(plug dp-server-dog dp-config) :: ++dojo-model
++ dp-model-pig ;~(plug dp-server-pig dp-config) :: ++dojo-model
++ dp-server-cat (stag 0 (stag %cat dp-device)) :: ++dojo-server
++ dp-server-dog (stag 0 (stag %dog dp-device)) :: ++dojo-server
++ dp-server-pig (stag 0 (stag %pig dp-device)) :: ++dojo-server
++ dp-twig wide:(vang & ~) :: ++twig
++ dp-device (most fas sym) :: ++dojo-device
++ dp-value :: ++dojo-source
%+ cook |=(a=dojo-source a)
%+ stag 0
;~ pose
(ifix [kel ker] (stag %tu (most ace dp-source)))
(stag %va ;~(pfix buc sym))
(stag %ex dp-twig)
==
::
++ dp-config :: ++dojo-config
%+ cook |=(a=dojo-config a)
;~ plug
(star ;~(pfix ace dp-value))
%+ cook
~(gas by *(map term (unit dojo-source)))
%+ more
;~(plug com ace)
;~ plug
;~(pfix tis sym)
;~ pose
;~(pfix ace (stag ~ dp-value))
(easy ~)
==
==
==
--
::
++ dy :: project work
|_ dojo-project ::
++ dy-abet +>(poy `+<) :: resolve
++ dy-amok +>(poy ~) :: terminate
++ dy-ford :: send work to ford
|= [way=wire kas=silk]
^+ +>+>
?> ?=(~ pux)
(he-card(poy `+>+<(pux `way)) %exec way our.hid `kas)
::
++ dy-stop :: stop work
^+ +>
?~ pux +>
(he-card(poy ~) %exec u.pux our.hid ~)
::
++ dy-slam :: call by ford
|= [way=wire gat=vase sam=vase]
^+ +>+>
(dy-ford way %call [%done ~ %noun gat] [%done ~ %noun sam])
::
++ dy-diff :: send effects, abet
|= fec=sole-effect
^+ +>+>
(he-diff(poy `+>+<) fec)
::
++ dy-rash :: send effects, amok
|= fec=sole-effect
^+ +>+>
(he-diff(poy ~) fec)
::
++ dy-init-command :: ++dojo-command
|= mad=dojo-command
^+ [mad +>]
?- -.mad
%flat =^(src +>.$ (dy-init-source q.mad) [[%flat p.mad src] +>.$])
%pill =^(src +>.$ (dy-init-source q.mad) [[%pill p.mad src] +>.$])
%poke =^(src +>.$ (dy-init-source q.mad) [[%poke p.mad src] +>.$])
%show =^(src +>.$ (dy-init-source p.mad) [[%show src] +>.$])
%verb =^(src +>.$ (dy-init-source q.mad) [[%verb p.mad src] +>.$])
==
::
++ dy-init-source-unit :: (unit dojo-source)
|= urc=(unit dojo-source)
^+ [urc +>]
?~ urc [~ +>]
=^ src +> (dy-init-source u.urc)
[`src +>.$]
::
++ dy-init-source :: ++dojo-source
|= src=dojo-source
^+ [src +>]
=^ bul +> (dy-init-build q.src)
=: p.src num
q.src bul
==
[src +>.$(num +(num), job (~(put by job) num q.src))]
::
++ dy-init-build :: ++dojo-build
|= bul=dojo-build
^+ [bul +>]
?- -.bul
%ex [bul +>.$]
%di =^(mod +>.$ (dy-init-model p.bul) [[%di mod] +>.$])
%dv [bul +>.$]
%fi !!
%ge =^(mod +>.$ (dy-init-model p.bul) [[%ge mod] +>.$])
%sc !!
%tu =^ dof +>.$
|- ^+ [p.bul +>.^$]
?~ p.bul [~ +>.^$]
=^ dis +>.^$ (dy-init-source i.p.bul)
=^ mor +>.^$ $(p.bul t.p.bul)
[[dis mor] +>.^$]
[[%tu dof] +>.$]
%va [bul +>.$]
==
::
++ dy-init-model :: ++dojo-model
|= mol=dojo-model
^+ [mol +>]
=^ one +>.$ (dy-init-server p.mol)
=^ two +>.$ (dy-init-config q.mol)
[[one two] +>.$]
::
++ dy-init-server :: ++dojo-server
|= srv=dojo-server
=. p.srv num
[srv +>.$(num +(num), job (~(put by job) num [%dv q.srv]))]
::
++ dy-init-config :: prepare config
|= cig=dojo-config
^+ [cig +>]
=^ ord +>.$ (dy-init-ordered p.cig)
=^ key +>.$ (dy-init-named q.cig)
[[ord key] +>.$]
::
++ dy-init-ordered :: (list dojo-source)
|= ord=(list dojo-source)
^+ [ord +>]
?~ ord [~ +>.$]
=^ fir +>.$ (dy-init-source i.ord)
=^ mor +>.$ $(ord t.ord)
[[fir mor] +>.$]
::
++ dy-init-named :: (map @tas dojo-src)
|= key=(map term (unit dojo-source))
^+ [key +>.$]
?~ key [~ +>.$]
=^ top +>.$ (dy-init-source-unit q.n.key)
=^ lef +>.$ $(key l.key)
=^ rit +>.$ $(key r.key)
[[[p.n.key top] lef rit] +>.$]
::
++ dy-init :: full initialize
^+ .
=^(dam . (dy-init-command mad) +(mad dam))
::
++ dy-hand :: complete step
|= cag=cage
^+ +>+>
?> ?=(^ cud)
(dy-step(cud ~, rez (~(put by rez) p.u.cud cag)) +(p.u.cud))
::
++ dy-meal :: vase to cage
|= vax=vase
?. &(?=(@ -.q.vax) ((sane %tas) -.q.vax))
~& %dy-meal-cage
(dy-rash %bel ~)
(dy-hand -.q.vax (slot 3 vax))
::
++ dy-made-edit :: sole edit
|= cag=cage
^+ +>+>
?> ?=(^ per)
?: ?| ?=(^ q.q.cag)
=((lent buf.say) q.q.cag)
!&(?=(%del -.u.per) =(+(p.u.per) (lent buf.say)))
==
dy-abet(per ~)
=^ lic say (~(transmit cs say) u.per)
(dy-diff(per ~) %mor [%det lic] [%err q.q.cag] ~)
::
++ dy-done :: dialog submit
|= txt=tape
?> ?=(^ pro)
(dy-slam /dial u.pro !>(txt))
::
++ dy-over :: finish construction
^+ +>
?- -.mad
%poke
%- he-card(poy ~)
:* %deal
/poke
[our.hid p.p.mad]
q.p.mad
%poke
(~(got by rez) p.q.mad)
==
::
%flat
=+ out=q.q:(~(got by rez) p.q.mad)
?^ out
(dy-rash %tan [%leaf "not an atom"]~)
(dy-rash %sav p.mad out)
::
%pill
(dy-rash %sag p.mad q.q:(~(got by rez) p.q.mad))
::
%verb
dy-amok(var (~(put by var) p.mad (~(got by rez) p.q.mad)))
::
%show
(dy-rash %tan (sell q:(~(got by rez) p.p.mad)) ~)
==
::
++ dy-edit :: handle edit
|= cal=sole-change
^+ +>+>
=^ dat say (~(transceive cs say) cal)
?: |(?=(^ per) ?=(^ pux) ?=(~ pro))
~& %dy-edit-busy
=^ lic say (~(transmit cs say) dat)
(dy-diff %mor [%det lic] [%bel ~] ~)
(dy-slam(per `dat) /edit u.pro !>((tufa buf.say)))
::
++ dy-type :: sole action
|= act=sole-action
?- -.act
%det (dy-edit +.act)
%ret (dy-done (tufa buf.say))
==
::
++ dy-cage |=(num=@ud (~(got by rez) num)) :: known cage
++ dy-vase |=(num=@ud q:(dy-cage num)) :: known vase
++ dy-silk-vase |=(vax=vase [%done ~ %noun vax]) :: vase to silk
++ dy-silk-config :: configure
|= [cag=cage cig=dojo-config]
^- silk
:+ %ride [%cnzy %$]
:+ %mute [%done ~ cag]
^- (list (pair wing silk))
:* :- [[~ 12] ~]
(dy-silk-vase !>([now=lat.hid eny=eny.hid bec=he-beak]))
::
:- [[~ 26] ~]
%- dy-silk-vase
|- ^- vase
?~ p.cig !>(~)
(slop (dy-vase p.i.p.cig) $(p.cig t.p.cig))
::
%+ turn (~(tap by q.cig))
|= [a=term b=(unit dojo-source)]
^- (pair wing silk)
:- [a [~ 27] ~]
%- dy-silk-vase
?~(b !>([~ ~]) (dy-vase p.u.b))
==
::
++ dy-silk-init-modo :: init and config
|= [cag=cage cig=dojo-config]
^- silk
(dy-silk-config cag cig)
::
++ dy-silk-device :: device to silk
|= way=wire
^- silk
[%boil %gate [he-beak (flop way)] ~]
::
++ dy-made-dial :: dialog product
|= cag=cage
^+ +>+>
?. ?=(^ q.q.cag)
(dy-diff %err q.q.cag)
=+ tan=((list tank) +2.q.q.cag)
=. +>+>.$ (he-diff %tan tan)
=+ vax=(spec (slot 3 q.cag))
?+ -.q.vax !!
%&
?~ +.q.vax
~& %dy-made-dial-abort
(dy-rash %bel ~)
(dy-meal (slot 7 vax))
::
%|
=< he-pone
%- dy-diff(pro `(slap (slot 7 vax) [%cnzy %q]))
=+ pom=(sole-prompt +<.q.vax)
[%pro pom(cad [':' ' ' cad.pom])]
==
::
++ dy-made-gent :: generator product
|= cag=cage
(dy-meal q.cag)
::
++ dy-make :: build step
^+ +>
?> ?=(^ cud)
%- dy-ford
^- (pair path silk)
?+ -.q.u.cud !!
%di [/dial (dy-silk-init-modo (dy-cage p.p.p.q.u.cud) q.p.q.u.cud)]
%ge [/gent (dy-silk-init-modo (dy-cage p.p.p.q.u.cud) q.p.q.u.cud)]
%dv [/hand (dy-silk-device p.q.u.cud)]
%ex [/hand [%ride p.q.u.cud [%reef ~]]]
%tu :- /hand
:+ %done ~
:- %noun
|- ^- vase
?~ p.q.u.cud !!
=+ hed=(dy-vase p.i.p.q.u.cud)
?~ t.p.q.u.cud hed
(slop hed $(p.q.u.cud t.p.q.u.cud))
==
::
++ dy-step :: advance project
|= nex=@ud
^+ +>+>
?> ?=(~ cud)
?: =(nex num)
dy-over
dy-make(cud `[nex (~(got by job) nex)])
--
::
++ he-dope :: sole user of ++dp
|= txt=tape ::
^- (each (unit dojo-command) hair) :: prefix/result
=+ vex=(dp-command:dp [1 1] txt) ::
?. =(+((lent txt)) q.p.vex) :: fully parsed
[%| p.p.vex (dec q.p.vex)] :: syntax error
[%& ?~(q.vex ~ `p.u.q.vex)] :: prefix/complete
::
++ he-duke :: ++he-dope variant
|= txt=tape
^- (each dojo-command ,@ud)
=+ foy=(he-dope txt)
?- -.foy
%| [%| q.p.foy]
%& ?~(p.foy [%| (lent txt)] [%& u.p.foy])
==
::
++ he-abet :: resolve
[(flop moz) %_(+> hoc (~(put by hoc) ost +<+))]
::
++ he-beak :: logical beam
^- beak
[our.hid syd ?^(luc u.luc [%da lat.hid])]
::
++ he-card :: emit gift
|= cad=card
^+ +>
%_(+> moz [[ost cad] moz])
::
++ he-send
|= [way=wire him=ship dap=term cop=clap]
^+ +>
(he-card %send way [him dap] cop)
::
++ he-diff :: emit update
|= fec=sole-effect
^+ +>
(he-card %diff %sole-effect fec)
::
++ he-stop :: abort work
^+ .
?~(poy . ~(dy-stop dy u.poy))
::
++ he-peer :: subscribe to
he-prom
::
++ he-pine :: restore prompt
^+ .
?^ poy .
he-prom:he-pone
::
++ he-pone :: clear prompt
^+ .
=^ cal say (~(transmit cs say) [%set ~])
(he-diff %mor [%det cal] ~)
::
++ he-prom :: send prompt
%- he-diff
:- %pro
[& %$ "> "]
::
++ he-made :: result from ford
|= [way=wire dep=@uvH rey=(each cage tang)]
^+ +>
?> ?=(^ poy)
=< he-pine
?- -.rey
%& %. p.rey
=+ dye=~(. dy u.poy(pux ~))
?+ way !!
[%hand ~] dy-hand:dye
[%dial ~] dy-made-dial:dye
[%gent ~] dy-made-gent:dye
[%edit ~] dy-made-edit:dye
==
%| ~& [%he-made-fail way]
(he-diff(poy ~) %tan p.rey)
==
::
++ he-unto :: result from behn
|= cit=cuft
^+ +>
?> ?=(%coup -.cit)
?~ p.cit
(he-diff %txt ">=")
(he-diff %tan u.p.cit)
::
++ he-like :: accept line
|= buf=(list ,@c)
=(%& -:(he-dope (tufa buf)))
::
++ he-stir :: apply change
|= cal=sole-change
^+ +>
:: ~& [%his-clock ler.cal]
:: ~& [%our-clock ven.say]
=^ dat say (~(transceive cs say) cal)
?. ?& ?=(%del -.dat)
=(+(p.dat) (lent buf.say))
==
+>.$
=+ foy=(he-dope (tufa buf.say))
?: ?=(%& -.foy) +>.$
:: ~& [%bad-change dat ted.cal]
=^ lic say (~(transmit cs say) dat)
:: ~& [%our-leg leg.say]
(he-diff %mor [%det lic] [%err q.p.foy] ~)
::
++ he-plan :: execute command
|= mad=dojo-command
^+ +>
?> ?=(~ poy)
he-pine:(dy-step:~(dy-init dy mad [0 ~ ~ ~ ~ ~ ~]) 0)
::
++ he-done :: parse command
|= txt=tape
^+ +>
?~ txt
%- he-diff
:~ %mor
[%txt "> "]
[%nex ~]
==
=+ doy=(he-duke txt)
?- -.doy
%| (he-diff [%err p.doy])
%&
=+ old=(weld "> " (tufa buf.say))
=^ cal say (~(transmit cs say) [%set ~])
%. p.doy
=< he-plan
%- he-diff
:~ %mor
[%txt old]
[%nex ~]
[%det cal]
==
==
::
++ he-type :: apply input
|= act=sole-action
^+ +>
?^ poy
he-pine:(~(dy-type dy u.poy) act)
?- -.act
%det (he-stir +.act)
%ret (he-done (tufa buf.say))
==
--
::
++ peer
|= [from pax=path]
^- (quip move +>)
~? !=(src our.hid) [%dojo-peer-stranger ost src pax]
:: ?> =(src our.hid)
?< (~(has by hoc) ost)
?> =(/sole pax)
=< he-abet
%~ he-peer he
:- [ost ~]
^- session
:* *sole-share :: say=sole-share
%main :: syd=desk
~ :: luc=(unit case)
~ :: poy=(unit dojo-project)
~ :: var=(map term cage)
~ :: old=(set term)
==
::
++ poke-sole-action
|= [from act=sole-action]
^- (quip move +>)
:: ~& [%dojo-poke ost src act]
:: ~? !=(src our.hid) [%dojo-poke ost src]
he-abet:(~(he-type he [ost ~] (~(got by hoc) ost)) act)
::
++ made
|= [then dep=@uvH rey=(each cage tang)]
he-abet:(~(he-made he [[ost ~] (~(got by hoc) ost)]) way dep rey)
::
++ unto
|= [then cit=cuft]
he-abet:(~(he-unto he [[ost ~] (~(got by hoc) ost)]) cit)
::
++ pull
|= [from pax=path]
^- (quip move +>)
=^ moz +>
he-abet:~(he-stop he [[ost ~] (~(got by hoc) ost)])
[moz +>.$(hoc (~(del by hoc) ost))]
--

183
base/ape/helm/core.hook Normal file
View File

@ -0,0 +1,183 @@
:: :: ::
:::: /hook/core/helm/ape :: ::
:: :: ::
/? 314 :: zuse version
/- *sole :: structures
/+ sole :: libraries
:: :: ::
:::: :: ::
!: :: ::
=> |% :: principal structures
++ helm-house :: all state
$: %0 :: state version
bur=(unit (pair ship mace)) :: requesting ticket
hoc=(map bone helm-session) :: consoles
== ::
++ helm-session ::
$: say=sole-share ::
mud=(unit (sole-dialog ,@ud)) ::
== ::
++ funk (pair ,@ ,@) ::
++ begs ,[his=@p tic=@p eny=@t ges=gens] :: begin data
++ suss ,[term @tas @da] :: config report
++ helm-wish ::
$| $? %reset :: reset kernel
%verb :: verbose mode
== ::
$% [%reload p=(list term)] :: reload vanes
== ::
++ dill :: sent to %dill
$% [%crud p=term q=(list tank)] :: fat report
[%text p=tape] :: thin report
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ card ::
$% [%cash wire p=@p q=buck] ::
[%conf wire dock %load ship term] ::
[%flog wire dill] ::
[%plug wire @p @tas @p @tas] ::
[%want wire sock path *] :: send message
== ::
++ move (pair bone card) :: user-level move
-- ::
:: ::
:::: ::
:: ::
|_ $: hid=hide :: system state
helm-house :: program state
== ::
++ he :: per session
|_ [[ost=bone moz=(list move)] helm-session] ::
++ he-abet :: resolve
[(flop moz) %_(+> hoc (~(put by hoc) ost +<+))] ::
:: ::
++ he-wish-start
|= dap=term
%_(+> moz :_(moz [ost %conf /start [our.hid dap] %load our.hid %main]))
::
++ he-wish-reset
^+ .
=- %_(+ moz (weld zum moz))
^= zum %- flop ^- (list move)
=+ top=`path`/(scot %p our.hid)/arvo/(scot %da lat.hid)
:- [ost %flog /reset %vega (weld top `path`/hoon)]
%+ turn
^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%a %ames]
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
[%t %time]
==
|= [p=@tas q=@tas]
=+ way=`path`(welp top /[q])
=+ txt=((hard ,@) .^(%cx (welp way /hoon)))
[ost %flog /reset %veer p way txt]
::
++ he-wish-reload
|= all=(list term)
%_ +>.$
moz
%- weld
:_ moz
%+ turn all
=+ ark=(arch .^(%cy /(scot %p our.hid)/arvo/(scot %da lat.hid)))
=+ van=(~(tap by r.ark))
|= nam=@tas
=. nam
?. =(1 (met 3 nam))
nam
=+ ^- zaz=(list ,[p=span ~])
(skim van |=([a=term ~] =(nam (end 3 1 a))))
?> ?=([[@ ~] ~] zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=+ way=[(scot %p our.hid) %arvo (scot %da lat.hid) nam %hoon ~]
=+ fil=(,@ .^(%cx way))
:* ost
%flog
/reload
[%veer ?:(=('z' tip) %$ tip) way (,@ .^(%cx way))]
==
==
::
++ he-wish-verb
%_ .
moz
:_ moz
[ost %flog /verb %verb ~]
==
++ he-wish-init
|= him=ship
%_ +>.$
moz
:_ moz
[ost %flog /init %crud %hax-init leaf/(scow %p him) ~]
==
--
::
++ hake :: poke core
|= [ost=bone src=ship]
?> =(src our.hid)
~(. he [ost ~] (fall (~(get by hoc) ost) *helm-session))
::
++ poke-helm-reset
|= [from ~]
~& %poke-helm-reset
he-abet:he-wish-reset:(hake ost src)
::
++ poke-helm-verb
|= [from ~]
~& %poke-helm-verb
he-abet:he-wish-verb:(hake ost src)
::
++ poke-helm-init
|= [from him=ship]
~& %poke-helm-init
he-abet:(he-wish-init:(hake ost src) him)
::
++ poke-helm-reload
|= [from all=(list term)]
he-abet:(he-wish-reload:(hake ost src) all)
::
++ poke-helm-start
|= [from dap=term]
he-abet:(he-wish-start:(hake ost src) dap)
::
++ poke-helm-begin
|= [from begs]
~& %behn-helm-begin
?> ?=(~ bur)
=+ buz=(shax :(mix (jam ges) eny))
=+ loy=(bruw 2.048 buz)
:_ +>.$(bur `[his [0 sec:ex:loy]~])
:~ :* ost %want /ticketing [our.hid (sein his)] /q/ta
his tic ges pub:ex:loy
==
==
::
++ poke-will
|= [from wil=(unit will)]
?> ?=(^ bur)
:_ +>.$(bur ~)
?~ wil
!!
:~ [ost %cash ~ p.u.bur q.u.bur u.wil]
[ost %plug ~ our.hid %main (sein our.hid) %main]
[ost %plug ~ our.hid %arvo (sein our.hid) %arvo]
[ost %plug ~ our.hid %try (sein our.hid) %try]
==
::
++ onto
|= [then saw=(each suss tang)]
:_ +> :_ ~
?- -.saw
%| [ost %pass ~ %flog %crud `@tas`-.way `tang`p.saw]
%& [ost %pass ~ %flog %text "<{<p.saw>}>"]
==
--

679
base/ape/sole/core.hook Normal file
View File

@ -0,0 +1,679 @@
:: :: ::
:::: /hook/core/sole/app :: ::
:: :: ::
/? 314 :: zuse version
/- *sole :: console structures
/+ sole :: console library
:: :: ::
:::: :: ::
!: :: ::
=> |% :: data structures
++ house :: all state
$: bin=(map bone source) :: input devices
== ::
++ source :: input device
$: edg=_79 :: terminal columns
off=@ud :: window offset
kil=(unit (list ,@c)) :: kill buffer
apt=(list gill) :: application ring
maz=master :: master window
feg=(map gill target) :: live applications
mir=(pair ,@ud (list ,@c)) :: mirrored terminal
== ::
++ master :: master buffer
$: liv=? :: master is live
tar=target :: master target
== ::
++ history :: past input
$: pos=@ud :: input position
num=@ud :: number of entries
lay=(map ,@ud (list ,@c)) :: editing overlay
old=(list (list ,@c)) :: entries proper
== ::
++ search :: reverse-i-search
$: pos=@ud :: search position
str=(list ,@c) :: search string
== ::
++ target :: application target
$: ris=(unit search) :: reverse-i-search
hit=history :: all past input
pom=sole-prompt :: static prompt
inp=sole-command :: input state
== ::
++ ukase :: master command
$% [%add p=(list gill)] :: add agents
[%del p=(list gill)] :: delete agents
== ::
++ suss ,[term @tas @da] :: config report
++ dill :: *forward* to %dill
$% [%crud p=term q=(list tank)] :: fat report
[%text p=tape] :: thin report
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ pear :: request
$% [%sole-action p=sole-action] ::
== ::
++ lime :: update
$% [%dill-blit dill-blit] ::
== ::
++ card :: general card
$% [%conf wire dock %load ship term] ::
[%diff lime] ::
[%flog wire dill] ::
[%peer wire dock path] ::
[%poke wire dock pear] ::
[%pull wire dock ~] ::
[%pass wire note] ::
== ::
++ move (pair bone card) :: user-level move
-- ::
|_ $: hid=hide :: system state
house :: program state
== ::
++ sp
|% ++ sp-ukase
%+ knee *ukase |. ~+
;~ pose
(stag %add ;~(pfix lus sp-gills))
(stag %del ;~(pfix hep sp-gills))
==
::
++ sp-gills
;~ pose
(most ;~(plug com ace) sp-gill)
%+ cook
|= a=ship
[[a %dojo] [a %talk] ~]
;~(pfix sig fed:ag)
==
::
++ sp-gill
;~ pose
(stag our.hid sym)
;~ plug
;~(pfix sig fed:ag)
;~(pfix fas sym)
==
==
--
++ se :: per source
|_ $: [moz=(list move) biz=(list dill-blit)]
[src=ship ost=bone]
source
==
++ se-abet :: resolve
:_ %_(+> bin (~(put by bin) ost +<+>))
%+ welp (flop moz)
^- (list move)
?~ biz ~
[ost %diff %dill-blit ?~(t.biz i.biz [%mor (flop biz)])]~
::
++ se-belt :: handle input
|= bet=dill-belt
^+ +>
?: ?=(%rez -.bet)
+>(edg (dec p.bet))
?: ?=(%yow -.bet)
(se-link p.bet)
=+ gyl=?^(apt i.apt [~zod %$])
=+ taz=~(. ta [& liv.maz gyl] ?:(liv.maz tar.maz (~(got by feg) gyl)))
=< ta-abet
?- -.bet
%aro (ta-aro:taz p.bet)
%bac ta-bac:taz
%cru (ta-cru:taz p.bet q.bet)
%ctl (ta-ctl:taz p.bet)
%del ta-del:taz
%met (ta-met:taz p.bet)
%ret ta-ret:taz
%txt (ta-txt:taz p.bet)
==
::
++ se-drop :: passive drop
|= gyl=gill
^+ +>
=< se-prom
?> (~(has by feg) gyl)
%_ +>
feg (~(del by feg) gyl)
apt (skip apt |=(a=gill =(gyl a)))
liv.maz ?~(apt & liv.maz)
==
::
++ se-join :: add connection
|= gyl=gill
^+ +>
=< se-prom
?: (~(has by feg) gyl)
(se-blit %bel ~)
+>(liv.maz |, apt [gyl apt], feg (~(put by feg) gyl *target))
::
++ se-nuke :: active drop
|= gyl=gill
^+ +>
(se-drop:(se-pull(liv.maz |) gyl) gyl)
::
++ se-like :: act in master
|= kus=ukase
?- -.kus
%add
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-link i.p.kus))
::
%del
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-nuke i.p.kus))
==
::
++ se-prom :: set master prompt
^+ .
%_ .
cad.pom.tar.maz
^- tape
%+ welp
(scow %p our.hid)
=+ ^= mux
|- ^- tape
?~ apt ~
=+ ^= mor ^- tape
?~ t.apt ~
[',' ' ' $(apt t.apt)]
%+ welp
^- tape
=+ txt=(trip q.i.apt)
?: =(our.hid p.i.apt)
txt
:(welp "~" (scow %p p.i.apt) "/" txt)
mor
?~ mux
"# "
:(welp ":" mux "# ")
==
::
++ se-link :: connect to app
|= gyl=gill
^+ +>
=. +> ?. =(p.gyl src) +>
(se-emit ost %conf (se-path gyl) gyl %load src %main)
(se-join:(se-peer gyl /sole) gyl)
::
++ se-blit :: give output
|= bil=dill-blit
+>(biz [bil biz])
::
++ se-show :: show buffer, raw
|= lin=(pair ,@ud (list ,@c))
^+ +>
?: =(mir lin) +>
=. +> ?:(=(q.mir q.lin) +> (se-blit %pro q.lin))
=. +> ?:(=(p.mir p.lin) +> (se-blit %hop p.lin))
+>(mir lin)
::
++ se-just :: adjusted buffer
|= lin=(pair ,@ud (list ,@c))
^+ +>
=. off ?:((lth p.lin edg) 0 (sub p.lin edg))
(se-show (sub p.lin off) (scag edg (slag off q.lin)))
::
++ se-view :: flush buffer
?: liv.maz
(se-just ~(ta-vew ta [& & ~zod %$] tar.maz))
?~ apt
se-view(liv.maz &)
%- se-just
~(ta-vew ta [& | i.apt] (~(got by feg) i.apt))
::
++ se-kill :: kill a source
=+ tup=apt
|- ^+ +>
?~ tup +>(apt ~)
$(tup +.tup, +> (se-nuke i.tup))
::
++ se-emit :: emit move
|= mov=move
%_(+> moz [mov moz])
::
++ se-path :: standard path
|= gyl=gill
[(scot %p src) (scot %p p.gyl) q.gyl ~]
::
++ se-poke :: send a poke
|= [gyl=gill par=pear]
(se-emit ost %poke (se-path gyl) gyl par)
::
++ se-peer
|= [gyl=gill pax=path]
(se-emit ost %peer (se-path gyl) gyl pax)
::
++ se-pull
|= gyl=gill
(se-emit ost %pull (se-path gyl) gyl ~)
::
++ se-pass :: pass an action
|= [gyl=gill noh=note]
(se-emit ost %pass (se-path gyl) noh)
::
++ se-tame
|= gyl=gill
^+ ta
~(. ta [& %| gyl] (~(got by feg) gyl))
::
++ se-diff :: receive results
|= [gyl=gill fec=sole-effect]
^+ +>
ta-abet:(ta-fec:(se-tame gyl) fec)
::
++ ta :: per target
|_ $: $: liv=? :: don't delete
mav=? :: showing master
gyl=gill :: target app
== ::
target :: target state
== ::
++ ta-abet :: resolve
^+ ..ta
=. liv.maz mav
?: mav
?. liv
(se-blit `dill-blit`[%qit ~])
+>(tar.maz +<+)
?. liv
=. ..ta (se-nuke gyl)
..ta(liv.maz =(~ apt))
%_(+> feg (~(put by feg) gyl +<+))
::
++ ta-ant :: toggle master
^+ .
?: mav
?~ apt ta-bel
%_ .
mav |
+<+ (~(got by feg) gyl)
tar.maz +<+
==
%_ .
mav &
+<+ tar.maz
feg (~(put by feg) gyl +<+)
==
::
++ ta-act :: send action
|= act=sole-action
^+ +>
?: mav
+>.$
+>.$(+> (se-poke gyl %sole-action act))
::
++ ta-aro :: hear arrow
|= key=?(%d %l %r %u)
^+ +>
?- key
%d =. ris ~
?. =(num.hit pos.hit)
(ta-mov +(pos.hit))
?: =(0 (lent buf.say.inp))
ta-bel
(ta-hom:ta-nex %set ~)
%l ?^ ris ta-bel
?: =(0 pos.inp) ta-bel
+>(pos.inp (dec pos.inp))
%r ?^ ris ta-bel
?: =((lent buf.say.inp) pos.inp)
ta-bel
+>(pos.inp +(pos.inp))
%u =. ris ~
?:(=(0 pos.hit) ta-bel (ta-mov (dec pos.hit)))
==
::
++ ta-bel .(+> (se-blit %bel ~)) :: beep
++ ta-cat :: mass insert
|= [pos=@ud txt=(list ,@c)]
^- sole-edit
:- %mor
|- ^- (list sole-edit)
?~ txt ~
[[%ins pos i.txt] $(pos +(pos), txt t.txt)]
::
++ ta-cut :: mass delete
|= [pos=@ud num=@ud]
^- sole-edit
:- %mor
|-(?:(=(0 num) ~ [[%del pos] $(num (dec num))]))
::
++ ta-det :: send edit
|= ted=sole-edit
^+ +>
(ta-act %det [[his.ven.say.inp own.ven.say.inp] (sham buf.say.inp) ted])
::
++ ta-bac :: hear backspace
^+ .
?^ ris
?: =(~ str.u.ris)
ta-bel
.(str.u.ris (scag (dec (lent str.u.ris)) str.u.ris))
?: =(0 pos.inp)
.(+> (se-blit %bel ~))
=+ pre=(dec pos.inp)
(ta-hom(pos.inp pre) %del pre)
::
++ ta-ctl :: hear control
|= key=@ud
^+ +>
?+ key ta-bel
%a +>(pos.inp 0)
%b (ta-aro %l)
%c ta-bel(ris ~)
%d ?: &(=(0 pos.inp) =(0 (lent buf.say.inp)))
+>(liv |)
ta-del
%e +>(pos.inp (lent buf.say.inp))
%f (ta-aro %r)
%g ta-bel(ris ~)
%k =+ len=(lent buf.say.inp)
?: =(pos.inp len)
ta-bel
%- ta-hom(kil `(slag pos.inp buf.say.inp))
(ta-cut pos.inp (sub len pos.inp))
%l +>(+> (se-blit %clr ~))
%n (ta-aro %d)
%p (ta-aro %u)
%r ?~ ris
+>(ris `[pos.hit ~])
?: =(0 pos.u.ris)
ta-bel
(ta-ser ~)
%t =+ len=(lent buf.say.inp)
?: |(=(0 pos.inp) (lth len 2))
ta-bel
=+ sop=?:(=(len pos.inp) (dec pos.inp) pos.inp)
=. pos.inp +(sop)
%- ta-hom
:~ %mor
[%del sop]
[%ins (dec sop) (snag sop buf.say.inp)]
==
%u ?: =(0 pos.inp)
ta-bel
%- ta-hom(pos.inp 0, kil `(scag pos.inp buf.say.inp))
(ta-cut 0 pos.inp)
%v ta-ant
%x ?: =(~ apt) ta-bel
?: mav ta-bel
+>(apt (welp (slag 1 apt) [(snag 0 apt) ~]))
%y ?~ kil ta-bel
%- ta-hom(pos.inp (add pos.inp (lent u.kil)))
(ta-cat pos.inp u.kil)
==
::
++ ta-cru :: hear crud
|= [lab=@tas tac=(list tank)]
=. +>+> (se-blit %out (tuba (trip lab)))
(ta-tan tac)
::
++ ta-del :: hear delete
^+ .
?: =((lent buf.say.inp) pos.inp)
.(+> (se-blit %bel ~))
(ta-hom %del pos.inp)
::
++ ta-erl :: hear local error
|= pos=@ud
ta-bel(pos.inp (min pos (lent buf.say.inp)))
::
++ ta-err :: hear remote error
|= pos=@ud
(ta-erl (~(transpose cs say.inp) pos))
::
++ ta-fec :: apply effect
|= fec=sole-effect
^+ +>
?- -.fec
%bel ta-bel
%blk +>
%clr +>(+> (se-blit fec))
%det (ta-got +.fec)
%err (ta-err +.fec)
%mor |- ^+ +>.^$
?~ p.fec +>.^$
$(p.fec t.p.fec, +>.^$ ^$(fec i.p.fec))
%nex ta-nex
%pro (ta-pro +.fec)
%tan (ta-tan p.fec)
%sag +>(+> (se-blit fec))
%sav +>(+> (se-blit fec))
%txt $(fec [%tan [%leaf p.fec]~])
==
::
++ ta-dog :: change cursor
|= ted=sole-edit
%_ +>
pos.inp
=+ len=(lent buf.say.inp)
%+ min len
|- ^- @ud
?- -.ted
%del ?:((gth pos.inp p.ted) (dec pos.inp) pos.inp)
%ins ?:((lte pos.inp p.ted) +(pos.inp) pos.inp)
%mor |- ^- @ud
?~ p.ted pos.inp
$(p.ted t.p.ted, pos.inp ^$(ted i.p.ted))
%nop pos.inp
%set len
==
==
::
++ ta-got :: apply change
|= cal=sole-change
=^ ted say.inp (~(receive cs say.inp) cal)
(ta-dog ted)
::
++ ta-hom :: local edit
|= ted=sole-edit
^+ +>
=. +> (ta-det ted)
=. +> (ta-dog(say.inp (~(commit cs say.inp) ted)) ted)
+>
::
++ ta-met :: meta key
|= key=@ud
~& [%ta-met key]
+>
::
++ ta-mov :: move in history
|= sop=@ud
^+ +>
?: =(sop pos.hit) +>
%+ %= ta-hom
pos.hit sop
lay.hit %+ ~(put by lay.hit)
pos.hit
buf.say.inp
==
%set
%- (bond |.((snag (sub num.hit +(sop)) old.hit)))
(~(get by lay.hit) sop)
::
++ ta-nex :: advance history
%_ .
num.hit +(num.hit)
pos.hit +(num.hit)
ris ~
lay.hit ~
old.hit [buf.say.inp old.hit]
==
::
++ ta-pro :: set prompt
|= pom=sole-prompt
+>(pom pom(cad :(welp (scow %p p.gyl) ":" (trip q.gyl) cad.pom)))
::
++ ta-ret :: hear return
?. mav
(ta-act %ret ~)
=+ txt=(tufa buf.say.inp)
=+ fey=(rose txt sp-ukase:sp)
?- -.fey
%| (ta-erl (lent (tuba (scag p.fey txt))))
%& ?~ p.fey
(ta-erl (lent buf.say.inp))
=. +>+> (se-like u.p.fey)
=. pom pom.tar.maz
(ta-hom:ta-nex %set ~)
==
::
++ ta-ser :: reverse search
|= ext=(list ,@c)
^+ +>
?: |(?=(~ ris) =(0 pos.u.ris)) ta-bel
=+ tot=(weld str.u.ris ext)
=+ dol=(slag (sub num.hit pos.u.ris) old.hit)
=+ sop=pos.u.ris
=+ ^= ser
=+ ^= beg
|= [a=(list ,@c) b=(list ,@c)] ^- ?
?~(a & ?~(b | &(=(i.a i.b) $(a t.a, b t.b))))
|= [a=(list ,@c) b=(list ,@c)] ^- ?
?~(a & ?~(b | |((beg a b) $(b t.b))))
=+ ^= sup
|- ^- (unit ,@ud)
?~ dol ~
?: (ser tot i.dol)
`sop
$(sop (dec sop), dol t.dol)
?~ sup ta-bel
(ta-mov(str.u.ris tot, pos.u.ris (dec u.sup)) (dec u.sup))
::
++ ta-tan :: print tanks
|= tac=(list tank)
=+ wol=`wall`(zing (turn tac |=(a=tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>+>.^$ (se-blit %out (tuba i.wol)))
::
++ ta-txt :: hear text
|= txt=(list ,@c)
^+ +>
?^ ris
(ta-ser txt)
%- ta-hom(pos.inp (add (lent txt) pos.inp))
:- %mor
|- ^- (list sole-edit)
?~ txt ~
[[%ins pos.inp i.txt] $(pos.inp +(pos.inp), txt t.txt)]
::
++ ta-vew :: computed prompt
|- ^- (pair ,@ud (list ,@c))
?^ ris
%= $
ris ~
cad.pom
:(welp "(reverse-i-search)'" (tufa str.u.ris) "': ")
==
=- [(add pos.inp (lent p.vew)) (weld (tuba p.vew) q.vew)]
^= vew ^- (pair tape (list ,@c))
?: vis.pom [cad.pom buf.say.inp]
:- ;: welp
cad.pom
?~ buf.say.inp ~
;: welp
"<"
(scow %p (end 4 1 (sham buf.say.inp)))
"> "
==
==
=+ len=(lent buf.say.inp)
|- ^- (list ,@c)
?:(=(0 len) ~ [`@c`'*' $(len (dec len))])
--
--
++ peer
|= [from pax=path]
^- (quip move +>)
:: ~& [%sole-peer ost src pax]
?< (~(has by bin) ost)
:- [ost %diff %dill-blit %pro [`@c`0x23 `@c`0x20 ~]]~
%= +>
bin
%+ ~(put by bin) ost
^- source
:* 80
0
~
~
:* %&
*(unit search)
*history
`sole-prompt`[%& %sole "{(scow %p our.hid)}# "]
*sole-command
==
~
[0 ~]
==
==
::
++ poke-dill-belt
|= [from bet=dill-belt]
^- (quip move +>)
:: ~& [%sole-poke ost src bet]
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-poke-stale ost]
[~ +>.$]
=< se-abet
=< se-view
(~(se-belt se [~ ~] [src ost] u.yog) bet)
::
++ diff-sole-effect
|= [then fec=sole-effect]
^- (quip move +>)
:: ~& [%diff-sole-effect way]
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-diff-stale ost way]
[~ +>.$]
?> ?=([@ @ @ ~] way)
=< se-abet
=< se-view
=+ gyl=[(slav %p i.t.way) i.t.t.way]
(~(se-diff se [~ ~] [(slav %p i.way) ost] u.yog) gyl fec)
::
++ coup
|= [then saw=(unit tang)]
^- (quip move +>)
?~ saw [~ +>]
:_ +> :_ ~
[ost %flog ~ %crud %coup u.saw]
::
++ reap
|= [then saw=(unit tang)]
^- (quip move +>)
?~ saw [~ +>]
:_ +> :_ ~
`move`[ost %flog ~ %crud %reap u.saw]
::
++ quit
|= then
^- (quip move +>)
[~ +>]
::
++ onto
|= [then saw=(each suss tang)]
:_ +> :_ ~
?- -.saw
%| [ost %flog ~ %crud `@tas`-.way `tang`p.saw]
%& [ost %flog ~ %text "<{<p.saw>}>"]
==
::
++ pull
|= from
^- (quip move +>)
:: ~& [%sole-pull ost]
=^ moz +>
=< se-abet
=< se-view
~(se-kill se [~ ~] [our.hid ost] (~(got by bin) ost))
[moz +>.$(bin (~(del by bin) ost))]
--

1733
base/ape/talk/core.hook Normal file

File diff suppressed because it is too large Load Diff

View File

@ -36,6 +36,7 @@
== ::
++ dill-flog :: sent to %dill
$% [%crud p=%hax-init [%leaf p=tape] ~] :: initialize ship
[%heft ~] :: weigh memory
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
@ -180,6 +181,13 @@
[ost %pass /verb %d %flog %verb ~]
==
::
++ he-wish-mass
%_ .
moz
:_ moz
[ost %pass /heft %d %flog %heft ~]
==
::
++ he-wish-init
|= him=ship
%_ +>.$
@ -429,6 +437,11 @@
~& %poke-helm-verb
he-abet:he-wish-verb:(hake ost her)
::
++ poke-helm-mass
|= [ost=bone her=ship ~]
~& %poke-helm-mass
he-abet:he-wish-mass:(hake ost her)
::
++ poke-helm-init
|= [ost=bone her=ship him=ship]
~& %poke-helm-init

View File

@ -8,9 +8,16 @@
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
== ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%diff p=cage] :: subscription output
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
== ::
++ gift :: out result <-$
$% [%hear p=lane q=@] :: receive packet
[%init p=@p] :: report install
[%mass p=mass] :: memory usage
[%send p=lane q=@] :: transmit packet
[%waft p=sock q=*] :: response message
[%wart p=sock q=@tas r=path s=*] :: network request
@ -30,6 +37,7 @@
[%sith p=@p q=@uw r=?] :: imperial generator
[%wake ~] :: timer activate
[%want p=sock q=path r=*] :: send message
[%wegh ~] :: report memory
[%wont p=sock q=path r=*] :: e2e send message
== ::
++ move ,[p=duct q=(mold note gift)] :: local move
@ -39,6 +47,11 @@
== == ::
$: %a :: to %ames
$% [%kick p=@da] ::
== == ::
$: %b :: to %behn
$% [%rote p=sack q=path r=*] ::
[%roth p=sack q=path r=*] ::
[%mess p=[@p %ye ~] q=@p r=cage] ::
== == ::
$: %g :: to %gall
$% [%rote p=sack q=path r=*] ::
@ -53,6 +66,10 @@
++ sign :: in result $<-
$? $: %a :: from %ames
$% [%went p=ship q=cape] ::
== == ::
$: %b :: from %gall
$% [%unto p=cuft] ::
[%mack p=(unit tang)] :: message ack
== == ::
$: %g :: from %gall
$% [%mean p=ares] ::
@ -440,7 +457,7 @@
vix=(bex +((cut 0 [25 2] mag))) :: width of sender
tay=(cut 0 [27 5] mag) :: message type
==
?> =(3 vez)
?> =(4 vez)
?> =(chk (end 0 20 (mug bod)))
:+ [(end 3 wix bod) (cut 3 [wix vix] bod)]
(kins tay)
@ -460,7 +477,7 @@
=+ tay=(ksin q.kec)
%+ mix
%+ can 0
:~ [3 3]
:~ [3 4]
[20 (mug bod)]
[2 yax]
[2 qax]
@ -1043,7 +1060,7 @@
++ gnaw :: gnaw:am
|= [kay=cape ryn=lane pac=rock] :: process packet
^- [p=(list boon) q=fort]
?. =(3 (end 0 3 pac)) [~ fox]
?. =(4 (end 0 3 pac)) [~ fox]
=+ kec=(bite pac)
?: (goop p.p.kec) [~ fox]
?. (~(has by urb.ton.fox) q.p.kec)
@ -1054,7 +1071,7 @@
%- ~(chew la:(ho:(um q.p.kec) p.p.kec) kay ryn %none (shaf %flap pac))
[q.kec r.kec]
::
++ goop
++ goop :: blacklist
|= him=ship
|
::
@ -1621,6 +1638,7 @@
++ load
|= old=fort
^+ ..^$
~& %ames-reload
..^$(fox old)
::
++ scry
@ -1667,6 +1685,7 @@
[hen [%slip %a %kick now]]
[hen [%slip %e %init p.bon]]
[hen [%slip %g %init p.bon]]
[hen [%slip %b %init p.bon]] :: temporary %behn
[hen [%slip %d %init p.bon]] :: must be after gall
~
==
@ -1697,7 +1716,7 @@
:+ (scot %p p.p.bon)
(scot %p q.p.bon)
q.q.bon
[hen %pass pax %g %rote p.bon /helm 0 %m %will wil]~
[hen %pass pax %b %rote p.bon /helm 0 %m %will wil]~
?> ?=([@ @ *] t.q.q.bon)
:_ fox
=+ [cak=i.t.q.q.bon ven=i.t.t.q.q.bon]
@ -1772,6 +1791,26 @@
:~ :- (claw p.p.bon)
[%sick %wart p.bon i.t.q.q.bon t.t.q.q.bon r.bon]
==
::
%be :: %behn request
=* imp t.t.q.q.bon
?> (levy imp (sane %ta))
=+ ^= pax
:+ (scot %p p.p.bon)
(scot %p q.p.bon)
q.q.bon
:: ~& [%ames-behn-request p.bon imp pax]
:_ fox [hen %pass pax %b %rote p.bon imp r.bon]~
::
%bh :: %behn response
=* imp t.t.q.q.bon
?> (levy imp (sane %ta))
=+ ^= pax
:+ (scot %p p.p.bon)
(scot %p q.p.bon)
q.q.bon
:: ~& [%ames-behn-response p.bon imp pax]
:_ fox [hen %pass pax %b %roth p.bon imp r.bon]~
::
%ge :: %gall request
=* imp t.t.q.q.bon
@ -1819,16 +1858,19 @@
?- +<.sih
%crud [[[hen [%slip %d %flog +.sih]] ~] +>]
%went [~ +>]
%mack ?~ +>.sih $(sih [%g %nice ~])
$(sih [%g %mean `[%mack +>+.sih]])
%unto ~|([%ames-unto tea hen +>-.sih] !!)
?(%mean %nice)
?: ?=([%ye ~] tea)
[~ +>.$]
?> ?=([@ @ @ *] tea)
=+ soq=[(slav %p i.tea) (slav %p i.t.tea)]
=+ pax=t.t.tea
:: ~& [%knap soq num pax]
=+ ^= fuy
=< zork =< zank
%^ ~(rack am [now fox]) soq pax
:: ~& [%knap-ack ?-(+<.sih %mean `p.+.sih, %nice ~)]
?-(+<.sih %mean `p.+.sih, %nice ~)
=> %_(. fox q.fuy)
=| out=(list move)
@ -1842,8 +1884,11 @@
++ knob
|= [hen=duct kyz=kiss]
^- [(list move) _+>]
?: ?=([%crud *] kyz)
?: ?=(%crud -.kyz)
[[[hen [%slip %d %flog kyz]] ~] +>]
?: ?=(%wegh -.kyz)
~& %ames-weighing
[[hen %give %mass wegh]~ +>]
=+ ^= fuy
^- [p=(list boon) q=fort]
?- -.kyz
@ -1945,4 +1990,11 @@
[~ `@ud`p.p.q.i.lew.wod.u.fod]
?~ val.saf.u.gys ~
[~ `@ud`p.i.val.saf.u.gys]
::
++ wegh
^- mass
:- %|
:~ fox/`fox
:: cor/`.
==
--

1145
base/arvo/behn.hoon Normal file

File diff suppressed because it is too large Load Diff

View File

@ -20,8 +20,8 @@
++ gift :: out result <-$
$% [%ergo p=@p q=@tas r=@ud s=(list ,[path (unit mime)])]
:: version update
[%mere p=(each (set path) (pair term (list tank)))]
:: merge result
[%mass p=mass] :: memory usage
[%mere p=(each (set path) (pair term tang))] :: merge result
[%note p=@tD q=tank] :: debug message
[%writ p=riot] :: response
== ::
@ -39,6 +39,7 @@
[%plug p=@p q=@tas r=@p s=@tas] :: unset upstream
[%wart p=sock q=@tas r=path s=*] :: network request
[%warp p=sock q=riff] :: file request
[%wegh ~] :: report memory
== ::
++ mery ::
$: gem=germ :: strategy
@ -2578,6 +2579,14 @@
%c
[%warp [p.p.q.hic p.p.q.hic] ryf]
==
::
%wegh
:_ ..^$ :_ ~
:^ hen %give %mass
:- %|
:~ ruf/`ruf
:: cor/`..^$
==
==
::
++ doze

View File

@ -59,12 +59,26 @@
++ gill (pair ship term) :: general contact
-- ::
=> |% :: console protocol
++ axle :: all dill state
++ old-axle :: all dill state
$: %2 ::
ore=(unit ship) :: identity once set
hey=(unit duct) :: default duct
dug=(map duct axon) :: conversations
== ::
++ axle :: all dill state
$: %3 ::
ore=(unit ship) :: identity once set
hey=(unit duct) :: default duct
dug=(map duct axon) :: conversations
$= hef :: other weights
$: a=(unit mass) ::
c=(unit mass) ::
e=(unit mass) ::
f=(unit mass) ::
g=(unit mass) ::
t=(unit mass) ::
== ::
== ::
++ axon :: dill per duct
$: ram=term :: console program
tem=(unit (list dill-belt)) :: pending, reverse
@ -94,8 +108,9 @@
[%sav p=path q=@] :: save to file
== ::
++ flog :: sent to %dill
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
$% [%crud p=@tas q=(list tank)] :: error with trace
[%heft ~] :: system memory
[%text p=tape] :: print text
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
@ -105,6 +120,7 @@
[%blit p=(list blit)] :: terminal output
[%init p=@p] :: set owner
[%logo ~] :: logout
[%mass p=mass] :: memory usage
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
@ -117,6 +133,7 @@
[%flog p=flog] :: wrapped error
[%flow p=@tas q=(list gill)] :: terminal config
[%hail ~] :: terminal refresh
[%heft ~] :: system memory
[%hook ~] :: this term hung up
[%harm ~] :: all terms hung up
[%init p=ship] :: after gall ready
@ -143,6 +160,7 @@
== ::
++ note-dill :: note to self, odd
$% [%crud p=@tas q=(list tank)] ::
[%heft ~] ::
[%init p=ship] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
@ -156,11 +174,12 @@
[%took p=[p=ship q=path] q=ship] ::
== ::
++ note ::
$? [?(%a %c %e %f %g %t) %wegh ~] ::
$% [%a note-ames] :: out request $->
[%c note-clay] ::
[%d note-dill] ::
[%g note-gall] ::
== ::
== == ::
++ riff ,[p=desk q=(unit rave)] :: see %clay
++ sign-ames ::
$% [%nice ~] ::
@ -184,12 +203,13 @@
$% [%wake ~] ::
== ::
++ sign :: in result $<-
$? [?(%a %c %e %f %g %t) %mass p=mass] ::
$% [%a sign-ames] ::
[%c sign-clay] ::
[%d sign-dill] ::
[%g sign-gall] ::
[%t sign-time] ::
== ::
== == ::
:::::::: :: dill tiles
--
=| all=axle
@ -215,6 +235,7 @@
%crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
%blew (send %rez p.p.kyz q.p.kyz)
%heft heft
%veer (dump kyz)
%vega (dump kyz)
%verb (dump kyz)
@ -260,6 +281,19 @@
(dump %logo ~)
(done %blit [bit ~])
::
++ heft
%_ .
moz
:* [hen %pass /heft/ames %a %wegh ~]
[hen %pass /heft/clay %c %wegh ~]
[hen %pass /heft/eyre %e %wegh ~]
[hen %pass /heft/ford %f %wegh ~]
[hen %pass /heft/gall %g %wegh ~]
[hen %pass /heft/time %t %wegh ~]
moz
==
==
::
++ init :: initialize
~& [%dill-init our]
=+ myt=(flop (need tem))
@ -300,10 +334,55 @@
:_(moz [hen %pass ~ %g %took [our [ram ~]] our])
==
::
++ wegh
^- mass
:- %|
:~ ore/`ore.all
hey/`hey.all
dug/`dug.all
:: cor/`..as
==
::
++ wegt
|= [lal=?(%a %c %e %f %g %t) mas=mass]
^+ +>
=. hef.all
?- lal
%a ~?(?=(^ a.hef.all) %double-mass-a hef.all(a `mas))
%c ~?(?=(^ c.hef.all) %double-mass-c hef.all(c `mas))
%e ~?(?=(^ e.hef.all) %double-mass-e hef.all(e `mas))
%f ~?(?=(^ f.hef.all) %double-mass-f hef.all(f `mas))
%g ~?(?=(^ g.hef.all) %double-mass-g hef.all(g `mas))
%t ~?(?=(^ t.hef.all) %double-mass-t hef.all(t `mas))
==
?. ?& ?=(^ a.hef.all)
?=(^ c.hef.all)
?=(^ e.hef.all)
?=(^ f.hef.all)
?=(^ g.hef.all)
?=(^ t.hef.all)
==
+>.$
%+ done(hef.all [~ ~ ~ ~ ~ ~])
%mass
=> [hef.all d=wegh]
:- %|
:~ ames/u.a
clay/u.c
dill/d
eyre/u.e
ford/u.f
gall/u.g
time/u.t
==
::
++ take :: receive
|= sih=sign
|= [tea=wire sih=sign]
^+ +>
?- sih
[?(%a %c %e %f %g %t) %mass *]
(wegt -.sih p.sih)
::
[%a %nice *]
:: ~& [%take-nice-ames sih]
+>
@ -311,14 +390,14 @@
[%a %init *]
+>(moz :_(moz [hen %give +.sih]))
::
[%c %mere *]
[%c %mere *] :: i don't think we get these anymore
?: ?=(%& -.p.sih)
+>.$
~| %dill-mere-fail
~| p.p.p.sih
|-
?~ q.p.p.sih !!
~> %mean.|.(i.q.p.p.sih) :: interpolate ford fail into stack trace
~> %mean.|.(i.q.p.p.sih) :: interpolate ford fail into stack trace
$(q.p.p.sih t.q.p.p.sih)
::
[%c %note *]
@ -425,7 +504,9 @@
~
::
++ load :: trivial
|= old=axle
|= old=?(old-axle axle)
?: ?=(%2 -.old)
$(old [%3 ore hey dug ~ ~ ~ ~ ~ ~]:old)
..^$(all old)
:: |= old=* :: diable
:: ..^$(ore.all `~zod)
@ -454,6 +535,6 @@
[~ ..^$]
=+ our=?>(?=(^ ore.all) u.ore.all)
=^ moz all
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) q.hin)
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) tea q.hin)
[moz ..^$]
--

480
base/arvo/doll.hoon Normal file
View File

@ -0,0 +1,480 @@
!:
:: dill (4d), terminal handling
::
|= pit=vase
=> |% :: interface tiles
++ console-action :: console to app
$% [%det console-change] :: edit prompt line
[%inn ~] :: enter session
[%out ~] :: exit session
[%ret ~] :: submit and clear
== ::
++ console-buffer (list ,@c) :: command state
++ console-change :: network change
$: ler=console-clock :: destination clock
haw=@uvH :: source hash
ted=console-edit :: state change
== ::
++ console-clock ,[own=@ud his=@ud] :: vector clock
++ console-edit :: shared state change
$% [%del p=@ud] :: delete one at
[%ins p=@ud q=@c] :: insert at
[%mor p=(list console-edit)] :: combination
[%nop ~] :: no-op
[%set p=console-buffer] :: discontinuity
== ::
++ console-effect :: app to console
$% [%bel ~] :: beep
[%blk p=@ud q=@c] :: blink/match char at
[%clr ~] :: clear screen
[%det console-change] :: edit input
[%nex ~] :: save and clear input
[%tan p=(list tank)] :: classic tank
:: [%taq p=tanq] :: modern tank
[%txt p=tape] :: text line
== ::
++ dill-belt :: console input
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%cru p=@tas q=(list tank)] :: echo error
[%ctl p=@c] :: control-key
[%del ~] :: true delete
[%met p=@c] :: meta-key
[%ret ~] :: return
[%rez p=@ud q=@ud] :: resize, cols, rows
[%txt p=(list ,@c)] :: utf32 text
[%yow p=gill] :: connect to app
== ::
++ dill-blit :: console output
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%mor p=(list dill-blit)] :: multiple blits
[%pro p=(list ,@c)] :: show as cursor/line
[%qit ~] :: close console
[%out p=(list ,@c)] :: send output line
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
== ::
++ gill (pair ship term) :: general contact
-- ::
=> |% :: console protocol
++ axle :: all dill state
$: %2 ::
ore=(unit ship) :: identity once set
hey=(unit duct) :: default duct
dug=(map duct axon) :: conversations
== ::
++ axon :: dill per duct
$: ram=term :: console program
tem=(unit (list dill-belt)) :: pending, reverse
wid=_80 :: terminal width
pos=@ud :: cursor position
see=(list ,@c) :: current line
== ::
-- => ::
|% :: protocol below
++ blew ,[p=@ud q=@ud] :: columns rows
++ belt :: raw console input
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%ctl p=@c] :: control-key
[%del ~] :: true delete
[%met p=@c] :: 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
== ::
++ flog :: sent to %dill
$% [%crud p=@tas q=(list tank)] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ gift :: out result <-$
$% [%bbye ~] :: reset prompt
[%blit p=(list blit)] :: terminal output
[%init p=@p] :: set owner
[%logo ~] :: logout
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ 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
[%flow p=@tas q=(list gill)] :: terminal config
[%hail ~] :: terminal refresh
[%hook ~] :: this term hung up
[%harm ~] :: all terms hung up
[%init p=ship] :: after gall ready
[%noop ~] :: no operation
[%talk p=tank] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
-- => ::
|% :: protocol outward
++ mess ::
$% [%dill-belt p=(hypo dill-belt)] ::
== ::
++ club :: agent action
$% [%peer p=path] :: subscribe
[%poke p=cage] :: apply
[%pull ~] :: unsubscribe
[%pump ~] :: pump yes/no
== ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
[%diff p=cage] :: subscription output
== ::
++ cuss (pair term club) :: internal kiss
++ suss (trel term ,@tas ,@da) :: config report
++ move ,[p=duct q=(mold note gift)] :: local move
++ note-ames :: weird ames move
$% [%make p=(unit ,@t) q=@ud r=@ s=?] ::
[%sith p=@p q=@uw r=?] ::
== ::
++ note-clay ::
$% [%font p=@p q=@tas r=@p s=@tas] ::
[%warp p=sock q=riff] :: wait for clay, hack
== ::
++ note-dill :: note to self, odd
$% [%crud p=@tas q=(list tank)] ::
[%init p=ship] ::
[%text p=tape] ::
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ note-behn ::
$% [%conf dock %load ship desk] ::
[%deal p=sock q=cuss] ::
== ::
++ note :: out request $->
$% [%a note-ames] ::
[%b note-behn] ::
[%c note-clay] ::
[%d note-dill] ::
== ::
++ riff ,[p=desk q=(unit rave)] :: see %clay
++ sign-ames ::
$% [%nice ~] ::
[%init p=ship] ::
== ::
++ sign-behn :: see %behn
$% [%onto p=(unit tang)] ::
== ::
++ sign-clay ::
$% [%mere p=(each (set path) (pair term tang))] ::
[%note p=@tD q=tank] ::
[%writ p=riot] ::
== ::
++ sign-dill ::
$% [%blit p=(list blit)] ::
== ::
++ sign-behn ::
$% [%onto p=(each suss tang)] ::
[%unto p=cuft] ::
== ::
++ sign-time ::
$% [%wake ~] ::
== ::
++ sign :: in result $<-
$% [%a sign-ames] ::
[%b sign-behn] ::
[%c sign-clay] ::
[%d sign-dill] ::
[%t sign-time] ::
== ::
:::::::: :: dill tiles
--
=| all=axle
|= [now=@da eny=@ ski=sled] :: current invocation
=> |%
++ as :: per cause
|_ $: [moz=(list move) hen=duct our=ship]
axon
==
++ abet :: resolve
^- [(list move) axle]
[(flop moz) all(dug (~(put by dug.all) hen +<+))]
::
++ call :: receive input
|= kyz=kiss
^+ +>
?+ -.kyz ~& [%strange-kiss -.kyz] +>
%flow +>
%harm +>
%hail +>
%belt (send `dill-belt`p.kyz)
%text (from %out (tuba p.kyz))
%crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
%blew (send %rez p.p.kyz q.p.kyz)
%veer (dump kyz)
%vega (dump kyz)
%verb (dump kyz)
==
::
++ crud
|= [err=@tas tac=(list tank)]
=+ ^= wol ^- wall
:- (trip err)
(zing (turn tac |=(a=tank (~(win re a) [0 wid]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>.^$ (from %out (tuba i.wol)))
::
++ dump :: pass down to hey
|= git=gift
?> ?=(^ hey.all)
+>(moz [[u.hey.all %give git] moz])
::
++ done :: return gift
|= git=gift
+>(moz :_(moz [hen %give git]))
::
++ from :: receive belt
|= bit=dill-blit
^+ +>
?: ?=(%mor -.bit)
|- ^+ +>.^$
?~ p.bit +>.^$
$(p.bit t.p.bit, +>.^$ ^$(bit i.p.bit))
?: ?=(%out -.bit)
%+ done %blit
:~ [%lin p.bit]
[%mor ~]
[%lin see]
[%hop pos]
==
?: ?=(%pro -.bit)
(done(see p.bit) %blit [[%lin p.bit] [%hop pos] ~])
?: ?=(%hop -.bit)
(done(pos p.bit) %blit [bit ~])
?: ?=(%qit -.bit)
(dump %logo ~)
(done %blit [bit ~])
::
++ init :: initialize
~& [%dill-init our]
=+ myt=(flop (need tem))
=. tem ~
<<<<<<< HEAD:urb/zod/base/arvo/dill.hoon
=. moz :_(moz [hen %pass / %c %font our %home our %base])
=. moz :_(moz [hen %pass / %g %show [our [ram ~]] our ~])
=======
=. moz :_(moz [hen %pass ~ %b %conf [[our ram] %load our %main]])
=. moz :_(moz [hen %pass ~ %b %deal [our our] ram %peer ~])
>>>>>>> newgall^:urb/zod/arvo/dill.hoon
|- ^+ +>
?~ myt +>
$(myt t.myt, +> (send i.myt))
::
++ into :: preinitialize
|= gyl=(list gill)
%_ +>
tem `(turn gyl |=(a=gill [%yow a]))
moz
:_ moz
:* hen
%pass
/
%c
[%warp [our our] %base `[%sing %y [%ud 1] /]]
==
==
::
++ send :: send action
|= bet=dill-belt
?^ tem
+>(tem `[bet u.tem])
%_ +>
moz
:_ moz
[hen %pass ~ %b %deal [our our] ram %poke [%dill-belt -:!>(bet) bet]]
==
::
++ pump :: send diff ack
%_ .
moz
:_(moz [hen %pass ~ %b %deal [our our] ram %pump ~])
==
::
++ take :: receive
|= sih=sign
^+ +>
?- sih
[%a %nice *]
:: ~& [%take-nice-ames sih]
+>
::
[%a %init *]
+>(moz :_(moz [hen %give +.sih]))
::
[%c %mere *]
?: ?=(%& -.p.sih)
+>.$
~| %dill-mere-fail
~| p.p.p.sih
|-
?~ q.p.p.sih !!
~> %mean.|.(i.q.p.p.sih) :: interpolate ford fail into stack trace
$(q.p.p.sih t.q.p.p.sih)
::
[%b %onto *]
:: ~& [%take-behn-onto +>.sih]
?- -.+>.sih
%| (crud %onto p.p.+>.sih)
%& (done %blit [%lin (tuba "{<p.p.sih>}")]~)
==
::
[%b %unto *]
:: ~& [%take-behn-unto +>.sih]
?- -.+>.sih
%coup ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
%quit !! :: ??
%reap ?~(p.p.+>.sih +>.$ (crud %reap u.p.p.+>.sih))
%diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih))
==
::
[%c %note *]
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
::
[%c %writ *]
init
::
[%d %blit *]
(done +.sih)
::
[%t %wake *]
:: ~& %dill-wake
+>
==
--
::
++ ax :: make ++as
|= [hen=duct kyz=kiss] ::
?~ ore.all ~
=+ nux=(~(get by dug.all) hen)
?^ nux
(some ~(. as [~ hen u.ore.all] u.nux))
?. ?=(%flow -.kyz) ~
%- some
%. q.kyz
%~ into as
:- [~ hen u.ore.all]
:* p.kyz
[~ ~]
80
0
(tuba "<{(trip p.kyz)}>")
==
--
|% :: 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)
==
?: ?=(%boot -.q.hic)
:_(..^$ [hen %pass ~ (note %a p.q.hic)]~)
?: ?=(%flog -.q.hic)
:: ~& [%dill-flog +.q.hic]
?: ?=([%crud %hax-init [%leaf *] ~] p.q.hic)
=+ him=(slav %p (crip p.i.q.p.q.hic))
:_(..^$ ?~(hey.all ~ [u.hey.all %give %init him]~))
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d p.q.hic]~))
=. hey.all ?^(hey.all hey.all `hen)
?: ?=(%init -.q.hic)
:: ~& [%call-init hen]
?: =(ore.all `p.q.hic)
[[hen %give q.hic]~ ..^$]
=: ore.all `p.q.hic
dug.all ~
==
=+ ^= flo ^- (list (pair ship term))
=+ myr=(clan p.q.hic)
?: =(%pawn myr)
[[p.q.hic %dojo] ~]
?: =(%earl myr)
=+ fap=(sein p.q.hic)
[[fap %dojo] [fap %talk] [fap %helm] ~]
[[p.q.hic %dojo] [p.q.hic %talk] [p.q.hic %helm] ~]
=^ moz all abet:(need (ax (need hey.all) [%flow %sole flo]))
?: |((lth p.q.hic 256) (gte p.q.hic (bex 64))) [moz ..^$] :: XX HORRIBLE
[:_(moz [(need hey.all) %give %init p.q.hic]) ..^$]
=+ nus=(ax hen q.hic)
?~ nus
~& [%dill-no-flow q.hic]
[~ ..^$]
=^ moz all abet:(call:u.nus q.hic)
[moz ..^$]
::
++ doze
|= [now=@da hen=duct]
^- (unit ,@da)
~
::
++ load :: trivial
|= old=axle
..^$(all old)
:: |= old=* :: diable
:: ..^$(ore.all `~zod)
::
++ scry
|= [fur=(unit (set monk)) ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit cage))
[~ ~]
::
++ stay all
::
++ take :: process move
|= [tea=wire hen=duct hin=(hypo sign)]
^- [p=(list move) q=_..^$]
?: =(~ ore.all)
?: ?=([%a %init *] q.hin)
:: ~& [%take-init hen]
=. hey.all ?^(hey.all hey.all `hen)
[[[hen %give +.q.hin] ~] ..^$]
:: [~ ..^$]
~& [%take-back q.hin]
[~ ..^$]
?. (~(has by dug.all) hen)
~& [%take-weird-sign q.hin]
~& [%take-weird-hen hen]
[~ ..^$]
=+ our=?>(?=(^ ore.all) u.ore.all)
=^ moz all
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) q.hin)
[moz ..^$]
--
:: good test

View File

@ -5,7 +5,8 @@
=> =~
|% :: interfaces
++ gift :: out result <-$
$% [%thou p=httr] :: raw http response
$% [%mass p=mass] :: memory usage
[%thou p=httr] :: raw http response
[%thus p=@ud q=(unit hiss)] :: http request/cancel
[%veer p=@ta q=path r=@t] :: drop-through
[%vega p=path] :: drop-through
@ -28,6 +29,7 @@
[%this p=? q=clip r=httq] :: inbound request
[%thud ~] :: inbound cancel
[%wart p=sack q=@tas r=_`[path *]`*gram] :: urbit message
[%wegh ~] :: report memory
== ::
++ move ,[p=duct q=(mold note gift)] :: local move
++ note :: out request $->
@ -234,7 +236,12 @@
::
++ add-json :: inject window.urb
|= [urb=json jaz=cord] ^- cord
(cat 3 (crip "window.urb = {(pojo urb)}\0a") jaz)
=- (cat 3 (crip -) jaz)
"""
var _urb = {(pojo urb)}
window.urb = window.urb || \{}; for(k in _urb) window.urb[k] = _urb[k]
"""
::
++ ares-to-json
|= err=ares ^- json
@ -266,7 +273,7 @@
urb.tries = 0
urb.call = function() {
urb.wreq = new XMLHttpRequest()
urb.wreq.open('GET', urb.poll, true)
urb.wreq.open('GET', urb.wurl, true)
urb.wreq.addEventListener('load', function() {
// if(~~(this.status / 100) == 4)
// return document.write(this.responseText)
@ -285,11 +292,11 @@
}
urb.call()
urb.wasp = function(deh){
var old = /[^/]*$/.exec(urb.poll)[0]
var old = /[^/]*$/.exec(urb.wurl)[0]
var deps = old.replace(/^on.json\?|.json$/,'').split('&')
if (deps.indexOf(deh) !== -1) return;
deps.push(deh)
urb.poll = "/~/on.json?"+deps.join('&')
urb.wurl = "/~/on.json?"+deps.join('&')
urb.wreq.abort() // trigger keep
}
'''
@ -422,7 +429,7 @@
=. p.p.pul |(p.p.pul ?=(hoke r.p.pul))
=+ her=(host-to-ship r.p.pul)
?: |(?=(~ her) =(our u.her))
(handle pul q.+.kyz [p.heq maf s.heq])
(handle pul [q.+.kyz anon] [p.heq maf s.heq])
=+ han=(sham hen)
=. pox (~(put by pox) han hen)
(ames-gram u.her [%get ~] han +.kyz)
@ -477,6 +484,8 @@
=. sop (~(put by sop) p.u.mez q.p.kyz |)
(ames-gram q.p.kyz hat/~ p.u.mez our-host)
==
::
%wegh !!
==
::
++ axon :: accept response
@ -671,7 +680,7 @@
::
++ handle
|= $: [hat=hart pok=pork quy=quay] :: purl, parsed url
cip=clip :: client ip
[cip=clip him=ship] :: client ip, ship
[mef=meth maf=math bod=(unit octs)] :: method/headers/body
==
=< apex
@ -930,8 +939,7 @@
%mess
:- %|
=^ orx ..ya ?:(is-anon new-view:for-client [(need grab-oryx) ..ya])
=+ vew=(ire-ix (oryx-to-ixor orx))
=+ [him=him.vew cay=[%json !>(`json`s.hem)]]
=+ [vew=(ire-ix (oryx-to-ixor orx)) cay=[%json !>(`json`s.hem)]]
?: ?=(%json q.hem) ((teba new-mess.vew) p.hem r.hem cay)
%+ pass-note [%to (oryx-to-ixor orx) (scot %p p.p.hem) q.p.hem r.hem]
(ford-req root-beak [%cast q.hem %done ~ cay])
@ -939,7 +947,7 @@
%poll
?: ?=([~ %js] p.pok) :: XX treat non-json cases?
=+ polling-url=['/' (apex:earn %| pok(u.p %json) quy)]
[%& %js (add-json (joba %poll (jape polling-url)) poll:js)]
[%& %js (add-json (joba %wurl (jape polling-url)) poll:js)]
|-
=. done (new-dependency i.p.hem %& hen)
?~ t.p.hem [%| done]
@ -989,7 +997,7 @@
%get
~| aute/ham
?: |(=(anon him.ham) (~(has in aut.yac) him.ham))
process(pok rem.ham, ..ya abet.yac(him him.ham))
process(him him.ham, pok rem.ham)
?. =(our him.ham)
[%| ((teba foreign-auth.yac) him.ham hat rem.ham quy)]
(show-login-page ~)
@ -1028,7 +1036,7 @@
(new-ya (rsh 3 1 (scot %p (end 6 1 ney))))
~| bad-cookie/u.lig
=+ cyz=(~(got by wup) u.lig)
~(. ya u.lig cyz(cug ~))
~(. ya u.lig cyz(him him, cug ~))
::
++ new-ya |=(ses=hole ~(. ya ses (new-cyst ses)))
++ new-cyst
@ -1251,6 +1259,13 @@
((hard kiss) q.hic)
==
^- [p=(list move) q=_..^$]
?: ?=(%wegh -.q.hic)
:_ ..^$ :_ ~
:^ hen %give %mass
:- %|
:~ bol/`bol
:: cor/`..^$
==
=+ our=`@p`0x100 :: XX sentinel
=+ ska=(slod ski)
=+ sky=|=(* `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a]))))

View File

@ -10,6 +10,7 @@
++ bead ,[p=(set beam) q=gage] :: computed result
++ gift :: out result <-$
$% [%made p=@uvH q=(each gage tang)] :: computed result
[%mass p=mass] :: memory usage
[%news ~] :: fresh depends
== ::
++ heel path :: functional ending
@ -51,6 +52,7 @@
++ kiss :: in request ->$
$% [%exec p=@p q=beak r=(unit silk)] :: make / kill
[%wasp p=@p q=@uvH] :: depends query
[%wegh ~] :: report memory
== ::
++ milk (trel ship desk silk) :: sourced silk
++ move ,[p=duct q=(mold note gift)] :: local move
@ -210,10 +212,6 @@
=+ gib=(wox p.n.r.arc)
?~(gib rac [[u.gib p.n.r.arc] rac])
::
++ slob :: XX belongs in h/h
|= [cog=@tas typ=type]
(~(has in (sa (sloe typ))) cog)
::
++ norm :: normalize beam rev
|= [ska=sled bem=beam]
%_ bem
@ -1653,6 +1651,13 @@
|= [hen=duct hic=(hypo (hobo kiss))]
^- [p=(list move) q=_..^$]
=> .(q.hic ?.(?=(%soft -.q.hic) q.hic ((hard kiss) p.q.hic)))
?: ?=(%wegh -.q.hic)
:_ ..^$ :_ ~
:^ hen %give %mass
:- %|
:~ lex/`lex
:: cor/`..^$
==
=+ ^= our ^- @p
?- -.q.hic
%exec p.q.hic

View File

@ -10,11 +10,26 @@
== ::
++ bead ,[p=(set beam) q=gage] :: computed result
++ bone ,@ud :: opaque duct
++ club :: agent action
$% [%peer p=path] :: subscribe
[%poke p=cage] :: apply
[%pull ~] :: unsubscribe
[%pump ~] :: pump yes/no
== ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%diff p=cage] :: subscription output
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
== ::
++ cuss (pair term club) :: internal kiss
++ suss (trel term ,@tas ,@da) :: config report
++ gift :: out result <-$
$% [%back p=?] :: %mess ack good/bad
[%crud p=@tas q=(list tank)] :: physical error
[%dumb ~] :: close duct
[%gone p=hapt] :: app death
[%mass p=mass] :: memory usage
[%mean p=ares] :: message failure
[%meta p=vase] :: meta-gift
[%nice ~] :: message success
@ -31,6 +46,7 @@
[%rote p=sack q=path r=*] :: remote request
[%roth p=sack q=path r=*] :: remote response
[%took p=hapt q=ship] :: remote acknowledge
[%wegh ~] :: report memory
[%wipe p=hapt] :: forget app
== ::
++ knob :: pending action
@ -57,6 +73,12 @@
++ note :: out request $->
$? $: %a :: to %ames
$% [%wont p=sock q=path r=*] ::
== == ::
$: %b :: to %behn
$% [%deal p=sock q=cuss] :: full transmission
== == ::
$: %c :: to %clay
$% [%warp p=sock q=riff] ::
== == ::
$: %f :: to %ford
$% [%exec p=@p q=beak r=(unit silk)] ::
@ -136,6 +158,10 @@
$% [%init p=@p] :: only for :begin
[%woot p=ship q=coop] ::
[%went p=ship q=cape] :: only for apps
== == ::
$: %b :: by %behn
$% [%onto p=(each suss tang)] ::
[%unto p=cuft] ::
== == ::
$: %g :: by %gall
$% [%init p=@p] ::
@ -213,6 +239,7 @@
|% :: vane interface
++ call :: handle request
|= [hen=duct hic=(hypo (hobo kiss))]
^- [p=(list move) q=_..^$]
=> .(q.hic ?.(?=(%soft -.q.hic) q.hic ((hard kiss) p.q.hic)))
?- -.q.hic
%init
@ -223,6 +250,14 @@
::
%roth
(gawd hen p.q.hic q.q.hic ((hard ,[@ud roon]) r.q.hic))
::
%wegh
:_ ..^$ :_ ~
:^ hen %give %mass
:- %|
:~ all/`all
:: cor/`..^$
==
::
%wipe
=+ mat=(~(got by pol.all) p.p.q.hic)

View File

@ -61,6 +61,7 @@
[%many p=(list coin)] ::
== ::
++ cord ,@t :: text atom (UTF-8)
++ dock (pair ,@p term) :: message target
++ date ,[[a=? y=@ud] m=@ud t=tarp] :: parsed date
++ dime ,[p=@ta q=@] ::
++ each |*([a=$+(* *) b=$+(* *)] $%([& p=a] [| p=b])) :: either a or b
@ -101,6 +102,8 @@
++ nail ,[p=hair q=tape] :: parsing input
++ numb ,@ :: just a number
++ pair |*([a=$+(* *) b=$+(* *)] ,[p=a q=b]) :: just a pair
++ quid |*([a=$+(* *) b=*] ,[a _b]) :: for =^
++ quip |*([a=$+(* *) b=*] ,[(list a) _b]) :: for =^
++ wand |* a=(pole $+(* *)) :: hetero list
|= b=* ::
?~ a ~ ::
@ -4930,6 +4933,194 @@
=((scam bb ss) (ward u.rr (scam u.aa h)))
::
--
::
++ scr :: scrypt
~% %scr + ~
|%
++ sal |= [x=@ r=@] :: salsa20 hash
?> =((mod r 2) 0) :: with r rounds
=+ few==>(fe .(a 5))
=+ ^= rot
|= [a=@ b=@]
(mix (end 5 1 (lsh 0 a b)) (rsh 0 (sub 32 a) b))
=+ ^= lea
|= [a=@ b=@]
(net:few (sum:few (net:few a) (net:few b)))
=> |% ++ qr :: quarterround
|= y=[@ @ @ @ ~]
=+ zb=(mix &2.y (rot 7 (sum:few &1.y &4.y)))
=+ zc=(mix &3.y (rot 9 (sum:few zb &1.y)))
=+ zd=(mix &4.y (rot 13 (sum:few zc zb)))
=+ za=(mix &1.y (rot 18 (sum:few zd zc)))
~[za zb zc zd]
++ rr :: rowround
|= [y=(list ,@)]
=+ za=(qr ~[&1.y &2.y &3.y &4.y])
=+ zb=(qr ~[&6.y &7.y &8.y &5.y])
=+ zc=(qr ~[&11.y &12.y &9.y &10.y])
=+ zd=(qr ~[&16.y &13.y &14.y &15.y])
^- (list ,@) :~
&1.za &2.za &3.za &4.za
&4.zb &1.zb &2.zb &3.zb
&3.zc &4.zc &1.zc &2.zc
&2.zd &3.zd &4.zd &1.zd
==
++ cr :: columnround
|= [x=(list ,@)]
=+ ^= y %- rr ^- (list ,@) :~
&1.x &5.x &9.x &13.x
&2.x &6.x &10.x &14.x
&3.x &7.x &11.x &15.x
&4.x &8.x &12.x &16.x
==
^- (list ,@) :~
&1.y &5.y &9.y &13.y
&2.y &6.y &10.y &14.y
&3.y &7.y &11.y &15.y
&4.y &8.y &12.y &16.y
==
++ dr :: doubleround
|= [x=(list ,@)]
(rr (cr x))
++ al :: add two lists
|= [a=(list ,@) b=(list ,@)]
|- ^- (list ,@)
?~ a ~ ?~ b ~
[i=(sum:few -.a -.b) t=$(a +.a, b +.b)]
--
=+ xw=(rpp 5 16 x)
=+ ^= ow |- ^- (list ,@)
?~ r xw
$(xw (dr xw), r (sub r 2))
(rep 5 (al xw ow))
::
++ rpp |= [a=bloq b=@ c=@] :: rip w/filler blocks
=+ q=(rip a c)
=+ w=(lent q)
?. =(w b)
?. (lth w b) (slag (sub w b) q)
^+ q (weld q (reap (sub b (lent q)) 0))
q
::
++ xrl |= [a=(list ,@) b=(list ,@)] :: xor lists
|- ^- (list ,@)
?~ a b ?~ b a
[i=(mix -.a -.b) t=$(a +.a, b +.b)]
::
++ xrm |= [a=(list (list ,@)) b=(list (list ,@))]
|- ^- (list (list ,@))
?~ a b ?~ b a
[i=(xrl -.a -.b) t=$(a +.a, b +.b)]
::
++ bls |= [a=@ b=(list ,@)] :: split to sublists
?> =((mod (lent b) a) 0)
|- ^- (list (list ,@))
?~ b ~
[i=(scag a `(list ,@)`b) t=$(b (slag a `(list ,@)`b))]
::
++ slb |= [a=(list (list ,@))]
|- ^- (list ,@)
?~ a ~
(weld `(list ,@)`-.a $(a +.a))
::
++ sbm |= [r=@ b=(list ,@)] :: scryptBlockMix
?> =((lent b) (mul 2 r))
=+ [x=(snag (dec (mul 2 r)) b) c=0]
=| [ya=(list ,@) yb=(list ,@)]
|- ^- (list ,@)
?~ b (flop (weld yb ya))
=. x (sal (mix x -.b) 8)
?~ (mod c 2)
$(c +(c), b +.b, ya [i=x t=ya])
$(c +(c), b +.b, yb [i=x t=yb])
::
++ srm |= [r=@ b=(list ,@) n=@] :: scryptROMix
?> ?&
=((lent b) (mul 2 r))
=(n (bex (dec (xeb n))))
(lth n (bex (mul r 16)))
==
=| v=(list (list ,@))
=+ c=0
=. v
|- ^- (list (list ,@))
=+ w=(sbm r b)
?: =(c n) (flop v)
$(c +(c), v [i=[b] t=v], b w)
=+ x=(sbm r (snag (dec n) v))
|- ^- (list ,@)
?: =(c n) x
=+ q=(snag (dec (mul r 2)) x)
$(x (sbm r (xrl x (snag (mod q n) v))), c +(c))
::
++ hmc |= [k=@ t=@] :: HMAC-SHA-256
(hml k (met 3 k) t (met 3 t))
::
++ hml |= [k=@ kl=@ t=@ tl=@] :: w/length
=. k (end 3 kl k) =. t (end 3 tl t)
=+ b=64
=. k ?. (gth kl b) k (shay kl k)
=+ ^= q %+ shay (add b tl)
(add (lsh 3 b t) (mix k (fil 3 b 0x36)))
%+ shay (add b 32)
(add (lsh 3 b q) (mix k (fil 3 b 0x5c)))
::
++ pbk ~/ %pbk :: PBKDF2-HMAC-SHA256
|= [p=@ s=@ c=@ d=@]
(pbl p (met 3 p) s (met 3 s) c d)
::
++ pbl ~/ %pbl :: w/length
|= [p=@ pl=@ s=@ sl=@ c=@ d=@]
=. p (end 3 pl p) =. s (end 3 sl s)
=+ h=32
?> ?& (lte d (bex 30)) :: max key length 1GB
(lte c (bex 28)) :: max iterations 2^28
!=(c 0)
==
=+ ^= l ?~ (mod d h)
(div d h)
+((div d h))
=+ r=(sub d (mul h (dec l)))
=+ [t=0 j=1 k=1]
=. t |- ^- @
?: (gth j l) t
=+ u=(add s (lsh 3 sl (rep 3 (flop (rpp 3 4 j)))))
=+ f=0 =. f |- ^- @
?: (gth k c) f
=+ q=(hml p pl u ?:(=(k 1) (add sl 4) h))
$(u q, f (mix f q), k +(k))
$(t (add t (lsh 3 (mul (dec j) h) f)), j +(j))
(end 3 d t)
::
++ hsh ~/ %hsh :: scrypt
|= [p=@ s=@ n=@ r=@ z=@ d=@]
(hsl p (met 3 p) s (met 3 s) n r z d)
::
++ hsl ~/ %hsl :: w/length
|= [p=@ pl=@ s=@ sl=@ n=@ r=@ z=@ d=@]
=| v=(list (list ,@))
=. p (end 3 pl p) =. s (end 3 sl s)
=+ u=(mul (mul 128 r) z)
?> ?& =(n (bex (dec (xeb n)))) :: n is power of 2
!=(r 0) !=(z 0)
%+ lte :: max 1GB memory
(mul (mul 128 r) (dec (add n z)))
(bex 30)
(lth pl (bex 31))
(lth sl (bex 31))
==
=+ ^= b =+ %^ rpp 3 u
(pbl p pl s sl 1 u)
%+ turn (bls (mul 128 r) -)
|=(a=(list ,@) (rpp 9 (mul 2 r) (rep 3 a)))
?> =((lent b) z)
=+ ^= q
=+ |- ?~ b (flop v)
$(b +.b, v [i=(srm r -.b n) t=v])
%+ turn `(list (list ,@))`-
|=(a=(list ,@) (rpp 3 (mul 128 r) (rep 9 a)))
(pbl p pl (rep 3 (slb q)) u 1 d)
--
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 2eY, SHA-256 (move me) ::
::
@ -5781,6 +5972,14 @@
|= [cog=@tas typ=type]
!=(~ q:(~(fino ut typ) 0 %free cog))
::
++ slob :: superficial arm
|= [cog=@tas typ=type]
^- ?
?+ typ |
[%hold *] $(typ ~(repo ut typ))
[%core *] (~(has by q.r.q.typ) cog)
==
::
++ sloe :: get arms in core
|= typ=type
^- (list term)
@ -9016,7 +9215,7 @@
++ expv |.(;~(gunk lobe wisp)) :: tile, core tail
++ expw |.(;~(gunk lobe teak)) :: tile and tiki
++ expx |.((butt ;~(gunk teak race))) :: tiki, [tile twig]s
++ expy |.((butt ;~(gunk teak loaf race))) :: tiki twig [tile twig]s
++ expy |.((butt ;~(gunk teak loaf race))) :: tk twig [tile twig]s
++ expz |.(loaf(bug &)) :: twig with tracing
:: Hint syntaces (nock 10)
++ hinb |.(;~(gunk bont loaf)) :: hint and twig
@ -9397,12 +9596,13 @@
++ cage (cask vase) :: global metadata
++ cask |*(a=_,* (pair mark a)) :: global data
++ cuff :: permissions
$: p=kirk :: readers
q=(set monk) :: authors
$: p=(unit (set monk)) :: can be read by
q=(set monk) :: caused or created by
== ::
++ curd ,[p=@tas q=*] :: typeless card
++ duct (list wire) :: causal history
++ gage (pair marc vase) :: structured cage
++ from ,[ost=bone src=ship] :: forward problem
++ hide :: standard app state
$: $: our=ship :: owner/operator
app=term :: app identity
@ -9437,6 +9637,7 @@
$% [%tabl p=(list (pair marc marc))] :: map
== ::
++ mark ,@tas :: content type
++ mass (each noun (list (pair cord ,mass))) :: memory usage
++ mill (each vase milt) :: vase/metavase
++ milt ,[p=* q=*] :: metavase
++ monk (each ship khan) :: general identity
@ -9458,6 +9659,7 @@
++ slad $+ [(unit (set monk)) term beam] :: undertyped
(unit (unit (cask))) ::
++ slut $+(* (unit (unit))) :: old namespace
++ then ,[ost=bone src=ship way=wire] :: backward problem
++ vile :: reflexive constants
$: typ=type :: -:!>(*type)
duc=type :: -:!>(*duct)
@ -9801,6 +10003,7 @@
|= [lac=? gum=muse]
^- [[p=(list ovum) q=(list muse)] _niz]
:: =. lac |(lac ?=(?(%g %f) p.gum))
:: =. lac &(lac !?=(%b p.gum))
%+ fire
p.gum
?- -.r.gum
@ -9882,6 +10085,20 @@
$(ova t.ova, +>+.^$ (veer now q.i.ova))
?: ?=(%vega -.q.i.ova)
(vega now t.ova (path +.q.i.ova))
?: ?=(%mass -.q.i.ova)
=+ avo=$(ova t.ova)
:_ +.avo
:_ -.avo
%= i.ova
q.q
:- %|
:~ [%hoon `pit]
[%zuse `bud]
[%hoon-cache `p.niz]
[%vanes q.q.i.ova]
[%dot `.]
==
==
=+(avo=$(ova t.ova) [[i.ova -.avo] +.avo])
++ wish |=(* (^wish ((hard ,@ta) +<))) :: 20
--

View File

@ -1,6 +1,6 @@
:: :: %time, just a timer
!? 164
::::
!:::
|= pit=vase
=> =~
|%
@ -12,13 +12,17 @@
== ::
++ broq |* [a=_,* b=_,*] :: brodal skew qeu
(list (sqeu a b)) ::
++ weight
(each noun (list (pair tape weight)))
++ gift :: out result <-$
$% [%wake ~] :: wakey-wakey
$% [%mass p=mass] :: memory usage
[%wake ~] :: wakey-wakey
== ::
++ kiss :: in request ->$
$% [%rest p=@da] :: cancel alarm
[%wait p=@da] :: set alarm
[%wake ~] :: timer activate
[%wegh ~] :: report memory
== ::
++ move ,[p=duct q=(mold note gift)] :: local move
++ note ,~ :: out request $->
@ -169,12 +173,16 @@
==
=^ mof tym
?- -.q.hic
%rest =. q.tym (~(put up q.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
%wait =. p.tym (~(put up p.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
%rest
=. q.tym (~(put up q.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
::
%wait
=. p.tym (~(put up p.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
::
%wake
|- ^+ [*(list move) tym]
=. tym (raze tym)
@ -183,9 +191,20 @@
?: (lte now p.nex) [~ tym]
=^ mof tym $(p.tym ~(pop up p.tym))
[[`move`[q.nex %give %wake ~] mof] tym]
::
%wegh
:_ tym :_ ~
:^ hen %give %mass
:- %|
:~ tym/`tym
:: cor/`..^$
==
==
[mof ..^$]
::
++ foo
%bar
::
++ doze
|= [now=@da hen=duct]
^- (unit ,@da)

View File

@ -1894,10 +1894,6 @@
cip=(each ,@if ,@is) :: client IP
cum=(map ,@tas ,*) :: custom dirt
== ::
++ cuff :: permissions
$: p=(unit (set monk)) :: readers
q=(set monk) :: authors
== ::
++ deed ,[p=@ q=step r=?] :: sig, stage, fake?
++ dome :: project state
$: ank=ankh :: state

View File

@ -21,6 +21,7 @@
=+ all=.*(0 ken)
=+ ^= vay ^- (list ,[p=@tas q=@tas])
:~ [%$ %zuse]
[%b %behn]
[%g %gall]
[%f %ford]
[%a %ames]

View File

@ -65,7 +65,7 @@
?- -.dex
%del ?:((lte p.sin p.dex) dex(p +(p.dex)) dex)
%ins ?: =(p.sin p.dex)
?:((lth q.sin q.dex) dex dex(p +(p.dex)))
?:((gth q.sin q.dex) dex dex(p +(p.dex)))
?:((lte p.sin p.dex) dex(p +(p.dex)) dex)
==
==
@ -85,8 +85,7 @@
++ inverse :: relative inverse
|= ted=sole-edit
^- sole-edit
:: =. ted ?.(?=([%mor * ~] ted) ted i.p.ted) :: XX why?
~| [ted abet]
=. ted ?.(?=([%mor * ~] ted) ted i.p.ted)
?- -.ted
%del [%ins p.ted (snag p.ted buf)]
%ins [%del p.ted]
@ -103,14 +102,13 @@
++ receive :: naturalize event
|= sole-change
^- [sole-edit sole-share]
~| [ler ven]
?> &(=(his.ler his.ven) (lte own.ler own.ven))
?> |(!=(own.ler own.ven) =(haw (sham buf)) =(haw 0)) :: trust the clock
?> &(=(his.ler his.ven) (lte own.ler own.ven))
?> |(!=(own.ler own.ven) =(0 haw) =(haw (sham buf)))
=. leg (scag (sub own.ven own.ler) leg)
:: ~? !=(own.ler own.ven) [%miss-leg leg]
=+ dat=(transmute [%mor (flop leg)] ted)
=+ dat=(transmute [%mor leg] ted)
:: ~? !=(~ leg) [%transmute from/ted to/dat ~]
:: =- ~& (tufa buf) -
[dat abet:(apply(his.ven +(his.ven)) dat)]
::
++ remit :: conditional accept
@ -126,7 +124,6 @@
++ transmit :: outgoing change
|= ted=sole-edit
^- [sole-change sole-share]
:: =- ~& (tufa buf) -
[[[his.ven own.ven] (sham buf) ted] (commit ted)]
::
++ transceive :: receive and invert

View File

@ -12,5 +12,5 @@ is a general-purpose computing stack designed to live in the cloud.
------------------------------------------------------------------------
If you're new to the system, take a look at some of the
[guides](doc/guides) to get oriented. Come join us on `:chat` to ask
[guides](doc/guide) to get oriented. Come join us on `:chat` to ask
questions and get help.

View File

@ -80,7 +80,13 @@ module.exports = recl
_input: (e) ->
text = @$writing.text()
length = text.length
# geturl = new RegExp "(^|[ \t\r\n])((ftp|http|https|gopher|mailto|news|nntp|telnet|wais|file|prospero|aim|webcal):(([A-Za-z0-9$_.+!*(),;/?:@&~=-])|%[A-Fa-f0-9]{2}){2,}(#([a-zA-Z0-9][a-zA-Z0-9$_.+!*(),;/?:@&~=%-]*))?([A-Za-z0-9$_+!*();/?:~-]))", "g"
# geturl = new RegExp [
# '(^|[ \t\r\n])((ftp|http|https|gopher|mailto|'
# 'news|nntp|telnet|wais|file|prospero|aim|webcal'
# '):(([A-Za-z0-9$_.+!*(),;/?:@&~=-])|%[A-Fa-f0-9]{2}){2,}'
# '(#([a-zA-Z0-9][a-zA-Z0-9$_.+!*(),;/?:@&~=%-]*))?'
# '([A-Za-z0-9$_+!*();/?:~-]))'
# ].join() , "g"
# urls = text.match(geturl)
# if urls isnt null and urls.length > 0
# for url in urls