mirror of
https://github.com/urbit/shrub.git
synced 2024-12-15 21:03:10 +03:00
598 lines
24 KiB
Plaintext
598 lines
24 KiB
Plaintext
:: :: ::
|
|
:::: /hook/core/dojo/app :: ::
|
|
:: :: ::
|
|
/? 314 :: zuse version
|
|
/- *console :: console structures
|
|
/+ console :: console library
|
|
:: :: ::
|
|
:::: :: ::
|
|
!: :: ::
|
|
=> |% :: external structures
|
|
++ house :: all state
|
|
$: hoc=(map bone session) :: conversations
|
|
== ::
|
|
++ session :: per conversation
|
|
$: say=console-share :: command-line state
|
|
poy=(unit dojo-project) :: working
|
|
var=(map term cage) :: variable state
|
|
old=(set term) :: used TLVs
|
|
== ::
|
|
++ dojo-command ::
|
|
$% [%poke p=goal q=dojo-source] :: make and poke
|
|
[%save p=term q=dojo-source] :: save/print
|
|
[%show p=dojo-source] :: print
|
|
== ::
|
|
++ dojo-source :: construction node
|
|
$: p=@ud :: assembly index
|
|
q=dojo-build :: general build
|
|
== ::
|
|
++ dojo-build :: one ford step
|
|
$& [p=dojo-build q=dojo-build] :: build cell
|
|
$% [%ex p=twig] :: hoon expression
|
|
[%fi p=(list dojo-filter) q=dojo-build] :: filter pipeline
|
|
[%fo p=dojo-model] :: form
|
|
[%sc p=dojo-model] :: script
|
|
[%va p=term] :: dojo variable
|
|
== ::
|
|
++ dojo-filter :: pipeline filter
|
|
$% [%a p=twig] :: direct gate
|
|
[%b p=mark] :: simple transmute
|
|
[%c p=dojo-model] :: full filter
|
|
== ::
|
|
++ dojo-model :: data construction
|
|
$: p=dojo-server :: core source
|
|
q=dojo-config :: configuration
|
|
== ::
|
|
++ dojo-server :: numbered device
|
|
$: p=@ud :: assembly index
|
|
q=dojo-device :: loadable
|
|
== ::
|
|
++ dojo-device :: core devices
|
|
$% [%& p=term] :: general device
|
|
[%| p=term q=path] :: special device
|
|
== ::
|
|
++ dojo-config :: configuration
|
|
$: p=(list dojo-source) :: by order
|
|
q=(map term dojo-source) :: by keyword
|
|
== ::
|
|
++ dojo-problem (each dojo-source dojo-server) :: construction problem
|
|
++ dojo-project :: construction state
|
|
$: mad=dojo-command :: operation
|
|
num=@ud :: number of tasks
|
|
cur=@ud :: currently solving
|
|
pro=(unit vase) :: prompting loop
|
|
idl=? :: not calling ford
|
|
per=(unit console-edit) :: pending reverse
|
|
job=(map ,@ud dojo-problem) :: problems
|
|
rez=(map ,@ud cage) :: results
|
|
== ::
|
|
++ bead ,[p=(set beam) q=cage] :: computed result
|
|
++ goal ,[p=ship q=term] :: flat application
|
|
++ gift :: out result <-$
|
|
$% [%mean p=ares] :: error
|
|
[%nice ~] :: acknowledge
|
|
[%rush %console-effect console-effect] ::
|
|
== ::
|
|
++ hapt ,[p=ship q=path] ::
|
|
++ move ,[p=bone q=(mold note gift)] ::
|
|
++ 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]
|
|
== ::
|
|
++ note-ford :: note to ford
|
|
$% [%exec p=@p q=(unit silk)] :: make / kill
|
|
== ::
|
|
++ note-gall :: note to %gall
|
|
$% [%mess p=[p=ship q=path] q=ship r=cage] ::
|
|
== ::
|
|
++ sign-gall :: sign from %gall
|
|
$% [%mean p=ares] ::
|
|
[%nice ~] ::
|
|
== ::
|
|
++ sign-ford :: sign from ford
|
|
$% [%made p=(each bead (list tank))] :: computed result
|
|
== ::
|
|
++ note :: out request $->
|
|
$% [%f note-ford] ::
|
|
[%g note-gall] ::
|
|
== ::
|
|
++ sign :: in result $<-
|
|
$% [%f sign-ford] ::
|
|
[%g sign-gall] ::
|
|
== ::
|
|
-- ::
|
|
:: ::
|
|
:::: ::
|
|
:: ::
|
|
|_ $: 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 zap
|
|
;~(plug dp-goal ;~(pfix ace dp-source))
|
|
==
|
|
::
|
|
%+ stag %save
|
|
;~ pfix tis
|
|
;~(plug 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
|
|
(ifix [sel ser] dp-many)
|
|
;~(pfix col (stag %fo dp-model))
|
|
;~(pfix bar (stag %sc dp-model))
|
|
;~(pfix buc (stag %va sym))
|
|
(stag %ex dp-twig)
|
|
==
|
|
++ dp-many :: ++dojo-build
|
|
%+ cook
|
|
|= a=(list dojo-build)
|
|
^- dojo-build
|
|
?~(a !! ?~(t.a i.a [i.a $(a t.a)]))
|
|
(most ace dp-build)
|
|
::
|
|
++ dp-goal :: ++goal
|
|
%+ cook |=(a=goal a)
|
|
;~ pose
|
|
;~ plug
|
|
;~(pfix sig fed:ag)
|
|
;~(pfix fas sym)
|
|
==
|
|
(cook |=(a=term `goal`[our.hid a]) sym)
|
|
==
|
|
++ dp-model ;~(plug dp-server dp-config) :: ++dojo-model
|
|
++ dp-server (stag 0 dp-device) :: ++dojo-server
|
|
++ dp-twig wide:(vang & ~) :: ++twig
|
|
++ dp-device :: ++dojo-device
|
|
%+ cook
|
|
|= [a=term b=path]
|
|
^- dojo-device
|
|
?~(b [%& a] [%| a b])
|
|
;~(plug sym (more fas sym))
|
|
::
|
|
++ dp-value :: ++dojo-source
|
|
%+ cook |=(a=dojo-source a)
|
|
%+ stag 0
|
|
;~ pose
|
|
(ifix [kel ker] dp-many)
|
|
(stag %va ;~(pfix buc sym))
|
|
(stag %ex dp-twig)
|
|
==
|
|
::
|
|
++ dp-config :: ++dojo-config
|
|
%+ cook |=(a=dojo-config a)
|
|
;~ plug
|
|
(more ;~(plug com ace) dp-value)
|
|
%+ cook
|
|
|= a=(list (pair term (unit dojo-source)))
|
|
%- ~(gas by *(map term dojo-source))
|
|
%+ turn a
|
|
|= b=(pair term (unit dojo-source))
|
|
[p.b ?~(q.b [0 %ex [%dtzy %f &]] u.q.b)]
|
|
%+ 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 :: silk to ford
|
|
|= [pax=path kas=silk]
|
|
^+ +>+>
|
|
(he-pass(poy `+>+<(idl %|)) pax %f %exec our.hid `kas)
|
|
::
|
|
++ dy-slam :: call by ford
|
|
|= [pax=path gat=vase sam=vase]
|
|
^+ +>+>
|
|
(dy-ford pax %call [%done ~ %noun gat] [%done ~ %noun sam])
|
|
::
|
|
++ dy-rush :: send effects, abet
|
|
|= fec=console-effect
|
|
^+ +>+>
|
|
(he-rush(poy `+>+<) fec)
|
|
::
|
|
++ dy-rash :: send effects, amok
|
|
|= fec=console-effect
|
|
^+ +>+>
|
|
(he-rush(poy ~) fec)
|
|
::
|
|
++ dy-init-command :: ++dojo-command
|
|
|= mad=dojo-command
|
|
^+ [mad +>]
|
|
?- -.mad
|
|
%poke =^(src +>.$ (dy-init-source q.mad) [[%poke p.mad src] +>.$])
|
|
%save =^(src +>.$ (dy-init-source q.mad) [[%save p.mad src] +>.$])
|
|
%show =^(src +>.$ (dy-init-source p.mad) [[%show p.mad] +>.$])
|
|
==
|
|
::
|
|
++ 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 [%& src]))]
|
|
::
|
|
++ dy-init-build :: ++dojo-build
|
|
|= bul=dojo-build
|
|
^+ [bul +>]
|
|
?^ -.bul
|
|
=^ one +>.$ $(bul -.bul)
|
|
=^ two +>.$ $(bul +.bul)
|
|
[[one two] +>.$]
|
|
?- -.bul
|
|
%ex [bul +>.$]
|
|
%fi !!
|
|
%fo =^(mod +>.$ (dy-init-model p.bul) [[%fo mod] +>.$])
|
|
%sc !!
|
|
%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 [%| 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 dojo-source)
|
|
^+ [key +>.$]
|
|
?~ key [~ +>.$]
|
|
=^ top +>.$ (dy-init-source 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-work :: console action
|
|
|= act=console-action
|
|
?- -.act
|
|
%det (he-stir +.act)
|
|
%ret (he-done (tufa buf.say))
|
|
==
|
|
::
|
|
++ dy-hand :: complete step
|
|
|= cag=cage
|
|
^+ +>+>
|
|
dy-step(cur +(cur), rez (~(put by rez) cur cag))
|
|
::
|
|
++ dy-made-edit :: console edit
|
|
|= cag=cage
|
|
^+ +>+>
|
|
?> ?=(^ per)
|
|
?^ q.q.cag
|
|
~& %dy-made-edit-good
|
|
dy-abet(per ~)
|
|
~& %dy-made-edit-bad
|
|
=^ lic say (~(transmit cs say) u.per)
|
|
(dy-rush(per ~) %mor [%bel ~] [%det lic] ~)
|
|
::
|
|
++ dy-made-make :: created prompt
|
|
|= cag=cage
|
|
^+ +>+>
|
|
~& %dy-made-make
|
|
(dy-slam /dial q.cag [[%atom %n] ~])
|
|
::
|
|
++ dy-made-dial :: dialog result
|
|
|= cag=cage
|
|
?. ?=([~ ~ a=* b=*] q.q.cag)
|
|
~& %dy-made-init-fail
|
|
(dy-rash %bel ~)
|
|
=. +>+>
|
|
?: =(a.q.q.cag ~)
|
|
+>+>
|
|
(he-rush %tan ((list tank) a.q.q.cag))
|
|
?+ -.b.q.q.cag (dy-rash %bel ~)
|
|
%&
|
|
?~ +.b.q.q.cag
|
|
(dy-rash %bel ~)
|
|
(dy-hand %noun (slot 63 q.cag))
|
|
::
|
|
%|
|
|
(dy-rush(pro `(slot 63 q.cag)) %pro (console-prompt +<.b.q.q.cag))
|
|
==
|
|
::
|
|
++ dy-done
|
|
|= txt=tape
|
|
~& %dy-done
|
|
?> ?=(^ pro)
|
|
(dy-slam /dial u.pro (slop [[%atom %n] ~] !>(txt)))
|
|
::
|
|
++ dy-over :: finish construction
|
|
^+ +>
|
|
?- -.mad
|
|
%poke
|
|
%- he-pass(poy ~)
|
|
:* /poke
|
|
%g
|
|
%mess
|
|
[p.p.mad [q.p.mad ~]]
|
|
our.hid
|
|
(~(got by rez) p.q.mad)
|
|
==
|
|
::
|
|
%save
|
|
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=console-change
|
|
^+ +>+>
|
|
=+ old=buf.say
|
|
=^ dat say (~(receive cs say) cal)
|
|
=. dat (~(inverse cs say(buf old)) dat)
|
|
?: |(?=(^ per) !idl ?=(~ pro))
|
|
~& %dy-edit-busy
|
|
=^ lic say (~(transmit cs say) dat)
|
|
(dy-rush %mor [%det lic] [%bel ~] ~)
|
|
(dy-slam(per `dat) /edit u.pro !>(buf.say))
|
|
::
|
|
++ dy-work :: handle input
|
|
|= act=console-action
|
|
^+ +>+>
|
|
?- -.act
|
|
%det (dy-edit +.act)
|
|
%ret (dy-done (tufa buf.say))
|
|
==
|
|
::
|
|
++ dy-silk-build :: build to silk
|
|
|= bul=dojo-build
|
|
^- silk
|
|
?^ -.bul [$(bul -.bul) $(bul +.bul)]
|
|
?+ -.bul !!
|
|
%ex [%ride p.bul [%reef ~]]
|
|
==
|
|
::
|
|
++ dy-silk-device :: device to silk
|
|
|= dov=dojo-device
|
|
^- silk
|
|
:* %boil
|
|
%noun
|
|
:- [our.hid %main %da lat.hid]
|
|
?- -.dov
|
|
%& [%mad p.dov ~]
|
|
%| [%app p.dov %mad q.dov]
|
|
==
|
|
~
|
|
==
|
|
::
|
|
++ dy-step :: advance project
|
|
^+ +>
|
|
?: =(cur num)
|
|
dy-over
|
|
=+ pob=(~(got by job) cur)
|
|
?- -.pob
|
|
%& (dy-ford /hand (dy-silk-build q.p.pob))
|
|
%| (dy-ford /make (dy-silk-device q.p.pob))
|
|
==
|
|
--
|
|
::
|
|
++ 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.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-give :: emit gift
|
|
|= git=gift
|
|
^+ +>
|
|
%_(+> moz [[ost %give git] moz])
|
|
::
|
|
++ he-pass
|
|
|= [pax=path noy=note]
|
|
~& [%he-pass pax noy]
|
|
%_(+> moz [[ost %pass pax noy] moz])
|
|
::
|
|
++ he-rush :: emit update
|
|
|= fec=console-effect
|
|
^+ +>
|
|
(he-give %rush %console-effect fec)
|
|
::
|
|
++ he-peer :: subscribe to
|
|
he-prom
|
|
::
|
|
++ he-prom :: send prompt
|
|
%- he-rush
|
|
:- %pro
|
|
[& %$ (tuba (weld (scow %p our.hid) ":dojo> "))]
|
|
::
|
|
++ he-ford :: result from ford
|
|
|= [pax=path rey=(each bead (list tank))]
|
|
^+ +>
|
|
?> ?=(^ poy)
|
|
?- -.rey
|
|
%& =+ dye=~(. dy u.poy)
|
|
=. idl.dye &
|
|
?+ pax ~&(%he-ford-path !!)
|
|
[%hand ~] (dy-hand:dye q.p.rey)
|
|
[%dial ~] (dy-made-dial:dye q.p.rey)
|
|
[%make ~] (dy-made-make:dye q.p.rey)
|
|
[%edit ~] (dy-made-edit:dye q.p.rey)
|
|
==
|
|
%| (he-rush(poy ~) %tan p.rey)
|
|
==
|
|
::
|
|
++ he-like :: accept line
|
|
|= buf=(list ,@c)
|
|
=(%& -:(he-dope (tufa buf)))
|
|
::
|
|
++ he-stir :: apply change
|
|
|= cal=console-change
|
|
^+ +>
|
|
=^ dut say (~(remit cs say) cal he-like)
|
|
?~ dut
|
|
+>.$
|
|
(he-rush %mor [%det u.dut] [%bel ~] ~)
|
|
::
|
|
++ he-plan :: execute command
|
|
|= mad=dojo-command
|
|
^+ +>
|
|
?> ?=(~ poy)
|
|
=< dy-step
|
|
~(dy-init dy mad [0 0 ~ %& ~ ~ ~])
|
|
::
|
|
++ he-done :: parse command
|
|
|= txt=tape
|
|
^+ +>
|
|
=+ doy=(he-duke txt)
|
|
?- -.doy
|
|
%|
|
|
%- he-rush
|
|
:~ %mor
|
|
[%tan [%leaf "syntax error at {<p.doy>}"]~]
|
|
[%bel ~]
|
|
==
|
|
::
|
|
%&
|
|
=+ old=(weld "> " (tufa buf.say))
|
|
=^ cal say (~(transmit cs say) [%set ~])
|
|
%. p.doy
|
|
=< he-plan
|
|
%- he-rush
|
|
:~ %mor
|
|
[%txt old]
|
|
[%nex ~]
|
|
[%det cal]
|
|
==
|
|
==
|
|
::
|
|
++ he-work :: apply input
|
|
|= act=console-action
|
|
^+ +>
|
|
?^ poy
|
|
(~(dy-work dy u.poy) act)
|
|
?- -.act
|
|
%det (he-stir +.act)
|
|
%ret (he-done (tufa buf.say))
|
|
==
|
|
--
|
|
::
|
|
++ peer
|
|
|= [ost=bone her=ship pax=path]
|
|
^- [(list move) _+>]
|
|
?< (~(has by hoc) ost)
|
|
?> =(/console pax)
|
|
?> =(her our.hid)
|
|
he-abet:~(he-peer he [ost ~] *session)
|
|
::
|
|
++ poke-console-action
|
|
|= [ost=bone her=ship act=console-action]
|
|
~& %poke-console-action
|
|
^- [(list move) _+>]
|
|
he-abet:(~(he-work he [ost [ost %give %nice ~]~] (~(got by hoc) ost)) act)
|
|
::
|
|
++ pour
|
|
|= [ost=bone pax=path sih=*]
|
|
^- [(list move) _+>]
|
|
=+ sih=((hard sign) sih)
|
|
?- -.sih
|
|
%f
|
|
he-abet:(~(he-ford he [[ost ~] (~(got by hoc) ost)]) pax +>.sih)
|
|
::
|
|
%g !!
|
|
==
|
|
--
|