More constant-blocking cleanups.

This commit is contained in:
C. Guy Yarvin 2017-12-15 20:13:50 -08:00
parent ae7f263a43
commit 0509820eea
4 changed files with 80 additions and 58 deletions

View File

@ -4,10 +4,9 @@
/? 309 :: arvo kelvin /? 309 :: arvo kelvin
/- sole, lens :: console structures /- sole, lens :: console structures
/+ sole :: console library /+ sole :: console library
[. sole] =, sole
=, space:userlib =, space:userlib
=, format =, format
!:
:: :: :: :: :: ::
:::: :: :::: :::: :: ::::
:: :: :: :: :: ::
@ -26,6 +25,14 @@
old/(set term) :: used TLVs old/(set term) :: used TLVs
buf/tape :: multiline buffer buf/tape :: multiline buffer
== :: == ::
++ monkey :: per conversation
$: say/sole-share :: command-line state
dir/beam :: active path
poy/(unit dojo-project) :: working
var/(map term cage) :: variable state
old/(set term) :: used TLVs
buf/tape :: multiline buffer
== ::
++ dojo-command :: ++ dojo-command ::
$^ (pair dojo-sink dojo-source) :: route value $^ (pair dojo-sink dojo-source) :: route value
{$brev p/term} :: unbind variable {$brev p/term} :: unbind variable
@ -116,6 +123,7 @@
:::: :: :::: ::
:: :: :: ::
=, gall =, gall
=+ foo=*monkey
|_ $: hid/bowl :: system state |_ $: hid/bowl :: system state
house :: program state house :: program state
== :: == ::
@ -838,14 +846,14 @@
:: ::
:> sort the items. :> sort the items.
++ sort-overview ++ sort-overview
|= ovr/overview |: ovr=$:overview
^- overview ^- overview
%+ sort ovr %+ sort ovr
|= {lhs/overview-item rhs/overview-item} |: $:{lhs/overview-item rhs/overview-item}
(aor (get-overview-name lhs) (get-overview-name rhs)) (aor (get-overview-name lhs) (get-overview-name rhs))
:: ::
++ get-overview-name ++ get-overview-name
|= ovr/overview-item |: ovr=$:overview-item
?- ovr ?- ovr
{$header *} "" {$header *} ""
{$item *} name.ovr {$item *} name.ovr
@ -865,7 +873,7 @@
:> functions which display output of various types. :> functions which display output of various types.
+| +|
++ print-item ++ print-item
|= itm/item |: itm=$:item
^- tang ^- tang
?- itm ?- itm
{$view *} (print-overview items.itm) {$view *} (print-overview items.itm)
@ -877,7 +885,7 @@
:: ::
:> renders the documentation for a full core. :> renders the documentation for a full core.
++ print-core ++ print-core
|= {core-name/tape docs/what sut/type con/coil uit/(unit item)} |: $:{core-name/tape docs/what sut/type con/coil uit/(unit item)}
^- tang ^- tang
=+ [arms chapters]=(arm-and-chapter-overviews sut con core-name) =+ [arms chapters]=(arm-and-chapter-overviews sut con core-name)
;: weld ;: weld
@ -983,12 +991,12 @@
:: ::
:> renders an overview as {tang} :> renders an overview as {tang}
++ print-overview ++ print-overview
|= ovr/overview |: ovr=$:overview
^- tang ^- tang
|^ (print-level ovr 0) |^ (print-level ovr 0)
++ print-level ++ print-level
:> indentation: multiply by 2 to get number of spaces. :> indentation: multiply by 2 to get number of spaces.
|= {ovr/overview indentation/@u} |: $:{ovr/overview indentation/@u}
^- tang ^- tang
:> max-key-length: length of the longest {item} term. :> max-key-length: length of the longest {item} term.
=/ max-key-length (calculate-max-key-length ovr) =/ max-key-length (calculate-max-key-length ovr)
@ -1024,7 +1032,7 @@
:: ::
:> :>
++ calculate-max-key-length ++ calculate-max-key-length
|= ovr/overview |: ovr=$:overview
^- @u ^- @u
%- dy-longest-tape %- dy-longest-tape
(turn ovr get-overview-name) (turn ovr get-overview-name)
@ -1291,7 +1299,7 @@
$| $|
=> .(vax (slap vax !,(*hoon ?>(?=($| -) .)))) :: XX working spec #72 => .(vax (slap vax !,(*hoon ?>(?=($| -) .)))) :: XX working spec #72
=+ typ={$| (unit knot) hiss:eyre *} =+ typ={$| (unit knot) hiss:eyre *}
=+ [~ usr hiz ~]=((dy-cast typ !>(*typ)) vax) =+ [~ usr hiz ~]=((dy-cast typ !>($:typ)) vax)
=. ..dy (he-diff %tan leaf+"< {(en-purl:html p.hiz)}" ~) =. ..dy (he-diff %tan leaf+"< {(en-purl:html p.hiz)}" ~)
(dy-eyre(pro `(slap (slot 15 vax) limb+%r)) /scar usr hiz) (dy-eyre(pro `(slap (slot 15 vax) limb+%r)) /scar usr hiz)
== ==
@ -1683,9 +1691,9 @@
-- --
:: ::
++ prep ++ prep
=+ session-4==+(*session _-(lib *(list), sur *(list))) =+ session-4==+($:session _-(lib *(list), sur *(list)))
=+ session-1==+(*session-4 _-(poy *(unit))) =+ session-1==+($:session-4 _-(poy *(unit)))
=+ session-0==+(*session-1 _[_say syd=desk * _|2.-]) =+ session-0==+($:session-1 _[_say syd=desk * _|2.-])
:: ,_`..prep :: ,_`..prep
=+ ^= hoze =+ ^= hoze
$% {$0 p/(map bone session-0)} $% {$0 p/(map bone session-0)}
@ -1697,7 +1705,10 @@
|= old/(unit ?(house hoze)) ^+ [~ ..prep] |= old/(unit ?(house hoze)) ^+ [~ ..prep]
?~ old `..prep ?~ old `..prep
?+ -.u.old !! ?+ -.u.old !!
$4 $(-.u.old %5, q.u.old (~(run by q.u.old) |=(session-4 +<(sur ~, lib ~)))) $4 %= $
-.u.old %5
q.u.old (~(run by q.u.old) |:($:session-4 +<(sur ~, lib ~)))
==
$5 `..prep(+<+ u.old) $5 `..prep(+<+ u.old)
== ==
:: ::
@ -1707,10 +1718,12 @@
|= {moz/(list move) ses/session} |= {moz/(list move) ses/session}
=> ~(. he moz ses) => ~(. he moz ses)
=- [wrap=- +] =- [wrap=- +]
|* he-arm/_he-type =+ he-arm=he-type
|= _+<.he-arm |% +- $
^- (quip move _..he) |: +<.he-arm
he-abet:(he-arm +<) ^- (quip move _..he)
he-abet:(he-arm +<)
--
:: ::
++ peer-sole ++ peer-sole
~? !=(our.hid src.hid) [%dojo-peer-stranger ost.hid src.hid] ~? !=(our.hid src.hid) [%dojo-peer-stranger ost.hid src.hid]

