mirror of
https://github.com/urbit/shrub.git
synced 2024-12-25 13:04:17 +03:00
Merge branch 'philip/tab-complete' (#1899)
* philip/tab-complete: auto: gain and lose types on ?: auto: handle tab in middle of symbol auto: support forks auto: support autocomplete inside wings auto: fix some crashes on strange wet gates auto: support multiline tab completion auto: don't look in context of non-gold cores easy-print: don't crash if type-check crashes dojo, drum: change %tab sole-effect to use tanks dojo, auto: move insert-magic logic to lib/auto dojo, drum: give tab completion as true output dojo: add a better function printer dojo: add tab completion Signed-off-by: Jared Tobin <jared@tlon.io>
This commit is contained in:
Jared Tobin
commit
988b3a4785
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:58606e40eb62beb0c811e77529211913e3b66e4e824f8efdb55c92c27746fd49
|
||||
size 9082848
|
||||
oid sha256:11e608f3e5f0dd4860d19131c6c91550514f1e65a2229f9ee6ba0146e9ea7229
|
||||
size 9093157
|
||||
|
||||
@ -301,6 +301,7 @@
|
||||
%det (edit +.act)
|
||||
%clr [~ this]
|
||||
%ret obey
|
||||
%tab [~ this]
|
||||
==
|
||||
:: +edit: apply sole edit
|
||||
::
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
:: :: ::
|
||||
/? 309 :: arvo kelvin
|
||||
/- *sole, lens ::
|
||||
/+ sole, pprint ::
|
||||
/+ sole, pprint, auto, easy-print ::
|
||||
:: :: ::
|
||||
:::: :: ::::
|
||||
:: :: ::
|
||||
@ -678,6 +678,7 @@
|
||||
$det (dy-edit +.act)
|
||||
$ret (dy-done (tufa buf.say))
|
||||
$clr dy-stop
|
||||
$tab +>+>
|
||||
==
|
||||
::
|
||||
++ dy-cage |=(num/@ud (~(got by rez) num)) :: known cage
|
||||
@ -724,23 +725,6 @@
|
||||
:+ %$ %noun
|
||||
?~(b !>([~ ~]) (dy-vase p.u.b))
|
||||
::
|
||||
++ dy-hoon-head :: dynamic state
|
||||
:: todo: how do i separate the toplevel 'dojo state' comment?
|
||||
:: dojo state
|
||||
::
|
||||
:: our: the name of this urbit
|
||||
:: now: the current time
|
||||
:: eny: a piece of random entropy
|
||||
::
|
||||
^- cage
|
||||
:- %noun
|
||||
=+ sloop=|=({a/vase b/vase} ?:(=(*vase a) b ?:(=(*vase b) a (slop a b))))
|
||||
%+ sloop
|
||||
%- ~(rep by var)
|
||||
|= {{a/term @ b/vase} c/vase} ^- vase
|
||||
(sloop b(p face+[a p.b]) c)
|
||||
!>([our=our now=now eny=eny]:hid)
|
||||
::
|
||||
++ dy-made-dial :: dialog product
|
||||
|= cag/cage
|
||||
^+ +>+>
|
||||
@ -814,7 +798,7 @@
|
||||
=+ too=(dy-hoon-mark gen)
|
||||
=- ?~(too - [%cast he-disc u.too -])
|
||||
:+ %ride gen
|
||||
:- [%$ dy-hoon-head]
|
||||
:- [%$ he-hoon-head]
|
||||
:^ %plan he-rail `coin`blob+**
|
||||
`scaffold:ford`[he-rail zuse sur lib ~ ~]
|
||||
::
|
||||
@ -1112,6 +1096,69 @@
|
||||
==
|
||||
==
|
||||
::
|
||||
++ he-tab
|
||||
|= pos=@ud
|
||||
^+ +>
|
||||
=* res +>
|
||||
=+ ^- [back-pos=@ud fore-pos=@ud txt=tape]
|
||||
(insert-magic:auto (add (lent buf) pos) :(weld buf (tufa buf.say)))
|
||||
=/ id-len (sub fore-pos back-pos)
|
||||
=/ fore-pos-diff (sub fore-pos pos)
|
||||
=+ vex=((full parse-command-line:he-parser) [1 1] txt)
|
||||
?. ?=([* ~ [* @ %ex *] *] vex)
|
||||
res
|
||||
=/ typ p:(slop q:he-hoon-head !>(..dawn))
|
||||
=/ tl (tab-list-hoon:auto typ p.q.q.p.u.q.vex)
|
||||
=/ advance (advance-hoon:auto typ p.q.q.p.u.q.vex)
|
||||
=? res ?=(^ advance)
|
||||
=/ to-send
|
||||
(trip (rsh 3 (sub pos back-pos) u.advance))
|
||||
=| fxs=(list sole-effect)
|
||||
=. .
|
||||
|- ^+ +.$
|
||||
?. (gth fore-pos-diff 0)
|
||||
+.$
|
||||
=^ lic say (~(transmit sole say) %del pos)
|
||||
%= $
|
||||
fxs [det+lic fxs]
|
||||
fore-pos-diff (dec fore-pos-diff)
|
||||
==
|
||||
:: =. pos (add pos fore-pos-diff)
|
||||
|- ^+ res
|
||||
?~ to-send
|
||||
(he-diff %mor (flop fxs))
|
||||
=^ lic say (~(transmit sole say) %ins pos `@c`i.to-send)
|
||||
$(to-send t.to-send, fxs [`sole-effect`det+lic fxs], pos +(pos))
|
||||
:: If couldn't search (eg cursor not in appropriate position), do
|
||||
:: nothing.
|
||||
::
|
||||
?: ?=(~ tl)
|
||||
res
|
||||
:: If no options, ring the bell
|
||||
::
|
||||
?: =([~ ~] tl)
|
||||
(he-diff %bel ~)
|
||||
:: If only one option, don't print unless the option is already
|
||||
:: typed in.
|
||||
::
|
||||
?: &(?=([* ~] u.tl) !=((met 3 (need advance)) id-len))
|
||||
res
|
||||
:: Else, print results
|
||||
::
|
||||
=/ lots (gth (lent u.tl) 10)
|
||||
%+ he-diff %tab
|
||||
%+ turn u.tl
|
||||
|= [=term =type]
|
||||
~| term
|
||||
:- term
|
||||
?: lots
|
||||
*tank
|
||||
:: +perk is broken because *perk crashes.
|
||||
::
|
||||
?: =(%perk term)
|
||||
*tank
|
||||
~(duck easy-print type)
|
||||
::
|
||||
++ he-type :: apply input
|
||||
|= act/sole-action
|
||||
^+ +>
|
||||
@ -1121,6 +1168,7 @@
|
||||
$det (he-stir +.act)
|
||||
$ret (he-done (tufa buf.say))
|
||||
$clr he-pine(buf "")
|
||||
$tab (he-tab +.act)
|
||||
==
|
||||
::
|
||||
++ he-lame :: handle error
|
||||
@ -1130,6 +1178,23 @@
|
||||
?^ poy
|
||||
he-pine:~(dy-amok dy u.poy)
|
||||
he-pine :: XX give mean to original keystroke
|
||||
::
|
||||
++ he-hoon-head :: dynamic state
|
||||
:: todo: how do i separate the toplevel 'dojo state' comment?
|
||||
:: dojo state
|
||||
::
|
||||
:: our: the name of this urbit
|
||||
:: now: the current time
|
||||
:: eny: a piece of random entropy
|
||||
::
|
||||
^- cage
|
||||
:- %noun
|
||||
=+ sloop=|=({a/vase b/vase} ?:(=(*vase a) b ?:(=(*vase b) a (slop a b))))
|
||||
%+ sloop
|
||||
%- ~(rep by var)
|
||||
|= {{a/term @ b/vase} c/vase} ^- vase
|
||||
(sloop b(p face+[a p.b]) c)
|
||||
!>([our=our now=now eny=eny]:hid)
|
||||
--
|
||||
::
|
||||
++ prep
|
||||
|
||||
304
pkg/arvo/lib/auto.hoon
Normal file
304
pkg/arvo/lib/auto.hoon
Normal file
@ -0,0 +1,304 @@
|
||||
:: Autocomplete for hoon.
|
||||
::
|
||||
|%
|
||||
+$ ids (list [=term =type])
|
||||
::
|
||||
:: Get all the identifiers accessible if this type is your subject.
|
||||
::
|
||||
++ get-identifiers
|
||||
|= ty=type
|
||||
%- flop
|
||||
|- ^- ids
|
||||
?- ty
|
||||
%noun ~
|
||||
%void ~
|
||||
[%atom *] ~
|
||||
[%cell *]
|
||||
%+ weld
|
||||
$(ty p.ty)
|
||||
$(ty q.ty)
|
||||
::
|
||||
[%core *]
|
||||
%- weld
|
||||
:_ ?. ?=(%gold r.p.q.ty)
|
||||
~
|
||||
$(ty p.ty)
|
||||
^- (list (pair term type))
|
||||
%- zing
|
||||
%+ turn ~(tap by q.r.q.ty)
|
||||
|= [term =tome]
|
||||
%+ turn
|
||||
~(tap by q.tome)
|
||||
|= [name=term =hoon]
|
||||
^- (pair term type)
|
||||
~| term=term
|
||||
[name ~(play ~(et ut ty) ~[name] ~)]
|
||||
::
|
||||
[%face *]
|
||||
?^ p.ty
|
||||
~
|
||||
[p.ty q.ty]~
|
||||
::
|
||||
[%fork *]
|
||||
%= $
|
||||
ty
|
||||
=/ tines ~(tap in p.ty)
|
||||
?~ tines
|
||||
%void
|
||||
|- ^- type
|
||||
?~ t.tines
|
||||
i.tines
|
||||
(~(fuse ut $(tines t.tines)) i.tines)
|
||||
==
|
||||
::
|
||||
[%hint *] $(ty q.ty)
|
||||
[%hold *] $(ty ~(repo ut ty))
|
||||
==
|
||||
::
|
||||
:: Get all the identifiers that start with sid.
|
||||
::
|
||||
++ search-prefix
|
||||
|= [sid=term =ids]
|
||||
^- (list [term type])
|
||||
%+ skim ids
|
||||
|= [id=term ty=type]
|
||||
=(sid (end 3 (met 3 sid) id))
|
||||
::
|
||||
:: Get the longest prefix of a list of identifiers.
|
||||
::
|
||||
++ longest-match
|
||||
|= matches=(list [=term =type])
|
||||
^- term
|
||||
?~ matches
|
||||
''
|
||||
=/ n 1
|
||||
=/ last (met 3 term.i.matches)
|
||||
|- ^- term
|
||||
?: (gth n last)
|
||||
term.i.matches
|
||||
=/ prefix (end 3 n term.i.matches)
|
||||
?: |- ^- ?
|
||||
?| ?=(~ t.matches)
|
||||
?& =(prefix (end 3 n term.i.t.matches))
|
||||
$(t.matches t.t.matches)
|
||||
== ==
|
||||
$(n +(n))
|
||||
(end 3 (dec n) term.i.matches)
|
||||
::
|
||||
:: Run +find-type safely, printing the first line of the stack trace on
|
||||
:: error.
|
||||
::
|
||||
++ find-type-mule
|
||||
|= [sut=type gen=hoon]
|
||||
^- (unit [term type])
|
||||
=/ res (mule |.((find-type sut gen)))
|
||||
?- -.res
|
||||
%& p.res
|
||||
%| ((slog (flop (scag 1 p.res))) ~)
|
||||
==
|
||||
::
|
||||
:: Get the subject type of the wing where you've put the "magic-spoon".
|
||||
::
|
||||
++ find-type
|
||||
|= [sut=type gen=hoon]
|
||||
=* loop $
|
||||
|^
|
||||
^- (unit [term type])
|
||||
?- gen
|
||||
[%cnts [%magic-spoon ~] *] `['' sut]
|
||||
[%cnts [%magic-spoon @ ~] *] `[i.t.p.gen sut]
|
||||
[%cnts [%magic-spoon @ *] *]
|
||||
%= $
|
||||
sut (~(play ut sut) wing+t.t.p.gen)
|
||||
t.p.gen t.p.gen(t ~)
|
||||
==
|
||||
::
|
||||
[%cnts [%magic-fork @ ~] *]
|
||||
`['' (~(play ut sut) wing+t.p.gen)]
|
||||
::
|
||||
[^ *] (both p.gen q.gen)
|
||||
[%ktcn *] loop(gen p.gen)
|
||||
[%brcn *] (grow q.gen)
|
||||
[%brvt *] (grow q.gen)
|
||||
[%cnts *]
|
||||
|- ^- (unit [term type])
|
||||
=* inner-loop $
|
||||
?~ q.gen
|
||||
~
|
||||
%+ replace
|
||||
loop(gen q.i.q.gen)
|
||||
|. inner-loop(q.gen t.q.gen)
|
||||
::
|
||||
[%dtkt *] (spec-and-hoon p.gen q.gen)
|
||||
[%dtls *] loop(gen p.gen)
|
||||
[%rock *] ~
|
||||
[%sand *] ~
|
||||
[%tune *] ~
|
||||
[%dttr *] (both p.gen q.gen)
|
||||
[%dtts *] (both p.gen q.gen)
|
||||
[%dtwt *] loop(gen p.gen)
|
||||
[%hand *] ~
|
||||
[%ktbr *] loop(gen p.gen)
|
||||
[%ktls *] (both p.gen q.gen)
|
||||
[%ktpd *] loop(gen p.gen)
|
||||
[%ktsg *] loop(gen p.gen)
|
||||
[%ktwt *] loop(gen p.gen)
|
||||
[%note *] loop(gen q.gen)
|
||||
[%sgzp *] (both p.gen q.gen)
|
||||
[%sgbn *] loop(gen q.gen) :: should check for hoon in p.gen
|
||||
[%tsbn *] (change p.gen q.gen)
|
||||
[%tscm *]
|
||||
%+ replace
|
||||
loop(gen p.gen)
|
||||
|.(loop(gen q.gen, sut (~(busk ut sut) p.gen)))
|
||||
::
|
||||
[%wtcl *] (bell p.gen q.gen r.gen)
|
||||
[%fits *] (both p.gen wing+q.gen)
|
||||
[%wthx *] loop(gen wing+q.gen)
|
||||
[%dbug *] loop(gen q.gen)
|
||||
[%zpcm *] (both p.gen q.gen)
|
||||
[%lost *] loop(gen p.gen)
|
||||
[%zpmc *] (both p.gen q.gen)
|
||||
[%zpts *] loop(gen p.gen)
|
||||
[%zpvt *] (both q.gen r.gen)
|
||||
[%zpzp *] ~
|
||||
*
|
||||
=+ doz=~(open ap gen)
|
||||
?: =(doz gen)
|
||||
~_ (show [%c 'hoon'] [%q gen])
|
||||
~> %mean.'play-open'
|
||||
!!
|
||||
loop(gen doz)
|
||||
==
|
||||
::
|
||||
++ replace
|
||||
|= [a=(unit [term type]) b=(trap (unit [term type]))]
|
||||
^- (unit [term type])
|
||||
?~(a $:b a)
|
||||
::
|
||||
++ both
|
||||
|= [a=hoon b=hoon]
|
||||
(replace loop(gen a) |.(loop(gen b)))
|
||||
::
|
||||
++ bell
|
||||
|= [a=hoon b=hoon c=hoon]
|
||||
%+ replace loop(gen a)
|
||||
|. %+ replace loop(gen b, sut (~(gain ut sut) a))
|
||||
|. loop(gen c, sut (~(lose ut sut) a))
|
||||
::
|
||||
++ spec-and-hoon
|
||||
|= [a=spec b=hoon]
|
||||
(replace (find-type-in-spec sut a) |.(loop(gen b)))
|
||||
::
|
||||
++ change
|
||||
|= [a=hoon b=hoon]
|
||||
(replace loop(gen a) |.(loop(gen b, sut (~(play ut sut) a))))
|
||||
::
|
||||
++ grow
|
||||
|= m=(map term tome)
|
||||
=/ tomes ~(tap by m)
|
||||
|- ^- (unit [term type])
|
||||
=* outer-loop $
|
||||
?~ tomes
|
||||
~
|
||||
=/ arms ~(tap by q.q.i.tomes)
|
||||
|- ^- (unit [term type])
|
||||
=* inner-loop $
|
||||
?~ arms
|
||||
outer-loop(tomes t.tomes)
|
||||
%+ replace
|
||||
loop(gen q.i.arms, sut (~(play ut sut) gen))
|
||||
|. inner-loop(arms t.arms)
|
||||
--
|
||||
::
|
||||
:: Not implemented yet. I wonder whether we should modify types found
|
||||
:: in spec mode such that if it's a mold that produces a type, it
|
||||
:: should just display the type and not that it's technically a
|
||||
:: function.
|
||||
::
|
||||
++ find-type-in-spec
|
||||
|= [sut=type pec=spec]
|
||||
^- (unit [term type])
|
||||
!!
|
||||
::
|
||||
:: Insert magic marker in hoon source at the given position.
|
||||
::
|
||||
++ insert-magic
|
||||
|= [pos=@ud txt=tape]
|
||||
^- [back-pos=@ud fore-pos=@ud txt=tape]
|
||||
:: Find beg-pos by searching backward to where the current term
|
||||
:: begins
|
||||
::
|
||||
=/ forward=(unit term)
|
||||
%+ scan `tape`(slag pos txt)
|
||||
;~(sfix (punt sym) (star ;~(pose prn (just `@`10))))
|
||||
=/ backward=(unit term)
|
||||
%+ scan `tape`(flop (scag pos txt))
|
||||
;~(sfix (punt sym) (star ;~(pose prn (just `@`10))))
|
||||
=/ id=(unit term)
|
||||
?~ forward
|
||||
?~ backward
|
||||
~
|
||||
`u.backward
|
||||
?~ backward
|
||||
`u.forward
|
||||
`(cat 3 u.backward u.forward)
|
||||
=/ back-pos
|
||||
?~ backward
|
||||
pos
|
||||
(sub pos (met 3 u.backward))
|
||||
=/ fore-pos
|
||||
?~ forward
|
||||
pos
|
||||
(add pos (met 3 u.forward))
|
||||
:+ back-pos fore-pos
|
||||
:: Insert "magic-spoon" marker so +find-type can identify where to
|
||||
:: stop.
|
||||
::
|
||||
;: weld
|
||||
(scag back-pos txt)
|
||||
?: &(?=(~ id) ?=([%'.' *] (slag pos txt)))
|
||||
"magic-fork"
|
||||
"magic-spoon"
|
||||
?~ id
|
||||
""
|
||||
"."
|
||||
(slag back-pos txt)
|
||||
"\0a"
|
||||
==
|
||||
::
|
||||
:: Produce the longest possible advance without choosing between
|
||||
:: matches.
|
||||
::
|
||||
:: Takes a +hoon which has already has a magic-spoon marker. Useful if
|
||||
:: you want to handle your own parsing.
|
||||
::
|
||||
++ advance-hoon
|
||||
|= [sut=type gen=hoon]
|
||||
%+ bind (find-type-mule sut gen)
|
||||
|= [id=term typ=type]
|
||||
(longest-match (search-prefix id (get-identifiers typ)))
|
||||
::
|
||||
:: Same as +advance-hoon, but takes a position and text directly.
|
||||
::
|
||||
++ advance-tape
|
||||
|= [sut=type pos=@ud code=tape]
|
||||
(advance-hoon sut (scan txt:(insert-magic pos code) vest))
|
||||
::
|
||||
:: Produce a list of matches.
|
||||
::
|
||||
:: Takes a +hoon which has already has a magic-spoon marker. Useful if
|
||||
:: you want to handle your own parsing.
|
||||
::
|
||||
++ tab-list-hoon
|
||||
|= [sut=type gen=hoon]
|
||||
%+ bind (find-type-mule sut gen)
|
||||
|= [id=term typ=type]
|
||||
(search-prefix id (get-identifiers typ))
|
||||
::
|
||||
:: Same as +advance-hoon, but takes a position and text directly.
|
||||
::
|
||||
++ tab-list-tape
|
||||
|= [sut=type pos=@ud code=tape]
|
||||
(tab-list-hoon sut (scan txt:(insert-magic pos code) vest))
|
||||
--
|
||||
484
pkg/arvo/lib/easy-print.hoon
Normal file
484
pkg/arvo/lib/easy-print.hoon
Normal file
@ -0,0 +1,484 @@
|
||||
:: Fast type printing that's easy on the eyes or your money back
|
||||
::
|
||||
=> |%
|
||||
++ cape {p/(map @ud wine) q/wine}
|
||||
++ wine
|
||||
$@ $? $noun
|
||||
$path
|
||||
$type
|
||||
$void
|
||||
$wall
|
||||
$wool
|
||||
$yarn
|
||||
==
|
||||
$% {$mato p/term}
|
||||
{$gate p/hoon q/type r/wine}
|
||||
{$core p/(list @ta) q/wine}
|
||||
{$face p/term q/wine}
|
||||
{$list p/term q/wine}
|
||||
{$pear p/term q/@}
|
||||
{$bswt p/(list wine)}
|
||||
{$plot p/(list wine)}
|
||||
{$stop p/@ud}
|
||||
{$tree p/term q/wine}
|
||||
{$unit p/term q/wine}
|
||||
==
|
||||
--
|
||||
|_ sut/type
|
||||
++ dash
|
||||
|= {mil/tape lim/char lam/tape}
|
||||
^- tape
|
||||
=/ esc (~(gas in *(set @tD)) lam)
|
||||
:- lim
|
||||
|- ^- tape
|
||||
?~ mil [lim ~]
|
||||
?: ?| =(lim i.mil)
|
||||
=('\\' i.mil)
|
||||
(~(has in esc) i.mil)
|
||||
==
|
||||
['\\' i.mil $(mil t.mil)]
|
||||
?: (lte ' ' i.mil)
|
||||
[i.mil $(mil t.mil)]
|
||||
['\\' ~(x ne (rsh 2 1 i.mil)) ~(x ne (end 2 1 i.mil)) $(mil t.mil)]
|
||||
::
|
||||
++ deal |=(lum/* (dish dole lum))
|
||||
++ dial
|
||||
|= ham/cape
|
||||
=+ gid=*(set @ud)
|
||||
=| top-level=? :: don't need circumfix punctuation
|
||||
=< `tank`-:$
|
||||
|%
|
||||
++ many
|
||||
|= haz/(list wine)
|
||||
^- {(list tank) (set @ud)}
|
||||
?~ haz [~ gid]
|
||||
=^ mor gid $(haz t.haz)
|
||||
=^ dis gid ^$(q.ham i.haz)
|
||||
[[dis mor] gid]
|
||||
::
|
||||
++ $
|
||||
^- {tank (set @ud)}
|
||||
?- q.ham
|
||||
$noun :_(gid [%leaf '*' ~])
|
||||
$path :_(gid [%leaf '/' ~])
|
||||
$type :_(gid [%leaf '#' 't' ~])
|
||||
$void :_(gid [%leaf '#' '!' ~])
|
||||
$wool :_(gid [%leaf '*' '"' '"' ~])
|
||||
$wall :_(gid [%leaf '*' '\'' '\'' ~])
|
||||
$yarn :_(gid [%leaf '"' '"' ~])
|
||||
{$mato *} :_(gid [%leaf '@' (trip p.q.ham)])
|
||||
{$gate *}
|
||||
=^ sam gid
|
||||
?. ?=([%plot * * *] r.q.ham)
|
||||
?: ?=(%plot -.r.q.ham)
|
||||
%- (slog -:$(q.ham r.q.ham) ~)
|
||||
`gid
|
||||
`gid
|
||||
[`u=- +]:$(q.ham i.p.r.q.ham, top-level |)
|
||||
:_ gid
|
||||
:+ %rose
|
||||
:- ?> ?=(%core -.q.q.ham)
|
||||
?: ?=(%dry q.p.q.q.q.ham)
|
||||
" -> "
|
||||
" ~> "
|
||||
?: top-level
|
||||
["" ""]
|
||||
["(" ")"]
|
||||
:+ ?~(sam leaf+"_" u.sam)
|
||||
=/ res (mule |.((~(play ut q.q.ham) p.q.ham)))
|
||||
?- -.res
|
||||
%& duck(sut p.res)
|
||||
%| leaf+"###"
|
||||
==
|
||||
~
|
||||
::
|
||||
{$core *}
|
||||
=^ sam gid
|
||||
?. ?=([%plot * * ~] q.q.ham)
|
||||
`gid
|
||||
[`u=- +]:$(q.ham i.p.q.q.ham)
|
||||
:_ gid
|
||||
?~ sam
|
||||
:+ %rose
|
||||
[[' ' ~] ['<' ~] ['>' ~]]
|
||||
|- ^- (list tank)
|
||||
?~ p.q.ham ~
|
||||
[[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
|
||||
:+ %rose
|
||||
[" -> " "" ""]
|
||||
:+ u.sam
|
||||
:+ %rose
|
||||
[[' ' ~] ['<' ~] ['>' ~]]
|
||||
|- ^- (list tank)
|
||||
?~ p.q.ham ~
|
||||
[[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
|
||||
~
|
||||
::
|
||||
{$face *}
|
||||
=^ cox gid $(q.ham q.q.ham)
|
||||
:_(gid [%palm [['/' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~])
|
||||
::
|
||||
{$list *}
|
||||
=^ cox gid $(q.ham q.q.ham)
|
||||
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
|
||||
::
|
||||
{$bswt *}
|
||||
=^ coz gid (many p.q.ham)
|
||||
:_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz])
|
||||
::
|
||||
{$plot *}
|
||||
=^ coz gid (many p.q.ham)
|
||||
:_(gid [%rose [[' ' ~] ['{' ~] ['}' ~]] coz])
|
||||
::
|
||||
{$pear *}
|
||||
:_(gid [%leaf '$' ~(rend co [%$ p.q.ham q.q.ham])])
|
||||
::
|
||||
{$stop *}
|
||||
=+ num=~(rend co [%$ %ud p.q.ham])
|
||||
?: (~(has in gid) p.q.ham)
|
||||
:_(gid [%leaf '#' num])
|
||||
=^ cox gid
|
||||
%= $
|
||||
gid (~(put in gid) p.q.ham)
|
||||
q.ham (~(got by p.ham) p.q.ham)
|
||||
==
|
||||
:_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~])
|
||||
::
|
||||
{$tree *}
|
||||
=^ cox gid $(q.ham q.q.ham)
|
||||
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
|
||||
::
|
||||
{$unit *}
|
||||
=^ cox gid $(q.ham q.q.ham)
|
||||
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
|
||||
==
|
||||
--
|
||||
::
|
||||
++ dish !:
|
||||
|= {ham/cape lum/*} ^- tank
|
||||
~| [%dish-h ?@(q.ham q.ham -.q.ham)]
|
||||
~| [%lump lum]
|
||||
~| [%ham ham]
|
||||
%- need
|
||||
=| gil/(set {@ud *})
|
||||
|- ^- (unit tank)
|
||||
?- q.ham
|
||||
$noun
|
||||
%= $
|
||||
q.ham
|
||||
?: ?=(@ lum)
|
||||
[%mato %$]
|
||||
:- %plot
|
||||
|- ^- (list wine)
|
||||
[%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))]
|
||||
==
|
||||
::
|
||||
$path
|
||||
:- ~
|
||||
:+ %rose
|
||||
[['/' ~] ['/' ~] ~]
|
||||
|- ^- (list tank)
|
||||
?~ lum ~
|
||||
?@ lum !!
|
||||
?> ?=(@ -.lum)
|
||||
[[%leaf (rip 3 -.lum)] $(lum +.lum)]
|
||||
::
|
||||
$type
|
||||
=+ tyr=|.((dial dole))
|
||||
=+ vol=tyr(sut lum)
|
||||
=+ cis=;;(tank .*(vol [%9 2 %0 1]))
|
||||
:^ ~ %palm
|
||||
[~ ~ ~ ~]
|
||||
[[%leaf '#' 't' '/' ~] cis ~]
|
||||
::
|
||||
$wall
|
||||
:- ~
|
||||
:+ %rose
|
||||
[[' ' ~] ['<' '|' ~] ['|' '>' ~]]
|
||||
|- ^- (list tank)
|
||||
?~ lum ~
|
||||
?@ lum !!
|
||||
[[%leaf (trip ;;(@ -.lum))] $(lum +.lum)]
|
||||
::
|
||||
$wool
|
||||
:- ~
|
||||
:+ %rose
|
||||
[[' ' ~] ['<' '<' ~] ['>' '>' ~]]
|
||||
|- ^- (list tank)
|
||||
?~ lum ~
|
||||
?@ lum !!
|
||||
[(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
|
||||
::
|
||||
$yarn
|
||||
[~ %leaf (dash (tape lum) '"' "\{")]
|
||||
::
|
||||
$void
|
||||
~
|
||||
::
|
||||
{$mato *}
|
||||
?. ?=(@ lum)
|
||||
~
|
||||
:+ ~
|
||||
%leaf
|
||||
?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
|
||||
~(rend co [%$ p.q.ham lum])
|
||||
$$ ~(rend co [%$ %ud lum])
|
||||
$t (dash (rip 3 lum) '\'' ~)
|
||||
$tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])]
|
||||
==
|
||||
::
|
||||
{$gate *}
|
||||
!!
|
||||
::
|
||||
{$core *}
|
||||
:: XX needs rethinking for core metal
|
||||
:: ?. ?=(^ lum) ~
|
||||
:: => .(lum `*`lum)
|
||||
:: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
|
||||
:: ^= tok
|
||||
:: |- ^- (unit (list tank))
|
||||
:: ?~ p.q.ham
|
||||
:: =+ den=^$(q.ham q.q.ham)
|
||||
:: ?~(den ~ [~ u.den ~])
|
||||
:: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum)
|
||||
:: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
|
||||
[~ (dial ham)]
|
||||
::
|
||||
{$face *}
|
||||
=+ wal=$(q.ham q.q.ham)
|
||||
?~ wal
|
||||
~
|
||||
[~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
|
||||
::
|
||||
{$list *}
|
||||
?: =(~ lum)
|
||||
[~ %leaf '~' ~]
|
||||
=- ?~ tok
|
||||
~
|
||||
[~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
|
||||
^= tok
|
||||
|- ^- (unit (list tank))
|
||||
?: ?=(@ lum)
|
||||
?.(=(~ lum) ~ [~ ~])
|
||||
=+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
|
||||
?. &(?=(^ for) ?=(^ aft))
|
||||
~
|
||||
[~ u.for u.aft]
|
||||
::
|
||||
{$bswt *}
|
||||
|- ^- (unit tank)
|
||||
?~ p.q.ham
|
||||
~
|
||||
=+ wal=^$(q.ham i.p.q.ham)
|
||||
?~ wal
|
||||
$(p.q.ham t.p.q.ham)
|
||||
wal
|
||||
::
|
||||
{$plot *}
|
||||
=- ?~ tok
|
||||
~
|
||||
[~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
|
||||
^= tok
|
||||
|- ^- (unit (list tank))
|
||||
?~ p.q.ham
|
||||
~
|
||||
?: ?=({* ~} p.q.ham)
|
||||
=+ wal=^$(q.ham i.p.q.ham)
|
||||
?~(wal ~ [~ [u.wal ~]])
|
||||
?@ lum
|
||||
~
|
||||
=+ gim=^$(q.ham i.p.q.ham, lum -.lum)
|
||||
?~ gim
|
||||
~
|
||||
=+ myd=$(p.q.ham t.p.q.ham, lum +.lum)
|
||||
?~ myd
|
||||
~
|
||||
[~ u.gim u.myd]
|
||||
::
|
||||
{$pear *}
|
||||
?. =(lum q.q.ham)
|
||||
~
|
||||
=. p.q.ham
|
||||
(rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
|
||||
=+ fox=$(q.ham [%mato p.q.ham])
|
||||
?> ?=({~ $leaf ^} fox)
|
||||
?: ?=(?($n $tas) p.q.ham)
|
||||
fox
|
||||
[~ %leaf '%' p.u.fox]
|
||||
::
|
||||
{$stop *}
|
||||
?: (~(has in gil) [p.q.ham lum]) ~
|
||||
=+ kep=(~(get by p.ham) p.q.ham)
|
||||
?~ kep
|
||||
~|([%stop-loss p.q.ham] !!)
|
||||
$(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep)
|
||||
::
|
||||
{$tree *}
|
||||
=- ?~ tok
|
||||
~
|
||||
[~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
|
||||
^= tok
|
||||
=+ tuk=*(list tank)
|
||||
|- ^- (unit (list tank))
|
||||
?: =(~ lum)
|
||||
[~ tuk]
|
||||
?. ?=({n/* l/* r/*} lum)
|
||||
~
|
||||
=+ rol=$(lum r.lum)
|
||||
?~ rol
|
||||
~
|
||||
=+ tim=^$(q.ham q.q.ham, lum n.lum)
|
||||
?~ tim
|
||||
~
|
||||
$(lum l.lum, tuk [u.tim u.rol])
|
||||
::
|
||||
{$unit *}
|
||||
?@ lum
|
||||
?.(=(~ lum) ~ [~ %leaf '~' ~])
|
||||
?. =(~ -.lum)
|
||||
~
|
||||
=+ wal=$(q.ham q.q.ham, lum +.lum)
|
||||
?~ wal
|
||||
~
|
||||
[~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
|
||||
==
|
||||
::
|
||||
++ doge
|
||||
|= ham/cape
|
||||
=- ?+ woz woz
|
||||
{$list * {$mato $'ta'}} %path
|
||||
{$list * {$mato $'t'}} %wall
|
||||
{$list * {$mato $'tD'}} %yarn
|
||||
{$list * $yarn} %wool
|
||||
==
|
||||
^= woz
|
||||
^- wine
|
||||
?. ?=({$stop *} q.ham)
|
||||
?: ?& ?= {$bswt {$pear $n $0} {$plot {$pear $n $0} {$face *} ~} ~}
|
||||
q.ham
|
||||
=(1 (met 3 p.i.t.p.i.t.p.q.ham))
|
||||
==
|
||||
[%unit =<([p q] i.t.p.i.t.p.q.ham)]
|
||||
q.ham
|
||||
=+ may=(~(get by p.ham) p.q.ham)
|
||||
?~ may
|
||||
q.ham
|
||||
=+ nul=[%pear %n 0]
|
||||
?. ?& ?=({$bswt *} u.may)
|
||||
?=({* * ~} p.u.may)
|
||||
|(=(nul i.p.u.may) =(nul i.t.p.u.may))
|
||||
==
|
||||
q.ham
|
||||
=+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may)
|
||||
?: ?& ?=({$plot {$face *} {$face * $stop *} ~} din)
|
||||
=(p.q.ham p.q.i.t.p.din)
|
||||
=(1 (met 3 p.i.p.din))
|
||||
=(1 (met 3 p.i.t.p.din))
|
||||
==
|
||||
:+ %list
|
||||
(cat 3 p.i.p.din p.i.t.p.din)
|
||||
q.i.p.din
|
||||
?: ?& ?= $: $plot
|
||||
{$face *}
|
||||
{$face * $stop *}
|
||||
{{$face * $stop *} ~}
|
||||
==
|
||||
din
|
||||
=(p.q.ham p.q.i.t.p.din)
|
||||
=(p.q.ham p.q.i.t.t.p.din)
|
||||
=(1 (met 3 p.i.p.din))
|
||||
=(1 (met 3 p.i.t.p.din))
|
||||
=(1 (met 3 p.i.t.t.p.din))
|
||||
==
|
||||
:+ %tree
|
||||
%^ cat
|
||||
3
|
||||
p.i.p.din
|
||||
(cat 3 p.i.t.p.din p.i.t.t.p.din)
|
||||
q.i.p.din
|
||||
q.ham
|
||||
::
|
||||
++ dole
|
||||
^- cape
|
||||
=+ gil=*(set type)
|
||||
=+ dex=[p=*(map type @) q=*(map @ wine)]
|
||||
=< [q.p q]
|
||||
|- ^- {p/{p/(map type @) q/(map @ wine)} q/wine}
|
||||
=- [p.tez (doge q.p.tez q.tez)]
|
||||
^= tez
|
||||
^- {p/{p/(map type @) q/(map @ wine)} q/wine}
|
||||
?: (~(meet ut sut) -:!>(*type))
|
||||
[dex %type]
|
||||
?- sut
|
||||
$noun [dex sut]
|
||||
$void [dex sut]
|
||||
{$atom *} [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])]
|
||||
{$cell *}
|
||||
=+ hin=$(sut p.sut)
|
||||
=+ yon=$(dex p.hin, sut q.sut)
|
||||
:- p.yon
|
||||
:- %plot
|
||||
?:(?=({$plot *} q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
|
||||
::
|
||||
{$core *}
|
||||
?: ?=([[%$ * [[%$ @ *] ~ ~]] ~ ~] q.r.q.sut)
|
||||
=/ dad $(sut p.sut)
|
||||
:- p.dad
|
||||
~! q.r.q.sut
|
||||
[%gate q.n.q.q.n.q.r.q.sut sut(r.p.q %gold) q.dad]
|
||||
=+ yad=$(sut p.sut)
|
||||
:- p.yad
|
||||
=+ ^= doy ^- {p/(list @ta) q/wine}
|
||||
?: ?=({$core *} q.yad)
|
||||
[p.q.yad q.q.yad]
|
||||
[~ q.yad]
|
||||
:- %core
|
||||
:_ q.doy
|
||||
:_ p.doy
|
||||
%^ cat 3
|
||||
%~ rent co
|
||||
:+ %$ %ud
|
||||
%- ~(rep by (~(run by q.r.q.sut) |=(tome ~(wyt by q.+<))))
|
||||
|=([[@ a=@u] b=@u] (add a b))
|
||||
%^ cat 3
|
||||
?-(r.p.q.sut $gold '.', $iron '|', $lead '?', $zinc '&')
|
||||
=+ gum=(mug q.r.q.sut)
|
||||
%+ can 3
|
||||
:~ [1 (add 'a' (mod gum 26))]
|
||||
[1 (add 'a' (mod (div gum 26) 26))]
|
||||
[1 (add 'a' (mod (div gum 676) 26))]
|
||||
==
|
||||
::
|
||||
{$hint *}
|
||||
$(sut q.sut)
|
||||
::
|
||||
{$face *}
|
||||
=+ yad=$(sut q.sut)
|
||||
?^(p.sut yad [p.yad [%face p.sut q.yad]])
|
||||
::
|
||||
{$fork *}
|
||||
=+ yed=(sort ~(tap in p.sut) aor)
|
||||
=- [p [%bswt q]]
|
||||
|- ^- {p/{p/(map type @) q/(map @ wine)} q/(list wine)}
|
||||
?~ yed
|
||||
[dex ~]
|
||||
=+ mor=$(yed t.yed)
|
||||
=+ dis=^$(dex p.mor, sut i.yed)
|
||||
[p.dis q.dis q.mor]
|
||||
::
|
||||
{$hold *}
|
||||
=+ hey=(~(get by p.dex) sut)
|
||||
?^ hey
|
||||
[dex [%stop u.hey]]
|
||||
?: (~(has in gil) sut)
|
||||
=+ dyr=+(~(wyt by p.dex))
|
||||
[[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
|
||||
=+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut))
|
||||
=+ rey=(~(get by p.p.rom) sut)
|
||||
?~ rey
|
||||
rom
|
||||
[[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
|
||||
==
|
||||
::
|
||||
++ duck (dial dole)
|
||||
--
|
||||
@ -393,6 +393,35 @@
|
||||
(se-link gyl)
|
||||
+>.$
|
||||
::
|
||||
++ se-tab :: print tab completions
|
||||
|= tl/(list {=cord =tank})
|
||||
^+ +>
|
||||
=/ lots (gth (lent tl) 10)
|
||||
=/ long
|
||||
?: lots
|
||||
0
|
||||
(roll (turn tl |=([=term *] (met 3 term))) max)
|
||||
%- se-dump
|
||||
%- flop
|
||||
^- (list tank)
|
||||
:- leaf+"-----"
|
||||
%+ turn tl
|
||||
|= [=term =type=tank]
|
||||
?: lots
|
||||
leaf+(trip term)
|
||||
=/ type-text ~(ram re type-tank)
|
||||
=/ spaces (trip (fil 3 (sub long (met 3 term)) ' '))
|
||||
=/ =tape "{(trip term)} {spaces} {type-text}"
|
||||
:: If type is too long and not the only result, abbreviate
|
||||
::
|
||||
?: (gth (lent type-text) edg)
|
||||
?: ?=([* ~] tl)
|
||||
:+ %rose
|
||||
["" "" ""]
|
||||
~[leaf+(trip term) type-tank]
|
||||
leaf+(weld (scag (sub edg 3) tape) "...")
|
||||
leaf+tape
|
||||
::
|
||||
++ se-dump :: print tanks
|
||||
|= tac/(list tank)
|
||||
^+ +>
|
||||
@ -589,6 +618,7 @@
|
||||
$f (ta-aro %r)
|
||||
$g ?~ ris ta-bel
|
||||
(ta-hom(pos.hit num.hit, ris ~) [%set ~])
|
||||
$i ta-tab
|
||||
$k =+ len=(lent buf.say.inp)
|
||||
?: =(pos.inp len)
|
||||
ta-bel
|
||||
@ -649,6 +679,7 @@
|
||||
$(p.fec t.p.fec, +>.^$ ^$(fec i.p.fec))
|
||||
{$nex *} ta-nex
|
||||
{$pro *} (ta-pro +.fec)
|
||||
{$tab *} +>(..ta (se-tab p.fec))
|
||||
{$tan *} +>(..ta (se-dump p.fec))
|
||||
{$sag *} +>(..ta (se-blit fec))
|
||||
{$sav *} +>(..ta (se-blit fec))
|
||||
@ -856,6 +887,9 @@
|
||||
++ ta-ret :: hear return
|
||||
(ta-act %ret ~)
|
||||
::
|
||||
++ ta-tab :: hear tab
|
||||
(ta-act %tab pos.inp)
|
||||
::
|
||||
++ ta-ser :: reverse search
|
||||
|= ext/(list @c)
|
||||
^+ +>
|
||||
|
||||
@ -6,8 +6,9 @@
|
||||
++ sole-action :: sole to app
|
||||
$% :: {$abo ~} :: reset interaction
|
||||
{$det sole-change} :: command line edit
|
||||
{$ret ~} :: submit and clear
|
||||
{$clr ~} :: exit context
|
||||
{$ret ~} :: submit and clear
|
||||
{$clr ~} :: exit context
|
||||
{$tab pos/@ud} :: tab complete
|
||||
== ::
|
||||
++ sole-buffer (list @c) :: command state
|
||||
++ sole-change :: network change
|
||||
@ -20,21 +21,22 @@
|
||||
$% {$del p/@ud} :: delete one at
|
||||
{$ins p/@ud q/@c} :: insert at
|
||||
{$mor p/(list sole-edit)} :: combination
|
||||
{$nop ~} :: no-op
|
||||
{$nop ~} :: no-op
|
||||
{$set p/sole-buffer} :: discontinuity
|
||||
== ::
|
||||
++ sole-effect :: app to sole
|
||||
$% {$bel ~} :: beep
|
||||
$% {$bel ~} :: beep
|
||||
{$blk p/@ud q/@c} :: blink+match char at
|
||||
{$clr ~} :: clear screen
|
||||
{$clr ~} :: clear screen
|
||||
{$det sole-change} :: edit command
|
||||
{$err p/@ud} :: error point
|
||||
{$klr p/styx} :: styled text line
|
||||
{$mor p/(list sole-effect)} :: multiple effects
|
||||
{$nex ~} :: save clear command
|
||||
{$nex ~} :: save clear command
|
||||
{$pro sole-prompt} :: set prompt
|
||||
{$sag p/path q/*} :: save to jamfile
|
||||
{$sav p/path q/@} :: save to file
|
||||
{$tab p/(list {=cord =tank})} :: tab-complete list
|
||||
{$tan p/(list tank)} :: classic tank
|
||||
:: {$taq p/tanq} :: modern tank
|
||||
{$txt p/tape} :: text line
|
||||
|
||||
@ -5178,7 +5178,7 @@
|
||||
::
|
||||
++ pfix :: discard first rule
|
||||
~/ %pfix
|
||||
|* sam=*
|
||||
|* sam={vex/edge sab/rule}
|
||||
%. sam
|
||||
(comp |*({a/* b/*} b))
|
||||
::
|
||||
@ -5210,7 +5210,7 @@
|
||||
::
|
||||
++ sfix :: discard second rule
|
||||
~/ %sfix
|
||||
|* sam=*
|
||||
|* sam={vex/edge sab/rule}
|
||||
%. sam
|
||||
(comp |*({a/* b/*} a))
|
||||
::
|
||||
@ -9915,10 +9915,12 @@
|
||||
%+ turn
|
||||
hag.$
|
||||
|= {p/type q/foot}
|
||||
:- %hold
|
||||
?. ?=({$core *} p)
|
||||
~_ (dunk %fire-type)
|
||||
~_ leaf+"expected-fork-to-be-core"
|
||||
~_ (dunk(sut p) %fork-type)
|
||||
~>(%mean.'fire-core' !!)
|
||||
:- %hold
|
||||
=+ dox=[%core q.q.p q.p(r.p %gold)]
|
||||
?: ?=($dry -.q)
|
||||
:: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-dry)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user