neo: software distribution

This commit is contained in:
Liam Fitzgerald 2024-05-24 12:45:07 -04:00
parent cdb82bc905
commit b3cd5cdb22
5 changed files with 330 additions and 52 deletions

View File

@ -475,7 +475,7 @@
fu-core
$(fu-core (fu-tone i.lis), lis t.lis)
++ fu-tone
|= [change=pith:neo =case:neo rift=?]
|= [change=pith:neo =case:neo =mode:neo]
^+ fu-core
=/ yel ~(tap by yel:fu-rave)
|-
@ -486,7 +486,7 @@
=; add=?
?. add
$(yel t.yel)
$(yel t.yel, wal :_(wal [pith i.yel rift]))
$(yel t.yel, wal :_(wal [pith i.yel mode]))
?: =(change pith)
&
?: ?=(%y p.i.yel)
@ -1016,6 +1016,30 @@
=. pith [p/our.bowl pith]
(on-card pith %make %ford-riff `vase/riff ~)
--
:: +abduct: check capture
++ abduct
|= [par=pith:neo child=pith:neo]
^- ?
?~ wav=(~(get of:neo tide) par)
|
?~ kids.dock.u.wav
|
?: ?=(%y p.u.kids.dock.u.wav)
=(par (~(parent of:neo tide) child))
!=(~ (dif:pith:neo par child))
:: +adopt: produce all capturing parents
::
++ adopt
=| here=pith:neo
=| res=(set pith:neo)
|= =pith:neo
|- ^+ res
=? res (abduct here pith)
(~(put in res) here)
=/ nex (dif:pith:neo here pith)
?~ nex
res
$(here (snoc here i.nex))
:: +arvo: local callstack
++ arvo
=+ verb=&
@ -1026,9 +1050,8 @@
=| $: done=(list move:neo) :: moves we've completed
down=(list move:neo) :: pending moves for children
up=(list move:neo) :: pending moves for uncles
grit=(list dust:neo) :: raw changelist
change=(map pith mode:neo) :: changeset
changes=(map pith mode:neo) :: also changeset
smut=(list dust:neo) :: total changelist
grit=(list dust:neo) :: changelist not gifted
gifts=(list [pith:neo gift:neo]) :: return values
==
|= =move:neo
@ -1050,7 +1073,7 @@
?: =([~ ~] block)
=. run (emil `(list card)`(do-ack [p p.q]:init-move err.block))
=. run (emil (turn up do-move))
(dial changes)
(dial smut)
:: %+ turn ~(tap by change)
:: |=([=pith:neo =mode:neo] ^+(+< [[p/our.bowl pith] mode]))
:: run
@ -1078,11 +1101,27 @@
?> ?=(^ gifts)
t.gifts
=. here pith
=/ =pail:neo
gift/!>(gift)
=^ cards=(list card:neo) arvo
`arvo :: (soft-site |.(si-abet:(si-poke:site pail)))
(soft-surf |.(su-abet:(su-give:surf gift)))
(ingest cards)
::
++ plunder
^+ arvo
=/ by-parent=(jug pith:neo dust:neo)
%+ roll grit
|= [=dust:neo by-parent=(jug pith:neo dust:neo)]
%- ~(gas ju by-parent)
(turn ~(tap in (adopt pith.dust)) |=(=pith:neo [pith [(dif:pith:neo pith pith.dust) +.dust]]))
:: XX: assert gifts empty
=. gifts
%+ turn (sort ~(tap in ~(key by by-parent)) sort:pith:neo)
|= =pith:neo
^- [pith:neo gift:neo]
[pith (gas-gift ~(tap in (~(get ju by-parent) pith)))]
=. smut (welp smut grit)
=. grit ~
give
::
++ trace-card
|= =move:neo
^- tank
@ -1104,33 +1143,14 @@
(take-dirt-card [p/our.bowl here] %grow pail *oath:neo)
=. grit (welp grit git)
arvo
++ finalize
^+ arvo
:: =. gifts
:: =- ~(tap by -)
:: ^- (map pith:neo gift:neo)
:: %+ roll ~(tap by change)
:: |= [[=pith:neo =mode:neo] out=(map pith:neo gift:neo)]
:: ?~ par=(parent:of-top pith)
:: out
:: =/ parent (~(gut by out) u.par *gift:neo)
:: =. parent (~(put by parent) (sub:pith:neo pith u.par) mode)
:: (~(put by out) u.par parent)
:: =. changes (~(uni by changes) change)
:: =. change *(map pith:neo mode:neo)
:: ?~ gifts
:: arvo
give
:: $(gifts t.gifts)
::
++ work
^+ arvo
|- ^+ arvo
?^ err.block
arvo
?~ down
finalize
plunder
=/ nex=move:neo i.down
=/ new-arvo (apply:arvo(down t.down) nex) :: XX: weird compiler?
$(arvo new-arvo, done (snoc done nex))
@ -1149,7 +1169,6 @@
++ tomb
|= *
:: =. apex (del:of-top here)
=. change (~(put by change) here %del)
work
::
++ apply
@ -1332,6 +1351,14 @@
:: ?>(check-pail) XX: TODO
=. arvo (grow pail)
su-core
::
++ su-give
|= =gift:neo
?. (~(has in poke.dock.wave) %gift)
~& skipping-give/here
su-core
(su-poke gift/!>(gift))
::
++ su-poke
|= =pail:neo
=/ [caz=(list card:neo) new=pail:neo]
@ -1533,6 +1560,16 @@
epic
=. epic (~(put of:neo epic) i.lst)
$(lst t.lst)
::
++ gas-gift
=| =gift:neo
|= lst=(list [pith:neo loot:neo])
^+ gift
?~ lst
gift
=. gift (~(put of:neo gift) i.lst)
$(lst t.lst)
++ gas-lore
=| =lore:neo
|= lst=(list [pith:neo idea:neo])

View File

@ -170,16 +170,6 @@
?~ pie=(ram:on:soil:neo u.fil.loam)
0
key.u.pie
++ rift
|= grow=?
^- ?
?~ fil.loam
grow
?~ old=(ram:on:soil:neo u.fil.loam)
grow
?: grow
=(~ q.val.u.old)
!=(~ q.val.u.old)
++ vest
|= kind=?(%y %z)
^- (map pith:neo case:neo)
@ -198,18 +188,26 @@
::
++ grow
|= [=pail:neo =oath:neo]
^- (quip [case:neo ?] loam:dirt:neo)
^- (quip loot:neo loam:dirt:neo)
=/ =poem:neo [[+(case) oath] `pail]
(make poem)
++ make
|= =poem:neo
^- (quip [case:neo ?] loam:dirt:neo)
^- (quip loot:neo loam:dirt:neo)
=? fil.loam ?=(~ fil.loam)
`*soil:neo
?> ?=(^ fil.loam)
=/ new=case:neo +(case)
?> =(new p.p.poem)
:- [new (rift !=(q.poem ~))]^~
=/ =mode:neo
?: =(q.poem ~)
%del
?~ old=(ram:on:soil:neo u.fil.loam)
%add
?: =(q.val.u.old ~)
%add
%dif
:- [new mode]^~
loam(fil `(put:on:soil:neo u.fil.loam new poem))
::
++ cull
@ -222,13 +220,13 @@
^- (quip gift:dirt:neo _loam)
=/ lom (~(dip of:neo loam) p.card)
%- (trace "call" (print-card card))
=^ gifts=(list [case:neo ?]) lom
=^ gifts=(list loot:neo) lom
?- -.q.card
%grow (~(grow plow lom) +.q.card)
%cull ~(cull plow lom)
==
:_ (~(rep of:neo loam) p.card lom)
(turn gifts |=([@ ?] `gift:dirt:neo`[p.card +<]))
(turn gifts |=(loot:neo `gift:dirt:neo`[p.card +<]))
::
++ look
|= =pith:neo
@ -328,7 +326,8 @@
^- farm:neo
?~ gis
farm
$(farm (eternal [p q r]:i.gis), gis t.gis)
=/ rift |(=(mode.i.gis %add) =(mode.i.gis %del))
$(farm (eternal pith.i.gis case.i.gis rift), gis t.gis)
++ scry
|= [=case:neo =pith:neo]
^- (unit (unit saga:neo))

View File

@ -0,0 +1,182 @@
/@ ford-desk
^- kook:neo
|%
++ state pro/%ford-desk
++ poke (sy %gift ~)
++ kids
:+ ~ %z
%- ~(gas by *lads:neo)
=/ mk |=(=term `pish:neo`[&/term &])
:~ [(mk %src) pro/%hoon ~]
[(mk %out) pro/%vase ~]
[(mk %pre) pro/%vase ~]
==
++ deps *deps:neo
++ form
^- form:neo
=<
|_ [=bowl:neo =aeon:neo stud:neo state-vase=vase]
+* run ~(. +> [bowl ~ !<(ford-desk state-vase)])
++ poke
|= [=stud:neo vax=vase]
^- (quip card:neo pail:neo)
=+ !<(=gift:neo vax)
=+ !<(sta=ford-desk state-vase)
=| cards=(list card:neo)
=/ gis ~(tap of:neo gift)
|-
?~ gis
[cards ford-desk/!>(sta)]
=/ [=pith:neo =loot:neo] i.gis
?: =(mode.loot %dif)
$(gis t.gis)
?. ?=([%src *] pith)
$(gis t.gis)
=/ =prop:neo (pith-to-prop t.pith)
?- mode.loot
%dif $(gis t.gis)
%del $(cards (welp cards (handle-del:run pith)), gis t.gis)
%add
=^ caz=(list card:neo) sta
(handle-add:run prop)
$(cards (welp cards caz), gis t.gis)
==
++ init
|= pal=(unit pail:neo)
^- (quip card:neo pail:neo)
`(need pal)
--
|_ [=bowl:neo cards=(list card:neo) sta=ford-desk]
++ abet [(flop cards) sta]
++ emit |=(=card:neo run(cards [card cards]))
++ run .
++ handle-del
|= =pith:neo
^- (list card:neo)
:~ [(welp here.bowl out/pith) %cull ~]
[(welp here.bowl pre/pith) %cull ~]
==
++ handle-add
|= =prop:neo
^- (quip card:neo _sta)
=< abet
(build-file prop)
::
++ build-file
|= =prop:neo
=/ pax (prop-pith prop)
=+ !<(src=@t q.pail:(~(got of:neo kids.bowl) pax))
=/ =file:ford:neo
~| parsing/pax
(scan (trip src) (rein:ford:neo [our.bowl (tail (welp here.bowl pax))]))
=. run (build-pros (turn pro.file tail))
:: =. run (build-libs (turn lib.file tail))
::M?> built-imports
=^ pre=pith run
(make-prelude prop file)
=/ =conf:neo
(~(gas by *conf:neo) [%sut (welp here.bowl pre)] ~)
=/ pit (prop-pith prop)
(ford-slap out/pit pre src/pit)
++ build-pros
|= pos=(list stud:neo)
^+ run
?~ pos
run
?: ?@(i.pos & =([ship desk]:i.pos [ship desk]:sta))
$(pos t.pos)
=. run (build-pro ?>(?=(^ i.pos) mark.i.pos))
$(pos t.pos)
++ build-pro
|= =mark
?: (~(has of:neo kids.bowl) #/out/pro/[mark])
run
?~ fil=(~(get of:neo kids.bowl) #/src/pro/[mark])
~& missing-dep/mark
run
(build-file pro/mark)
::
++ do-make
|= [=pith:neo lib=term sta=(unit pail:neo) =conf:neo]
(emit (welp here.bowl pith) %make lib sta conf)
::
++ ford-slap
|= [wer=pith sut=pith src=pith]
%^ do-make wer %ford-slap
`(~(gas by *conf:neo) sut/(ours sut) hoon/(ours src) ~)
::
++ slop
|= [wer=pith a=pith b=pith]
~| %ford-slop
%^ do-make wer %ford-slop
`(~(gas by *conf:neo) a/(ours a) b/(ours b) ~)
++ face
|= [wer=pith face=pith sut=pith]
~| %ford-face
%^ do-make wer %ford-face
`(~(gas by *conf:neo) face/(ours face) sut/(ours sut) ~)
++ same
|= [wer=pith from=pith]
~| ford-same/[wer from]
%^ do-make wer %ford-same
`(~(gas by *conf:neo) src/(ours from) ~)
++ ours
|= p=pith:neo `pith:neo`[p/our.bowl p]
++ make-deps
=| idx=@ud
|= [pat=pith deps=(list [face=term =pith])]
^+ run
?~ deps
~| pat
%+ same pat
?: =(0 idx)
#/out/reef
(snoc pat ud/(dec idx))
=/ wer=pith (snoc pat ud/idx)
=/ fac=pith (snoc wer %face)
=/ fav=pith (snoc fac %term)
=. run
(do-make fav %term `term/!>(face.i.deps) ~)
=. run
(face fac fav pith.i.deps)
=/ prev=pith
?: =(idx 0)
#/out/reef
(snoc pat ud/(dec idx))
=. run
(slop wer fac prev)
$(deps t.deps, idx +(idx))
++ file-to-deps
|= =file:ford:neo
^- (list [term pith])
%+ welp
(turn pro.file |=(p=pro:ford:neo [face.p %out (~(pith press:neo pro/stud.p) %out)]))
~ :: (turn lib.file |=(l=lib:ford:neo [face.l %out (prop-pith prouloc.l)]))
++ make-prelude
|= [=prop:neo =file:ford:neo]
^- [pith _run]
=/ pre-path=pith
pre/(prop-pith prop)
[pre-path (make-deps pre-path (file-to-deps file))]
::
++ prop-pith
|= =prop:neo
^- pith:neo
/[p.prop]/[q.prop]
::
++ pith-to-prop
|= =road:neo
?> ?=([=tack:neo =mark ~] road)
[tack mark]:road
++ exists
|= =prop:neo
^- ?
(~(has of:neo kids.bowl) src/(prop-pith prop))
::
++ built
|= =prop:neo
^- ?
(~(has of:neo kids.bowl) src/(prop-pith prop))
--
--

View File

@ -0,0 +1 @@
,[=ship =desk]

View File

@ -291,7 +291,9 @@
++ on ((^on case poem) lte)
+$ a ((mop case poem) lte)
--
+$ dust (trel pith @ud ?)
+$ mode ?(%add %dif %del)
+$ loot [case=@ud =mode]
+$ dust [=pith loot]
+$ grit (list dust)
:: $dirt: Layer 1 of the namespace
++ dirt
@ -827,7 +829,7 @@
::
:: $gift: notification that a children changed
::
+$ gift (map pith mode)
+$ gift (axal loot)
::
:: $hunt: perspective and shrub
::
@ -872,6 +874,8 @@
:: $post: Name of code being distributed
::
+$ post (pair tack stud)
:: $prop: Code unit inside desk
+$ prop (pair tack mark)
::
:: +get-stud-name: Get name for $stud
::
@ -1012,7 +1016,7 @@
:: Absolute ~hastuc-dibtux/src/foo/bar/test
:: Relative %^/bar
++ old-nam
:: ^- $-(nail (like name:neo))
:: ^- $-(nail (like name))
;~ pose
%+ sear
|= [kets=(list) pit=pith]
@ -1175,7 +1179,7 @@
==
+$ howl tone
:: $wail: change result
+$ wail (trel pith yell ?)
+$ wail (trel pith yell mode)
:: $song
:: $sound: internal change tracking listeners
@ -1302,6 +1306,9 @@
?~ long
~
$(curt t.curt, long t.long)
++ sort
|= [a=$ b=$]
(lte (lent a) (lent b))
--
++ name
=< name
@ -1587,7 +1594,6 @@
+$ rely
[=term =stem]
::
+$ mode ?(%add %dif %del)
::
+$ dish (pair pith mode)
+$ yarn (pair aeon mode)
@ -1980,4 +1986,57 @@
~
`i.lis
--
++ press
|_ =post
++ disk ^- ^disk ?@(q.post ~ +.q.post)
++ stud q.post
++ eject
|= =^pith
^- [kind:ford _post _pith]
~| ejecting/pith
=^ dis=^disk pith
?> ?=([%cod *] pith)
(eject:floppy t.pith)
?> ?=([kind:ford tack @ *] pith)
=/ =kind:ford i.pith
=/ =tack i.t.pith
:+ kind [tack ?@(dis i.t.t.pith [i.t.t.pith ship.dis term.dis])]
t.t.t.pith
++ slip
|= [=kind:ford pax=^pith]
=/ [@ p=^post =^pith]
(eject pax)
(~(pith press p) kind)
++ path
|= =kind:ford
(pout (pith kind))
::
++ pith
|= =kind:ford
:- %cod
%+ welp ~(pith floppy disk)
:- kind
:- p.post
=- ~[-]
?@ q.post q.post
mark.q.post
--
++ floppy
|_ =disk
++ eject
|= =^pith
^+ [disk pith]
?: ?=([%std *] pith)
[~ t.pith]
?> ?=([[%p @] @ *] pith)
[[+.i.pith i.t.pith] t.t.pith]
++ pith
^- ^pith
?@ disk
#/std
[p/ship.disk term.disk ~]
--
--