View File

@ -830,7 +830,7 @@
~&(e+lost+[tee hen] +>.$) ~&(e+lost+[tee hen] +>.$)
%+ roll ~(tap in (~(get ju liz) p.sih)) %+ roll ~(tap in (~(get ju liz) p.sih))
=< .(con ..axon(liz (~(del by liz) p.sih))) =< .(con ..axon(liz (~(del by liz) p.sih)))
|= {sus/(each duct ixor) con/_..axon} |: $:{sus/(each duct ixor) con/_..axon}
=. ..axon con =. ..axon con
?- -.sus ?- -.sus
$& (give-json(hen p.sus) 200 ~ %s (scot %uv p.sih)) $& (give-json(hen p.sus) 200 ~ %s (scot %uv p.sih))
@ -1056,7 +1056,10 @@
== ==
++ abet ..handle ++ abet ..handle
++ done . ++ done .
++ teba |*(a/$-(* _..handle) |*(b/* %_(done ..handle (a b)))) ++ teba =+ a=$-(* _..handle)
|% +- $
|*(b/* %_(done ..handle (a b)))
--
++ del-deps (teba ^del-deps) ++ del-deps (teba ^del-deps)
++ new-deps (teba ^new-deps) ++ new-deps (teba ^new-deps)
++ exec-live (teba ^exec-live) ++ exec-live (teba ^exec-live)
@ -1613,7 +1616,10 @@
=. +> poll-rest =. +> poll-rest
..ix(wix (~(del by wix) ire)) ..ix(wix (~(del by wix) ire))
:: ::
++ teba |*(a/$-(* _..ix) |*(b/* %_(done ..ix (a b)))) ++ teba =+ a=$-(* _..ix)
|% +- $
|*(b/* %_(done ..ix (a b)))
--
++ give-json (teba ^give-json) ++ give-json (teba ^give-json)
++ pass-note (teba ^pass-note) ++ pass-note (teba ^pass-note)
++ hurl-note ++ hurl-note
@ -1790,7 +1796,8 @@
++ pass-note |=({a/whir-se b/note} (pass-note:abet se+[a usr dom] b)) ++ pass-note |=({a/whir-se b/note} (pass-note:abet se+[a usr dom] b))
:: XX block reqs until correct core checked in? :: XX block reqs until correct core checked in?
++ warn |=(a/tang ((slog (flop a)) abet)) ++ warn |=(a/tang ((slog (flop a)) abet))
++ with |*({a/vase b/$-(vase abet)} |=(c/vase (b (slam a c)))) ++ with =+ $:{a/vase b/$-(vase abet)}
|% +- $ |=(c/vase (b (slam a c))) --
++ root-beak `beak`[our %home da+now] ++ root-beak `beak`[our %home da+now]
:: ::
:: Main :: Main
@ -1950,20 +1957,20 @@
$(a t.a) $(a t.a)
:: ::
++ on-ford-fail ++ on-ford-fail
|= {err/$-(tang _abet) try/$-((each cage tang) _abet)} |: $:{err/$-(tang _abet) try/$-((each cage tang) _abet)}
|= a/(each cage tang) ^+ abet |= a/(each cage tang) ^+ abet
?-(-.a $| (err p.a), $& (try a)) ?-(-.a $| (err p.a), $& (try a))
:: ::
++ on-error ++ on-error
|= {err/$-(tang _abet) handle-move/_|.(|~(vase abet))} |: $:{err/$-(tang _abet) handle-move/_|.(|~(vase abet))}
|= a/(each cage tang) ^+ abet |= a/(each cage tang) ^+ abet
=+ try=(possibly-stateful |=(b/_self (handle-move(+ b)))) :: XX types =+ try=(possibly-stateful |:(b=self (handle-move(+ b)))) :: XX types
?: ?=($| -.a) (err p.a) ?: ?=($| -.a) (err p.a)
=- ?-(-.- $& p.-, $| (err p.-)) =- ?-(-.- $& p.-, $| (err p.-))
(mule |.(~|(driver+dom ~|(bad-res+p.q.p.a (try q.p.a))))) (mule |.(~|(driver+dom ~|(bad-res+p.q.p.a (try q.p.a)))))
:: ::
++ possibly-stateful ++ possibly-stateful
|= han/$-(_self $-(vase _abet)) :: XX |.(|+(vase abet)) |: $:{han/$-(_self $-(vase _abet))} :: XX |.(|+(vase abet))
|= res/vase ^+ abet |= res/vase ^+ abet
?: ?=({@ *} q.res) ?: ?=({@ *} q.res)
=. p.res (~(fuse ut p.res) p:!>(*{@ *})) =. p.res (~(fuse ut p.res) p:!>(*{@ *}))
@ -2025,10 +2032,10 @@
:: ::
++ load :: take previous state ++ load :: take previous state
=+ driv-5=_=>(*driv [cor=p req=req.q]) =+ driv-5=_=>(*driv [cor=p req=req.q])
=+ bolo-5={$5 _=+(*bolo +.-(sec (~(run by sec.-) driv-5)))} =+ bolo-5={$5 _=+($:bolo +.-(sec (~(run by sec.-) driv-5)))}
=+ bolo-4={$4 _%*(+ *bolo-5 lyv *(map duct ^))} =+ bolo-4={$4 _%*(+ $:bolo-5 lyv *(map duct ^))}
::|= * %. (bolo +<) ::|= * %. (bolo +<)
|= old/?(bolo bolo-5 bolo-4) ^+ ..^$ |: $:{old/?(bolo bolo-5 bolo-4)} ^+ ..^$
?- -.old ?- -.old
$6 ..^$(+>- old) $6 ..^$(+>- old)
$5 $(old [%6 +.old(sec (~(run by sec.old) |=(driv-5 [cor & req])))]) $5 $(old [%6 +.old(sec (~(run by sec.old) |=(driv-5 [cor & req])))])

View File

@ -1,4 +1,4 @@
!::::: ::::::
:: :: %ford, new execution control :: :: %ford, new execution control
!? 164 !? 164
:::: ::::
@ -144,8 +144,10 @@
:: :: :: ::
++ flue |=(a/cafe (fine a ~)) :: cafe to empty ++ flue |=(a/cafe (fine a ~)) :: cafe to empty
++ flux |* a/_* :: bolt lift (fmap) ++ flux |* a/_* :: bolt lift (fmap)
|* {cafe _,.+<.a} =+ $:{cafe _,.+<.a}
(fine +<- (a +<+)) |% +- $
(fine +<- (a +<+))
--
:: ::
++ lark :: filter arch names ++ lark :: filter arch names
|= {wox/$-(knot (unit @)) arc/arch} |= {wox/$-(knot (unit @)) arc/arch}
@ -468,7 +470,7 @@
++ cool :: error caption ++ cool :: error caption
|* {cyt/$@(term (trap tank)) hoc/(bolt)} |* {cyt/$@(term (trap tank)) hoc/(bolt)}
?. ?=($2 -.q.hoc) hoc ?. ?=($2 -.q.hoc) hoc
[p=p.hoc q=[%2 p=p.q.hoc q=[?^(cyt *cyt >`@tas`cyt<) q.q.hoc]]] [p=p.hoc q=[%2 p=p.q.hoc q=[?^(cyt $:cyt >`@tas`cyt<) q.q.hoc]]]
:: ::
++ cope :: bolt along ++ cope :: bolt along
|* {hoc/(bolt) fun/(burg)} |* {hoc/(bolt) fun/(burg)}
@ -573,21 +575,21 @@
:: ::
++ some-in-map ++ some-in-map
|* fun/(burg knot (unit)) |* fun/(burg knot (unit))
=+ res=_(need [?+(-.q !! $0 q.q)]:*fun) =+ res=_(need [?+(-.q !! $0 q.q)]:$:fun)
=+ marv=(map knot res) =+ marv=(map knot res)
|= {cof/cafe sud/(map knot $~)} ^- (bolt marv) |= {cof/cafe sud/(map knot $~)} ^- (bolt marv)
?~ sud (flue cof) ?~ sud (flue cof)
%. [cof sud] %. [cof sud]
;~ cope ;~ cope
;~ coax ;~ coax
|=({cof/cafe _sud} ^$(cof cof, sud l)) |:($:{cof/cafe _sud} ^$(cof cof, sud l))
|=({cof/cafe _sud} ^$(cof cof, sud r)) |:($:{cof/cafe _sud} ^$(cof cof, sud r))
|= {cof/cafe {dir/@ta $~} ^} |= {cof/cafe {dir/@ta $~} ^}
%+ cope (fun cof dir) %+ cope (fun cof dir)
(flux (lift |*(* [dir +<]))) (flux (lift |*(* [dir +<])))
== ==
%- flux %- flux
|= {lam/marv ram/marv nod/(unit {knot res})} |: $:{lam/marv ram/marv nod/(unit {knot res})}
?^(nod [u.nod lam ram] (~(uni by lam) ram)) ?^(nod [u.nod lam ram] (~(uni by lam) ram))
== ==
++ dash :: process cache ++ dash :: process cache
@ -1465,9 +1467,9 @@
%. [cof p.kas] %. [cof p.kas]
;~ cope ;~ cope
;~ coax ;~ coax
|=({cof/cafe _p.kas} (fret ^^$(cof cof, kas p.i))) |:($:{cof/cafe _p.kas} (fret ^^$(cof cof, kas p.i)))
|=({cof/cafe _p.kas} (fret ^^$(cof cof, kas q.i))) |:($:{cof/cafe _p.kas} (fret ^^$(cof cof, kas q.i)))
|=({cof/cafe _p.kas} ^$(cof cof, p.kas t)) |:($:{cof/cafe _p.kas} ^$(cof cof, p.kas t))
== ==
(flux |=({k/gage v/gage t/(list {gage gage})} [[k v] t])) (flux |=({k/gage v/gage t/(list {gage gage})} [[k v] t]))
== ==
@ -1538,7 +1540,7 @@
|= {cof/cafe hyd/hood} |= {cof/cafe hyd/hood}
^- (bolt vase) ^- (bolt vase)
%+ cope (apex cof hyd) %+ cope (apex cof hyd)
|= {cof/cafe sel/_..abut} |: $:{cof/cafe sel/_..abut}
=. ..abut sel =. ..abut sel
%+ cope (wrapped-slap cof pit able) %+ cope (wrapped-slap cof pit able)
|= {cof/cafe bax/vase} |= {cof/cafe bax/vase}
@ -1557,13 +1559,13 @@
::=. dyv +(dyv) ::=. dyv +(dyv)
::~& [`term`(cat 3 %apex (fil 4 dyv ' ')) `path`(flop s.how) libs] ::~& [`term`(cat 3 %apex (fil 4 dyv ' ')) `path`(flop s.how) libs]
::=- ~& [`term`(cat 3 %xepa (fil 4 dyv ' ')) `path`(flop s.how)] - ::=- ~& [`term`(cat 3 %xepa (fil 4 dyv ' ')) `path`(flop s.how)] -
|= {cof/cafe sel/_..apex} |: $:{cof/cafe sel/_..apex}
=. ..apex sel =. ..apex sel
%+ cope (neck cof lib.hyd) %+ cope (neck cof lib.hyd)
|= {cof/cafe sel/_..apex} |: $:{cof/cafe sel/_..apex}
=. ..apex sel(boy boy) =. ..apex sel(boy boy)
%+ cope (head cof sur.hyd) %+ cope (head cof sur.hyd)
|= {cof/cafe sel/_..apex} |: $:{cof/cafe sel/_..apex}
(fine cof sel) (fine cof sel)
:: ::
++ body :: produce functions ++ body :: produce functions
@ -1571,7 +1573,7 @@
^- (bolt _..body) ^- (bolt _..body)
?~ src (fine cof ..body) ?~ src (fine cof ..body)
%+ cope (wilt cof i.src) %+ cope (wilt cof i.src)
|= {cof/cafe sel/_..body} |: $:{cof/cafe sel/_..body}
^$(src t.src, ..body sel, cof cof) ^$(src t.src, ..body sel, cof cof)
:: ::
++ chai :: atomic map ++ chai :: atomic map
@ -1724,7 +1726,7 @@
%+ cope (compile-to-hood cof bem) %+ cope (compile-to-hood cof bem)
|= {cof/cafe hyd/hood} |= {cof/cafe hyd/hood}
%+ cope (apex(how bem, boy ~) cof hyd) %+ cope (apex(how bem, boy ~) cof hyd)
|= {cof/cafe sel/_..head} |: $:{cof/cafe sel/_..head}
=. ..head =. ..head
%= sel %= sel
boy boy boy boy
@ -1760,7 +1762,7 @@
%+ cope (compile-to-hood cof bem) %+ cope (compile-to-hood cof bem)
|= {cof/cafe hyd/hood} |= {cof/cafe hyd/hood}
%+ cope (apex(how bem, boy ~) cof hyd) %+ cope (apex(how bem, boy ~) cof hyd)
|= {cof/cafe sel/_..neck} |: $:{cof/cafe sel/_..neck}
=. ..neck =. ..neck
%= sel %= sel
how how how how
@ -1784,27 +1786,27 @@
%+ cope (compile-to-hood cof p.hop) %+ cope (compile-to-hood cof p.hop)
|= {cof/cafe hyd/hood} |= {cof/cafe hyd/hood}
%+ cope (apex(boy ~) cof hyd) %+ cope (apex(boy ~) cof hyd)
(flux |=(sel/_..wilt sel(boy [[%tssg boy.sel] boy]))) (flux |:(sel=..wilt sel(boy [[%tssg boy.sel] boy])))
=+ [all=(lark (slat %tas) arc) sel=..wilt] =+ [all=(lark (slat %tas) arc) sel=..wilt]
%+ cope %+ cope
|- ^- (bolt (pair (map term (pair what foot)) _..wilt)) |- ^- (bolt (pair (map term (pair what foot)) _..wilt))
?~ all (fine cof ~ ..wilt) ?~ all (fine cof ~ ..wilt)
%+ cope $(all l.all) %+ cope $(all l.all)
|= {cof/cafe lef/(map term (pair what foot)) sel/_..wilt} |: $:{cof/cafe lef/(map term (pair what foot)) sel/_..wilt}
%+ cope ^$(all r.all, cof cof, sel sel) %+ cope ^$(all r.all, cof cof, sel sel)
|= {cof/cafe rig/(map term (pair what foot)) sel/_..wilt} |: $:{cof/cafe rig/(map term (pair what foot)) sel/_..wilt}
%+ cope %+ cope
%= ^^^^$ %= ^^^^$
cof cof cof cof
..wilt sel(boy ~) ..wilt sel(boy ~)
s.p.hop [p.n.all s.p.hop] s.p.hop [p.n.all s.p.hop]
== ==
|= {cof/cafe sel/_..wilt} |: $:{cof/cafe sel/_..wilt}
%+ fine cof %+ fine cof
:_ sel :_ sel
^- (map term (pair what foot)) ^- (map term (pair what foot))
[[p.n.all [~ %ash [%tssg boy.sel]]] lef rig] [[p.n.all [~ %ash [%tssg boy.sel]]] lef rig]
|= {cof/cafe mav/(map term (pair what foot)) sel/_..wilt} |: $:{cof/cafe mav/(map term (pair what foot)) sel/_..wilt}
?~ mav ?~ mav
(flaw cof [%leaf "source missing: {<(en-beam p.hop)>}"]~) (flaw cof [%leaf "source missing: {<(en-beam p.hop)>}"]~)
(fine cof sel(boy [[%brcn [~ ~] [[0 [~ ~] mav] ~ ~]] boy])) (fine cof sel(boy [[%brcn [~ ~] [[0 [~ ~] mav] ~ ~]] boy]))

View File

@ -34,17 +34,17 @@
++ axle-n ?(axle-1 axle-2 axle-3 axle-4) :: upgrade path ++ axle-n ?(axle-1 axle-2 axle-3 axle-4) :: upgrade path
++ axle-1 {$1 pol/(map ship mast-1)} :: ++ axle-1 {$1 pol/(map ship mast-1)} ::
++ mast-1 :: ++ mast-1 ::
(cork mast-2 |=(mast-2 +<(bum (~(run by bum) seat-1)))) :: (cork mast-2 |-($:mast-2 +<(bum (~(run by bum) seat-1)))) ::
++ seat-1 :: ++ seat-1 ::
(cork seat-2 |=(seat-2 +<+)) :: (cork seat-2 |:($:seat-2 +<+)) ::
++ axle-2 {$2 pol/(map ship mast-2)} :: ++ axle-2 {$2 pol/(map ship mast-2)} ::
++ mast-2 (cork mast-3 |=(mast-3 +<+)) :: ++ mast-2 (cork mast-3 |:($:mast-3 +<+)) ::
++ seat-2 seat-3 :: ++ seat-2 seat-3 ::
++ axle-3 {$3 pol/(map ship mast-3)} :: ++ axle-3 {$3 pol/(map ship mast-3)} ::
++ mast-3 :: ++ mast-3 ::
(cork mast-4 |=(mast-4 +<(bum (~(run by bum) seat-3)))) :: (cork mast-4 |:($:mast-4 +<(bum (~(run by bum) seat-3)))) ::
++ seat-3 :: ++ seat-3 ::
(cork seat-4 |=(seat-4 +<+)) :: (cork seat-4 |:($:seat-4 +<+)) ::
++ axle-4 axle :: ++ axle-4 axle ::
++ mast-4 mast :: ++ mast-4 mast ::
++ seat-4 seat :: ++ seat-4 seat ::