urbit/pkg/arvo/lib/hood/drum.hoon

1008 lines
32 KiB
Plaintext
Raw Normal View History

/- *sole
/+ sole
|%
2021-08-11 19:23:36 +03:00
+$ state state-4
+$ any-state
2021-08-11 19:23:36 +03:00
$~ *state
$% state-4
state-3
state-2
==
+$ state-4 [%4 pith-4]
+$ state-3 [%3 pith-3]
+$ state-2 [%2 pith-2]
::
+$ pith-4
$: eel=(set gill:gall) :: connect to
bin=(map bone source) :: terminals
== ::
::
++ pith-3 ::
$: eel=(set gill:gall) :: connect to
ray=(map dude:gall desk) ::
fur=(map dude:gall (unit *)) :: servers
bin=(map bone source) :: terminals
== ::
:: ::
2017-11-30 00:29:35 +03:00
++ pith-2 ::
$: eel=(set gill:gall) :: connect to
ray=(set well:gall) ::
fur=(map dude:gall (unit *)) :: servers
bin=(map bone source) :: terminals
2015-05-17 04:05:56 +03:00
== ::
:: ::
++ kill :: kill ring
$: pos=@ud :: ring position
num=@ud :: number of entries
max=_60 :: max entries
old=(list (list @c)) :: entries proper
== ::
2015-05-17 04:05:56 +03:00
++ source :: input device
$: edg=_80 :: terminal columns
off=@ud :: window offset
kil=kill :: kill buffer
inx=@ud :: ring index
fug=(map gill:gall (unit target)) :: connections
mir=(pair @ud stub) :: mirrored terminal
2015-05-17 04:05:56 +03:00
== ::
++ 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
2015-05-17 04:05:56 +03:00
== ::
++ search :: reverse-i-search
$: pos=@ud :: search position
str=(list @c) :: search string
2015-05-17 04:05:56 +03:00
== ::
++ target :: application target
2016-11-08 04:40:00 +03:00
$: $= blt :: curr & prev belts
%+ pair
(unit dill-belt:dill)
(unit dill-belt:dill)
ris=(unit search) :: reverse-i-search
hit=history :: all past input
pom=sole-prompt :: static prompt
inp=sole-command :: input state
2015-05-17 04:05:56 +03:00
== ::
2015-09-02 01:20:17 +03:00
--
:: :: ::
2015-05-17 04:05:56 +03:00
:::: :: ::
:: :: ::
2015-09-02 01:20:17 +03:00
|%
2017-11-30 00:29:35 +03:00
++ en-gill :: gill to wire
|= gyl=gill:gall
2016-11-12 04:26:19 +03:00
^- wire
[%drum %phat (scot %p p.gyl) q.gyl ~]
2015-05-17 04:05:56 +03:00
::
2017-11-30 00:29:35 +03:00
++ de-gill :: gill from wire
|= way=wire ^- gill:gall
?>(?=([@ @ ~] way) [(slav %p i.way) i.t.way])
2015-09-02 01:20:17 +03:00
--
2020-06-16 10:29:17 +03:00
:: TODO: remove .ost
2016-11-17 04:42:58 +03:00
::
2021-08-18 01:16:48 +03:00
|= [hid=bowl:gall state]
=* sat +<+
2019-11-14 21:39:50 +03:00
=/ ost 0
=+ (~(gut by bin) ost *source)
2015-10-23 01:45:48 +03:00
=* dev -
=| moz=(list card:agent:gall)
=| biz=(list dill-blit:dill)
|%
++ this .
+$ state ^state :: proxy
+$ any-state ^any-state :: proxy
++ on-init (poke-link our.hid %dojo)
2016-09-07 07:54:25 +03:00
++ diff-sole-effect-phat :: app event
|= [way=wire fec=sole-effect]
2015-09-02 01:20:17 +03:00
=< se-abet =< se-view
2017-11-30 00:29:35 +03:00
=+ gyl=(de-gill way)
2015-09-02 01:20:17 +03:00
?: (se-aint gyl) +>.$
(se-diff gyl fec)
::
++ peer ::
|= pax=path
2016-09-08 08:42:40 +03:00
~| [%drum-unauthorized our+our.hid src+src.hid] :: ourself
2021-07-17 02:54:20 +03:00
?> (team:title our.hid src.hid) :: or our own moon
2016-09-08 08:30:47 +03:00
=< se-abet =< se-view
2016-09-08 08:42:40 +03:00
(se-text "[{<src.hid>}, driving {<our.hid>}]")
2015-09-02 01:20:17 +03:00
::
2016-09-07 07:54:25 +03:00
++ poke-dill-belt :: terminal event
|= bet=dill-belt:dill
2015-09-02 01:20:17 +03:00
=< se-abet =< se-view
(se-belt bet)
::
2018-10-11 23:19:30 +03:00
++ poke-dill-blit :: terminal output
|= bit=dill-blit:dill
2018-10-11 23:19:30 +03:00
se-abet:(se-blit-sys bit)
::
2016-09-07 07:54:25 +03:00
++ poke-link :: connect app
|= gyl=gill:gall
2015-09-02 01:20:17 +03:00
=< se-abet =< se-view
(se-link gyl)
::
2016-09-07 07:54:25 +03:00
++ poke-unlink :: disconnect app
|= gyl=gill:gall
2015-10-20 23:48:11 +03:00
=< se-abet =< se-view
2019-11-21 01:26:13 +03:00
(se-drop:(se-pull gyl) & gyl)
2015-10-20 23:48:11 +03:00
::
2016-09-07 07:54:25 +03:00
++ poke-exit :: shutdown
2018-03-19 07:18:20 +03:00
|= ~
se-abet:(se-blit-sys `dill-blit:dill`[%qit ~])
::
2016-09-07 07:54:25 +03:00
++ poke-put :: write file
|= [pax=path txt=@]
2016-05-02 21:56:00 +03:00
se-abet:(se-blit-sys [%sav pax txt]) ::
2016-04-30 02:18:59 +03:00
::
2019-11-14 21:39:50 +03:00
++ poke
|= [=mark =vase]
?> =(our src):hid
2019-11-14 21:39:50 +03:00
?+ mark ~|([%poke-drum-bad-mark mark] !!)
2020-06-16 10:29:17 +03:00
%drum-dill-belt =;(f (f !<(_+<.f vase)) poke-dill-belt)
%drum-dill-blit =;(f (f !<(_+<.f vase)) poke-dill-blit)
2019-11-14 21:39:50 +03:00
%drum-exit =;(f (f !<(_+<.f vase)) poke-exit)
2020-06-16 10:29:17 +03:00
%drum-link =;(f (f !<(_+<.f vase)) poke-link)
%drum-put =;(f (f !<(_+<.f vase)) poke-put)
%drum-unlink =;(f (f !<(_+<.f vase)) poke-unlink)
2019-11-14 21:39:50 +03:00
==
::
++ on-load
2020-11-10 06:32:48 +03:00
|= [hood-version=@ud old=any-state]
=< se-abet =< se-view
=? old ?=(%2 -.old) [%4 [eel bin]:old]
=? old ?=(%3 -.old) [%4 [eel bin]:old]
::
?> ?=(%4 -.old)
=. sat old
2020-06-18 07:58:47 +03:00
=. dev (~(gut by bin) ost *source)
2021-08-11 19:23:36 +03:00
this
::
2016-09-07 07:54:25 +03:00
++ reap-phat :: ack connect
|= [way=wire saw=(unit tang)]
2015-09-02 01:20:17 +03:00
=< se-abet =< se-view
2017-11-30 00:29:35 +03:00
=+ gyl=(de-gill way)
2015-09-02 01:20:17 +03:00
?~ saw
(se-join gyl)
2019-11-14 21:39:50 +03:00
:: Don't print stack trace because we probably just crashed to
:: indicate we don't connect to the console.
::
(se-drop & gyl)
::
2016-09-07 07:54:25 +03:00
++ take-coup-phat :: ack poke
|= [way=wire saw=(unit tang)]
2015-09-02 01:20:17 +03:00
=< se-abet =< se-view
?~ saw +>
2017-11-30 00:29:35 +03:00
=+ gyl=(de-gill way)
2015-09-02 01:20:17 +03:00
?: (se-aint gyl) +>.$
2019-11-20 22:58:30 +03:00
%- se-dump:(se-drop:(se-pull gyl) & gyl)
2016-09-08 08:30:47 +03:00
:_ u.saw
2019-11-14 21:39:50 +03:00
>[%drum-coup-fail src.hid gyl]<
2015-09-02 01:20:17 +03:00
::
2019-11-14 21:39:50 +03:00
++ take-agent
2019-11-19 07:36:21 +03:00
|= [=wire =sign:agent:gall]
2021-07-17 02:54:20 +03:00
?+ wire ~|([%drum-bad-take-agent wire -.sign] !!)
[%phat *]
2019-11-14 21:39:50 +03:00
?- -.sign
2021-07-17 02:54:20 +03:00
%poke-ack (take-coup-phat t.wire p.sign)
%watch-ack (reap-phat t.wire p.sign)
%kick (quit-phat t.wire)
2019-11-14 21:39:50 +03:00
%fact
2021-07-17 02:54:20 +03:00
%+ diff-sole-effect-phat t.wire
2019-11-14 21:39:50 +03:00
?> ?=(%sole-effect p.cage.sign)
!<(sole-effect q.cage.sign)
==
==
::
2015-09-02 01:20:17 +03:00
++ quit-phat ::
|= way=wire
2015-09-02 01:20:17 +03:00
=< se-abet =< se-view
2017-11-30 00:29:35 +03:00
=+ gyl=(de-gill way)
2019-11-14 21:39:50 +03:00
~& [%drum-quit src.hid gyl]
2015-09-02 01:20:17 +03:00
(se-drop %| gyl)
:: :: ::
:::: :: ::
:: :: ::
++ se-abet :: resolve
^- (quip card:agent:gall state)
=. . se-subze:se-adze
:_ sat(bin (~(put by bin) ost dev))
2019-11-19 07:36:21 +03:00
^- (list card:agent:gall)
2019-11-14 21:39:50 +03:00
?~ biz (flop moz)
:_ (flop moz)
=/ =dill-blit:dill ?~(t.biz i.biz [%mor (flop biz)])
[%give %fact ~[/drum] %dill-blit !>(dill-blit)]
2016-09-07 07:54:25 +03:00
::
2015-09-02 01:20:17 +03:00
++ se-adze :: update connections
2015-10-23 01:45:48 +03:00
^+ .
%+ roll
%+ sort
~(tap in eel)
|= [[@ a=term] [@ b=term]]
?: =(a %dojo) %.n
?: =(b %dojo) %.y
(aor a b)
2015-10-23 01:45:48 +03:00
=< .(con +>)
|: $:,[gil=gill:gall con=_.] ^+ con
2015-10-23 01:45:48 +03:00
=. +>.$ con
?: (~(has by fug) gil)
+>.$
(se-peer gil)
::
++ se-subze :: downdate connections
2019-11-14 21:39:50 +03:00
=< .(dev (~(got by bin) ost))
=. bin (~(put by bin) ost dev)
2015-10-23 01:45:48 +03:00
^+ .
%- ~(rep by bin)
=< .(con +>)
|: $:,[[ost=bone dev=source] con=_.] ^+ con
2019-11-14 21:39:50 +03:00
=+ xeno=se-subze-local:%_(con ost ost, dev dev)
xeno(ost ost.con, dev dev.con, bin (~(put by bin) ost dev.xeno))
2015-10-23 01:45:48 +03:00
::
++ se-subze-local
^+ .
%- ~(rep by fug)
=< .(con +>)
|: $:,[[gil=gill:gall *] con=_.] ^+ con
2015-10-23 01:45:48 +03:00
=. +>.$ con
?: (~(has in eel) gil)
+>.$
(se-nuke gil)
2015-09-02 01:20:17 +03:00
::
++ se-aint :: ignore result
|= gyl=gill:gall
2015-09-02 01:20:17 +03:00
^- ?
2019-11-14 21:39:50 +03:00
?. (~(has by bin) ost) &
2015-09-02 01:20:17 +03:00
=+ gyr=(~(get by fug) gyl)
2018-03-19 07:18:20 +03:00
|(?=(~ gyr) ?=(~ u.gyr))
2015-09-02 01:20:17 +03:00
::
++ se-alas :: recalculate index
|= gyl=gill:gall
2015-09-02 01:20:17 +03:00
=+ [xin=0 wag=se-amor]
|- ^+ +>.^$
?~ wag +>.^$(inx 0)
?: =(i.wag gyl) +>.^$(inx xin)
$(wag t.wag, xin +(xin))
::
++ se-amor :: live targets
^- (list gill:gall)
%+ skim ~(tap in eel)
|=(a=gill:gall ?=([~ ~ *] (~(get by fug) a)))
2015-09-02 01:20:17 +03:00
::
++ se-anon :: rotate index
=+ wag=se-amor
?~ wag +
2015-12-21 00:16:39 +03:00
:: ~& [%se-anon inx+inx wag+wag nex+(mod +(inx) (lent se-amor))]
2017-03-02 00:03:41 +03:00
+(off 0, inx (mod +(inx) (lent wag)))
2015-09-02 01:20:17 +03:00
::
++ se-agon :: current gill
^- (unit gill:gall)
2015-09-02 01:20:17 +03:00
=+ wag=se-amor
?~ wag ~
2019-11-21 01:26:13 +03:00
~| [inx=inx wag=wag fug=fug eel=eel]
`(snag inx `(list gill:gall)`wag)
2015-09-02 01:20:17 +03:00
::
++ se-belt :: handle input
|= bet=dill-belt:dill
2015-09-02 01:20:17 +03:00
^+ +>
?: ?=([?(%cru %hey %rez %yow) *] bet) :: target-agnostic
2016-09-09 03:57:05 +03:00
?- bet
[%cru *] (se-dump:(se-text (trip p.bet)) q.bet)
[%hey *] +>(mir [0 ~]) :: refresh
[%rez *] +>(edg (dec p.bet)) :: resize window
[%yow *] ~&([%no-yow -.bet] +>)
2016-09-09 03:57:05 +03:00
==
2015-09-02 01:20:17 +03:00
=+ gul=se-agon
2018-03-19 07:18:20 +03:00
?: |(?=(~ gul) (se-aint u.gul))
2016-09-02 05:37:58 +03:00
(se-blit %bel ~)
ta-abet:(ta-belt:(se-tame u.gul) bet)
2015-09-02 01:20:17 +03:00
::
++ se-drop :: disconnect
|= [pej=? gyl=gill:gall]
2015-09-02 01:20:17 +03:00
^+ +>
=+ lag=se-agon
?. (~(has by fug) gyl) +>.$
=. fug (~(del by fug) gyl)
=. eel ?.(pej eel (~(del in eel) gyl))
2016-07-04 09:27:08 +03:00
=. +>.$ ?. &(?=(^ lag) !=(gyl u.lag))
2015-09-02 01:20:17 +03:00
+>.$(inx 0)
(se-alas u.lag)
=. +>.$ (se-text "[unlinked from {<gyl>}]")
2016-09-08 08:42:40 +03:00
?: =(gyl [our.hid %dojo]) :: undead dojo
2015-06-02 21:36:56 +03:00
(se-link gyl)
2015-10-08 01:42:19 +03:00
+>.$
2015-09-02 01:20:17 +03:00
::
++ 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
::
2015-09-02 01:20:17 +03:00
++ se-dump :: print tanks
|= tac=(list tank)
2015-09-02 01:20:17 +03:00
^+ +>
=/ wol=wall
(zing (turn (flop tac) |=(a=tank (~(win re a) [0 edg]))))
2015-09-02 01:20:17 +03:00
|- ^+ +>.^$
?~ wol +>.^$
?. ((sane %t) (crip i.wol)) :: XX upstream validation
2016-10-14 04:18:55 +03:00
~& bad-text+<`*`i.wol>
$(wol t.wol)
2015-09-02 01:20:17 +03:00
$(wol t.wol, +>.^$ (se-blit %out (tuba i.wol)))
::
++ se-join :: confirm connection
|= gyl=gill:gall
2015-09-02 01:20:17 +03:00
^+ +>
=. +> (se-text "[linked to {<gyl>}]")
2018-03-19 07:18:20 +03:00
?> ?=(~ (~(got by fug) gyl))
2015-10-08 01:42:19 +03:00
(se-alas(fug (~(put by fug) gyl `*target)) gyl)
2015-09-02 01:20:17 +03:00
::
2016-09-07 07:54:25 +03:00
++ se-nuke :: teardown connection
|= gyl=gill:gall
2015-09-02 01:20:17 +03:00
^+ +>
2015-10-08 01:42:19 +03:00
(se-drop:(se-pull gyl) & gyl)
2015-09-02 01:20:17 +03:00
::
2015-10-20 23:48:11 +03:00
++ se-klin :: disconnect app
|= gyl=gill:gall
=/ gil=(unit gill:gall) se-agon
=. eel (~(del in eel) gyl)
?~ gil +>.$
?: =(gyl u.gil)
+>.$(inx 0)
(se-alas u.gil)
2015-10-20 23:48:11 +03:00
::
2015-09-02 01:20:17 +03:00
++ se-link :: connect to app
|= gyl=gill:gall
2015-09-02 01:20:17 +03:00
+>(eel (~(put in eel) gyl))
::
++ se-blit :: give output
|= bil=dill-blit:dill
2015-09-02 01:20:17 +03:00
+>(biz [bil biz])
::
++ se-blit-sys :: output to system
|= bil=dill-blit:dill ^+ +>
(se-emit %give %fact ~[/drum] %dill-blit !>(bil))
::
2015-09-02 01:20:17 +03:00
++ se-show :: show buffer, raw
|= lin=(pair @ud stub)
2015-09-02 01:20:17 +03:00
^+ +>
?: =(mir lin) +>
=. +> ?:(=(p.mir p.lin) +> (se-blit %hop p.lin))
=. +> ?:(=(q.mir q.lin) +> (se-blit %pom q.lin))
2015-09-02 01:20:17 +03:00
+>(mir lin)
::
2016-07-04 09:27:08 +03:00
++ se-just :: adjusted buffer
|= [pom=stub lin=(pair @ud (list @c))]
2015-09-02 01:20:17 +03:00
^+ +>
=/ pol (lent-char:klr pom)
=/ pos (add pol p.lin)
?: (gte (div (mul pol 100) edg) 35) :: old style (long prompt)
=/ off ?:((lte pos edg) 0 (sub pos edg))
%+ se-show
(sub pos off)
2018-04-23 05:41:24 +03:00
(swag:klr [off edg] (welp pom [*stye q.lin]~))
=/ end (sub edg pol)
=. off ?: (gth p.lin (add end off))
(sub p.lin end)
?: (lth p.lin off)
(min p.lin (dec off))
off
%+ se-show
(sub pos off)
2018-04-23 05:41:24 +03:00
(welp pom [*stye (swag [off end] q.lin)]~)
2015-09-02 01:20:17 +03:00
::
++ se-view :: flush buffer
2016-09-07 17:21:41 +03:00
^+ .
2015-09-02 01:20:17 +03:00
=+ gul=se-agon
2018-03-19 07:18:20 +03:00
?: |(?=(~ gul) (se-aint u.gul)) +
2016-09-07 17:21:41 +03:00
(se-just ta-vew:(se-tame u.gul))
2015-09-02 01:20:17 +03:00
::
2019-11-14 21:39:50 +03:00
++ se-emit
2019-11-19 07:36:21 +03:00
|= card:agent:gall
2019-11-14 21:39:50 +03:00
%_(+> moz [+< moz])
2015-09-02 01:20:17 +03:00
::
++ se-text :: return text
|= txt=tape
2015-09-02 01:20:17 +03:00
^+ +>
?. ((sane %t) (crip txt)) :: XX upstream validation
2016-10-14 04:18:55 +03:00
~& bad-text+<`*`txt>
+>
2015-09-02 01:20:17 +03:00
(se-blit %out (tuba txt))
::
++ se-poke :: send a poke
|= [gyl=gill:gall par=cage]
2019-11-14 21:39:50 +03:00
(se-emit %pass (en-gill gyl) %agent gyl %poke par)
2015-09-02 01:20:17 +03:00
::
++ se-peer :: send a peer
|= gyl=gill:gall
2021-07-23 14:07:58 +03:00
~> %slog.0^leaf/"drum: link {<[p q]:gyl>}"
=/ =path /sole/(cat 3 'drum_' (scot %p our.hid))
2016-09-07 07:32:40 +03:00
%- se-emit(fug (~(put by fug) gyl ~))
[%pass (en-gill gyl) %agent gyl %watch path]
2015-09-02 01:20:17 +03:00
::
++ se-pull :: cancel subscription
|= gyl=gill:gall
2019-11-14 21:39:50 +03:00
(se-emit %pass (en-gill gyl) %agent gyl %leave ~)
2015-09-02 01:20:17 +03:00
::
++ se-tame :: switch connection
|= gyl=gill:gall
2015-09-02 01:20:17 +03:00
^+ ta
~(. ta gyl (need (~(got by fug) gyl)))
2015-09-02 01:20:17 +03:00
::
++ se-diff :: receive results
|= [gyl=gill:gall fec=sole-effect]
2015-09-02 01:20:17 +03:00
^+ +>
ta-abet:(ta-fec:(se-tame gyl) fec)
::
++ ta :: per target
|_ [gyl=gill:gall target] :: app and state
++ ta-abet :: resolve
2015-09-02 01:20:17 +03:00
^+ ..ta
..ta(fug (~(put by fug) gyl ``target`+<+))
::
++ ta-poke |=(a=cage +>(..ta (se-poke gyl a))) :: poke gyl
2015-05-17 04:05:56 +03:00
::
2015-09-02 01:20:17 +03:00
++ ta-act :: send action
|= act=sole-action
2015-05-17 22:39:03 +03:00
^+ +>
2019-11-22 03:51:52 +03:00
(ta-poke %sole-action !>(act))
::
++ ta-id (cat 3 'drum_' (scot %p our.hid)) :: per-ship duct id
::
2015-09-02 01:20:17 +03:00
++ ta-aro :: hear arrow
|= key=?(%d %l %r %u)
2015-05-17 07:50:05 +03:00
^+ +>
=. ris ~
2015-09-02 01:20:17 +03:00
?- key
%d ?. =(num.hit pos.hit)
2015-09-02 01:20:17 +03:00
(ta-mov +(pos.hit))
?: =(0 (lent buf.say.inp))
ta-bel
(ta-hom:ta-nex %set ~)
%l ?: =(0 pos.inp) ta-bel
+>(pos.inp (dec pos.inp))
%r ?: =((lent buf.say.inp) pos.inp)
2015-09-02 01:20:17 +03:00
ta-bel
+>(pos.inp +(pos.inp))
%u ?:(=(0 pos.hit) ta-bel (ta-mov (dec pos.hit)))
2015-09-02 01:20:17 +03:00
==
2015-05-17 07:50:05 +03:00
::
++ ta-bel :: beep
2016-09-07 20:58:48 +03:00
.(..ta (se-blit %bel ~), q.blt ~) :: forget belt
2016-09-09 03:57:05 +03:00
::
++ ta-belt :: handle input
|= bet=dill-belt:dill
2016-09-09 03:57:05 +03:00
^+ +>
?< ?=([?(%cru %hey %rez %yow) *] bet) :: target-specific
2016-09-09 03:57:05 +03:00
=. blt [q.blt `bet] :: remember belt
?- bet
[%aro *] (ta-aro p.bet)
[%bac *] ta-bac
[%ctl *] (ta-ctl p.bet)
[%del *] ta-del
[%met *] (ta-met p.bet)
[%ret *] ta-ret
[%txt *] (ta-txt p.bet)
2016-09-09 03:57:05 +03:00
==
::
2015-09-02 01:20:17 +03:00
++ ta-det :: send edit
|= ted=sole-edit
2015-05-17 04:05:56 +03:00
^+ +>
2019-11-22 03:51:52 +03:00
%^ ta-act
ta-id
2019-11-22 03:51:52 +03:00
%det
[[his.ven.say.inp own.ven.say.inp] (sham buf.say.inp) ted]
2015-05-17 04:05:56 +03:00
::
2015-09-02 01:20:17 +03:00
++ 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)
?~ buf.say.inp
(ta-act ta-id %clr ~)
ta-bel
(ta-hom %del (dec pos.inp))
2015-09-02 01:20:17 +03:00
::
++ ta-ctl :: hear control
|= key=@ud
2015-05-17 04:05:56 +03:00
^+ +>
=. ris ?.(?=(?(%g %r) key) ~ ris)
?+ key ta-bel
%a +>(pos.inp 0)
%b (ta-aro %l)
%c ta-bel
%d ?^ buf.say.inp
ta-del
2021-07-18 21:21:13 +03:00
?: =([our.hid %dojo] gyl)
2021-07-16 21:46:12 +03:00
+>(..ta (se-blit qit+~)) :: quit pier
+>(..ta (se-klin gyl)) :: unlink app
%e +>(pos.inp (lent buf.say.inp))
%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)
2015-09-02 01:20:17 +03:00
?: =(pos.inp len)
2016-07-04 09:27:08 +03:00
ta-bel
(ta-kil %r [pos.inp (sub len pos.inp)])
%l +>(..ta (se-blit %clr ~))
%n (ta-aro %d)
%p (ta-aro %u)
%r ?~ ris
2016-07-04 09:27:08 +03:00
+>(ris `[pos.hit ~])
2015-09-02 01:20:17 +03:00
?: =(0 pos.u.ris)
ta-bel
(ta-ser ~)
%t =+ len=(lent buf.say.inp)
2015-09-02 01:20:17 +03:00
?: |(=(0 pos.inp) (lth len 2))
ta-bel
=+ sop=(sub pos.inp ?:(=(len pos.inp) 2 1))
(ta-hom (rep:edit [sop 2] (flop (swag [sop 2] buf.say.inp))))
%u ?: =(0 pos.inp)
2015-09-02 01:20:17 +03:00
ta-bel
(ta-kil %l [0 pos.inp])
%v ta-bel
%w ?: =(0 pos.inp)
2016-07-05 09:50:32 +03:00
ta-bel
=+ sop=(ta-pos %l %ace pos.inp)
(ta-kil %l [(sub pos.inp sop) sop])
%x +>(..ta se-anon)
%y ?: =(0 num.kil)
ta-bel
2016-09-08 07:08:34 +03:00
(ta-hom (cat:edit pos.inp ta-yan))
2015-05-17 04:05:56 +03:00
==
::
2015-09-02 01:20:17 +03:00
++ ta-del :: hear delete
2015-05-17 04:05:56 +03:00
^+ .
2015-09-02 01:20:17 +03:00
?: =((lent buf.say.inp) pos.inp)
ta-bel
2015-09-02 01:20:17 +03:00
(ta-hom %del pos.inp)
2015-05-17 04:05:56 +03:00
::
2015-09-02 01:20:17 +03:00
++ ta-erl :: hear local error
|= pos=@ud
2015-09-02 01:20:17 +03:00
ta-bel(pos.inp (min pos (lent buf.say.inp)))
2015-05-17 04:05:56 +03:00
::
2015-09-02 01:20:17 +03:00
++ ta-err :: hear remote error
|= pos=@ud
2015-09-02 01:20:17 +03:00
(ta-erl (~(transpose sole say.inp) pos))
2015-05-17 04:05:56 +03:00
::
2015-09-02 01:20:17 +03:00
++ ta-fec :: apply effect
|= fec=sole-effect
2015-05-17 04:05:56 +03:00
^+ +>
?- fec
[%bel *] ta-bel
[%blk *] +>
[%bye *] +>(..ta (se-klin gyl))
[%clr *] +>(..ta (se-blit fec))
[%det *] (ta-got +.fec)
[%err *] (ta-err p.fec)
[%klr *] +>(..ta (se-blit %klr (make:klr p.fec)))
[%mor *] |- ^+ +>.^$
?~ p.fec +>.^$
$(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))
[%txt *] +>(..ta (se-text p.fec))
[%url *] +>(..ta (se-blit fec))
2015-09-02 01:20:17 +03:00
==
2015-05-17 04:05:56 +03:00
::
2015-09-02 01:20:17 +03:00
++ ta-dog :: change cursor
|= ted=sole-edit
2015-09-02 01:20:17 +03:00
%_ +>
pos.inp
=+ len=(lent buf.say.inp)
%+ min len
|- ^- @ud
?- ted
[%del *] ?:((gth pos.inp p.ted) (dec pos.inp) pos.inp)
[%ins *] ?:((gte 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
2015-09-02 01:20:17 +03:00
==
==
2015-05-17 04:05:56 +03:00
::
++ ta-off :: reset buffer offset
|= ted=sole-edit
=? off (any:edit ted |=(a=sole-edit ?=(%set -.a))) 0
+>
::
2015-09-02 01:20:17 +03:00
++ ta-got :: apply change
|= cal=sole-change
=^ ted say.inp (~(receive sole say.inp) cal)
(ta-dog:(ta-off ted.cal) ted)
::
2015-09-02 01:20:17 +03:00
++ ta-hom :: local edit
|= ted=sole-edit
^+ +>
=. +> (ta-det:(ta-off ted) ted)
(ta-dog(say.inp (~(commit sole say.inp) ted)) ted)
2015-05-17 04:05:56 +03:00
::
++ ta-jump :: buffer pos
|= [dir=?(%l %r) til=?(%ace %edg %wrd) pos=@ud]
^- @ud
%- ?:(?=(%l dir) sub add)
[pos (ta-pos dir til pos)]
::
++ ta-kil :: kill selection
|= [dir=?(%l %r) sel=[@ @]]
^+ +>
=+ buf=(swag sel buf.say.inp)
%. (cut:edit sel)
%= ta-hom
kil
?. ?& ?=(^ old.kil)
?=(^ p.blt)
?| ?=([%ctl ?(%k %u %w)] u.p.blt)
?=([%met ?(%d %bac)] u.p.blt)
== ==
%= kil :: prepend
num +(num.kil)
pos +(num.kil)
old (scag max.kil `(list (list @c))`[buf old.kil])
==
%= kil :: cumulative yanks
pos num.kil
old :_ t.old.kil
?- dir
%l (welp buf i.old.kil)
%r (welp i.old.kil buf)
2016-08-28 07:31:35 +03:00
== ==
==
::
2015-09-02 01:20:17 +03:00
++ ta-met :: meta key
|= key=@ud
^+ +>
=. ris ~
?+ key ta-bel
%dot ?. &(?=(^ old.hit) ?=(^ i.old.hit)) :: last "arg" from hist
ta-bel
=+ old=`(list @c)`i.old.hit
=+ sop=(ta-jump(buf.say.inp old) %l %ace (lent old))
(ta-hom (cat:edit pos.inp (slag sop old)))
::
%bac ?: =(0 pos.inp) :: kill left-word
ta-bel
=+ sop=(ta-pos %l %edg pos.inp)
(ta-kil %l [(sub pos.inp sop) sop])
::
%b ?: =(0 pos.inp) :: jump left-word
ta-bel
+>(pos.inp (ta-jump %l %edg pos.inp))
2016-07-03 21:39:40 +03:00
::
%c ?: =(pos.inp (lent buf.say.inp)) :: capitalize
2016-07-03 21:39:40 +03:00
ta-bel
=+ sop=(ta-jump %r %wrd pos.inp)
%- ta-hom(pos.inp (ta-jump %r %edg sop))
%+ rep:edit [sop 1]
^- (list @c) ^- (list @) :: XX unicode
(cuss `tape``(list @)`(swag [sop 1] buf.say.inp))
2016-07-03 21:39:40 +03:00
::
%d ?: =(pos.inp (lent buf.say.inp)) :: kill right-word
ta-bel
(ta-kil %r [pos.inp (ta-pos %r %edg pos.inp)])
::
%f ?: =(pos.inp (lent buf.say.inp)) :: jump right-word
ta-bel
+>(pos.inp (ta-jump %r %edg pos.inp))
2016-07-03 21:39:40 +03:00
::
%r %- ta-hom(lay.hit (~(put by lay.hit) pos.hit ~))
2016-09-07 07:54:25 +03:00
:- %set :: revert hist edit
?: =(pos.hit num.hit) ~
(snag (sub num.hit +(pos.hit)) old.hit)
2016-07-05 07:48:56 +03:00
::
%t =+ a=(ta-jump %r %edg pos.inp) :: transpose words
=+ b=(ta-jump %l %edg a)
=+ c=(ta-jump %l %edg b)
2016-07-04 03:57:43 +03:00
?: =(b c)
ta-bel
=+ next=[b (sub a b)]
=+ prev=[c (ta-pos %r %edg c)]
%- ta-hom(pos.inp a)
2016-07-04 03:57:43 +03:00
:~ %mor
(rep:edit next (swag prev buf.say.inp))
(rep:edit prev (swag next buf.say.inp))
2016-07-04 03:57:43 +03:00
==
2016-07-03 21:39:40 +03:00
::
?(%u %l) :: upper/lower case
2016-07-03 21:39:40 +03:00
?: =(pos.inp (lent buf.say.inp))
ta-bel
=+ case=?:(?=(%u key) cuss cass)
=+ sop=(ta-jump %r %wrd pos.inp)
=+ sel=[sop (ta-pos %r %edg sop)]
%- ta-hom
%+ rep:edit sel
^- (list @c) ^- (list @) :: XX unicode
(case `tape``(list @)`(swag sel buf.say.inp))
::
%y ?. ?& ?=(^ old.kil) :: rotate & yank
?=(^ p.blt)
?| ?=([%ctl %y] u.p.blt)
?=([%met %y] u.p.blt)
== ==
ta-bel
2016-09-08 07:08:34 +03:00
=+ las=(lent ta-yan)
=. pos.kil ?:(=(1 pos.kil) num.kil (dec pos.kil))
(ta-hom (rep:edit [(sub pos.inp las) las] ta-yan))
2016-07-02 06:31:51 +03:00
==
2015-05-17 04:05:56 +03:00
::
2015-09-02 01:20:17 +03:00
++ ta-mov :: move in history
|= sop=@ud
2015-09-02 01:20:17 +03:00
^+ +>
?: =(sop pos.hit) +>
2016-09-07 04:00:51 +03:00
%- %= ta-hom
2015-09-02 01:20:17 +03:00
pos.hit sop
2016-09-07 04:00:51 +03:00
lay.hit (~(put by lay.hit) pos.hit buf.say.inp)
2015-09-02 01:20:17 +03:00
==
2016-09-07 04:00:51 +03:00
:- %set
%. (~(get by lay.hit) sop)
(bond |.((snag (sub num.hit +(sop)) old.hit)))
2015-09-02 01:20:17 +03:00
::
++ ta-nex :: advance history
^+ .
=. ris ~
=. lay.hit ~
2018-03-19 07:18:20 +03:00
?: ?| ?=(~ buf.say.inp)
&(?=(^ old.hit) =(buf.say.inp i.old.hit))
==
.(pos.hit num.hit)
2015-09-02 01:20:17 +03:00
%_ .
num.hit +(num.hit)
pos.hit +(num.hit)
old.hit [buf.say.inp old.hit]
==
2015-05-17 04:05:56 +03:00
::
++ ta-pos :: buffer pos offset
|= [dir=?(%l %r) til=?(%ace %edg %wrd) pos=@ud]
^- @ud
%- ?- til %ace ace:offset
%edg edg:offset
%wrd wrd:offset
==
?- dir %l (flop (scag pos buf.say.inp))
%r (slag pos buf.say.inp)
==
::
2015-09-02 01:20:17 +03:00
++ ta-pro :: set prompt
|= pom=sole-prompt
2016-11-14 05:51:21 +03:00
%_ +>
pom
%_ pom
cad
;: welp
?. ?=(%earl (clan:title p.gyl))
(cite:title p.gyl)
2016-11-14 05:51:21 +03:00
(scow %p p.gyl)
::
":"
(trip q.gyl)
2016-11-14 05:51:21 +03:00
cad.pom
==
==
==
2015-09-02 01:20:17 +03:00
::
++ ta-ret :: hear return
(ta-act ta-id %ret ~)
2015-05-17 04:05:56 +03:00
::
dojo: add tab completion This is initial support for type-aware tab completion. When you hit tab, it tries to complete the word you're in the middle of using a face or arm in the subject at that point in the code. It also shows all possible matches and their associated types. It's nearly instantaneous. Notes: - It advances to the longest common prefix, so if you hit tab on `ab` and the only possible results are `abcde` and `abcdz`, then it'll write `abcd` and print both out (with their types). - If there are fewer than ten matches, it prints the type along with the face. Printing types is too slow to use all the time, but with 10 it's essentially instantaneous. - The match closest in the subject to you (i.e. smallest axis number) is displayed lowest (closest to your focus). Examples below, where `<TAB>` represents me hitting tab while my cursor is at that position (the line with the `<TAB>` is not preserved in the actual output). ``` ~zod:dojo> eth<TAB> ----- ethereum #t/<11.qcl {<3.ltb 27.ipf 7.ecf 36.uek 92.bjk 247.ows 51.mvt 126.xjf 41.mac 1.ane $141> <21.yeb 27.ipf 7.ecf 36.uek 92.bjk 247.ows 51.mvt 126.xjf 41.mac 1.ane $141>}> ethereum-types #t/<3.ltb 27.ipf 7.ecf 36.uek 92.bjk 247.ows 51.mvt 126.xjf 41.mac 1.ane $141> ~zod:dojo> ethereum ~zod:dojo> |= zong=@ud z<TAB> ----- zing #t/<1.dqs {* <126.xjf 41.mac 1.ane $141>}> zap #t/<1.iot {tub/{p/{p/@ud q/@ud} q/""} <1.rff {daf/@t <247.ows 51.mvt 126.xjf 41.mac 1.ane $141>}>}> zuse #t/$309 zong #t/@ud ~zod:dojo> |= zong=@ud zo<TAB> ----- zong #t/@ud ~zod:dojo> |= zong=@ud zong ~zod:dojo> <TAB> hoon-version trel quip pole unit qual lone ... about 600 more lines ... unity html zuse eny now our ~zod:dojo> ``` Functionally, this is in a state where I'd be comfortable shipping it. It doesn't interfere with anything if you don't press tab, and it's perfectly OTA-able. I do think its output is a little verbose, but that can be tuned over time as people try it and determine what feels good in practice. Additional notes: - There are plenty of similar systems for other languages, but my most direct inspiration is Idris's editor tools. This is implemented for the dojo, but I actually want it in my editor, which is why the meat is all defind in a library. I've only tested on dojo one-liners, so I don't know the performance on large blocks of code. - The default type printer isn't great for this use case. In particular, - Cores should not print anything about their context - The `#t/` should go away - If it looks like a gate, we should print its return value - Maybe special handling for molds, but if the above is done, then for example `bone` is `* -> @ud`. - The worst part about our wing ordering is that it really screws up tab completion. You want to do `point.owner-address` instead of `owner-address.point` because that lets you type `point.ow<TAB>`. I weakly prefer reading it how we do it now, but it's really not great. You could do an (dojo-specific?) alternate syntax of `point;owner-address`; this is a simple transformation. - Regardless of the above, this should handle the case where we're in the middle of defining a wing; it doesn't right now. - When a variable is shadowed, we show both of them. We should probably show the shadowed one with a `^`. - We probably shouldn't print out hundreds of results. Maybe just the closest 50 with ellipses. - This gets you any face in your subject, regardless of whether its type is reasonable. We could limit that some by copying the `gol` logic in mint, so that if the pseudo-backward-inference engine happens to know what type it should be, you can filter the tab results according to if they nest in that type. This would be "strongly type-aware".
2019-10-31 06:39:02 +03:00
++ ta-tab :: hear tab
(ta-act ta-id %tab pos.inp)
dojo: add tab completion This is initial support for type-aware tab completion. When you hit tab, it tries to complete the word you're in the middle of using a face or arm in the subject at that point in the code. It also shows all possible matches and their associated types. It's nearly instantaneous. Notes: - It advances to the longest common prefix, so if you hit tab on `ab` and the only possible results are `abcde` and `abcdz`, then it'll write `abcd` and print both out (with their types). - If there are fewer than ten matches, it prints the type along with the face. Printing types is too slow to use all the time, but with 10 it's essentially instantaneous. - The match closest in the subject to you (i.e. smallest axis number) is displayed lowest (closest to your focus). Examples below, where `<TAB>` represents me hitting tab while my cursor is at that position (the line with the `<TAB>` is not preserved in the actual output). ``` ~zod:dojo> eth<TAB> ----- ethereum #t/<11.qcl {<3.ltb 27.ipf 7.ecf 36.uek 92.bjk 247.ows 51.mvt 126.xjf 41.mac 1.ane $141> <21.yeb 27.ipf 7.ecf 36.uek 92.bjk 247.ows 51.mvt 126.xjf 41.mac 1.ane $141>}> ethereum-types #t/<3.ltb 27.ipf 7.ecf 36.uek 92.bjk 247.ows 51.mvt 126.xjf 41.mac 1.ane $141> ~zod:dojo> ethereum ~zod:dojo> |= zong=@ud z<TAB> ----- zing #t/<1.dqs {* <126.xjf 41.mac 1.ane $141>}> zap #t/<1.iot {tub/{p/{p/@ud q/@ud} q/""} <1.rff {daf/@t <247.ows 51.mvt 126.xjf 41.mac 1.ane $141>}>}> zuse #t/$309 zong #t/@ud ~zod:dojo> |= zong=@ud zo<TAB> ----- zong #t/@ud ~zod:dojo> |= zong=@ud zong ~zod:dojo> <TAB> hoon-version trel quip pole unit qual lone ... about 600 more lines ... unity html zuse eny now our ~zod:dojo> ``` Functionally, this is in a state where I'd be comfortable shipping it. It doesn't interfere with anything if you don't press tab, and it's perfectly OTA-able. I do think its output is a little verbose, but that can be tuned over time as people try it and determine what feels good in practice. Additional notes: - There are plenty of similar systems for other languages, but my most direct inspiration is Idris's editor tools. This is implemented for the dojo, but I actually want it in my editor, which is why the meat is all defind in a library. I've only tested on dojo one-liners, so I don't know the performance on large blocks of code. - The default type printer isn't great for this use case. In particular, - Cores should not print anything about their context - The `#t/` should go away - If it looks like a gate, we should print its return value - Maybe special handling for molds, but if the above is done, then for example `bone` is `* -> @ud`. - The worst part about our wing ordering is that it really screws up tab completion. You want to do `point.owner-address` instead of `owner-address.point` because that lets you type `point.ow<TAB>`. I weakly prefer reading it how we do it now, but it's really not great. You could do an (dojo-specific?) alternate syntax of `point;owner-address`; this is a simple transformation. - Regardless of the above, this should handle the case where we're in the middle of defining a wing; it doesn't right now. - When a variable is shadowed, we show both of them. We should probably show the shadowed one with a `^`. - We probably shouldn't print out hundreds of results. Maybe just the closest 50 with ellipses. - This gets you any face in your subject, regardless of whether its type is reasonable. We could limit that some by copying the `gol` logic in mint, so that if the pseudo-backward-inference engine happens to know what type it should be, you can filter the tab results according to if they nest in that type. This would be "strongly type-aware".
2019-10-31 06:39:02 +03:00
::
2015-09-02 01:20:17 +03:00
++ ta-ser :: reverse search
|= ext=(list @c)
2015-05-17 04:05:56 +03:00
^+ +>
2018-03-19 07:18:20 +03:00
?: |(?=(~ ris) =(0 pos.u.ris))
2016-09-02 05:39:24 +03:00
ta-bel
=+ sop=?~(ext (dec pos.u.ris) pos.u.ris)
2015-09-02 01:20:17 +03:00
=+ tot=(weld str.u.ris ext)
=+ dol=(slag (sub num.hit sop) old.hit)
2016-09-02 05:39:24 +03:00
=/ sup
2015-12-09 04:54:26 +03:00
|- ^- (unit @ud)
2015-09-02 01:20:17 +03:00
?~ dol ~
2016-09-02 05:39:24 +03:00
?^ (find tot i.dol)
2015-09-02 01:20:17 +03:00
`sop
$(sop (dec sop), dol t.dol)
?~ sup ta-bel
(ta-mov(str.u.ris tot, pos.u.ris u.sup) (dec u.sup))
2015-09-02 01:20:17 +03:00
::
++ ta-txt :: hear text
|= txt=(list @c)
2015-09-02 01:20:17 +03:00
^+ +>
?^ ris
(ta-ser txt)
(ta-hom (cat:edit pos.inp txt))
2015-09-02 01:20:17 +03:00
::
++ ta-vew :: computed prompt
^- [pom=stub lin=(pair @ud (list @c))]
=; vew=(pair (list @c) styx)
[(make:klr q.vew) pos.inp p.vew]
2016-08-28 07:44:44 +03:00
?: vis.pom
:- buf.say.inp :: default prompt
?~ ris
cad.pom
:(welp "(reverse-i-search)'" (tufa str.u.ris) "': ")
:- (reap (lent buf.say.inp) `@c`'*') :: hidden input
%+ welp
cad.pom
?~ buf.say.inp ~
:(welp "<" (scow %p (end 4 (sham buf.say.inp))) "> ")
2016-09-08 07:08:34 +03:00
::
++ ta-yan :: yank
(snag (sub num.kil pos.kil) old.kil)
2015-05-17 04:05:56 +03:00
--
++ edit :: produce sole-edits
|%
++ cat :: mass insert
|= [pos=@ud txt=(list @c)]
^- sole-edit
:- %mor
|- ^- (list sole-edit)
?~ txt ~
[[%ins pos i.txt] $(pos +(pos), txt t.txt)]
::
++ cut :: mass delete
|= [pos=@ud num=@ud]
^- sole-edit
:- %mor
|- ^- (list sole-edit)
?: =(0 num) ~
[[%del pos] $(num (dec num))]
::
++ rep :: mass replace
|= [[pos=@ud num=@ud] txt=(list @c)]
^- sole-edit
:~ %mor
(cut pos num)
(cat pos txt)
==
2017-03-03 23:27:32 +03:00
++ any :: matches?
|= [a=sole-edit b=$-(sole-edit ?)]
2017-03-03 23:27:32 +03:00
^- ?
?. ?=(%mor -.a) (b a)
(lien p.a |=(c=sole-edit ^$(a c)))
--
++ offset :: calculate offsets
|%
++ alnm :: alpha-numeric
|= a=@ ^- ?
?| &((gte a '0') (lte a '9'))
&((gte a 'A') (lte a 'Z'))
&((gte a 'a') (lte a 'z'))
==
::
++ ace :: next whitespace
|= a=(list @)
=| [b=_| i=@ud]
|- ^- @ud
?~ a i
=/ c !=(32 i.a)
=. b |(b c)
?: &(b !|(=(0 i) c)) i
$(i +(i), a t.a)
::
++ edg :: next word boundary
|= a=(list @)
=| [b=_| i=@ud]
|- ^- @ud
?~ a i
=/ c (alnm i.a)
=. b |(b c)
?: &(b !|(=(0 i) c)) i
$(i +(i), a t.a)
::
++ wrd :: next or current word
|= a=(list @)
=| i=@ud
|- ^- @ud
2018-03-19 07:18:20 +03:00
?: |(?=(~ a) (alnm i.a)) i
$(i +(i), a t.a)
--
::
++ klr :: styx/stub engine
=, dill
|%
++ make :: stub from styx
|= a=styx ^- stub
=| b=stye
%+ reel
|- ^- stub
2016-10-17 23:45:05 +03:00
%- zing %+ turn a
|= a=$@(@t (pair styl styx))
2016-10-17 23:45:05 +03:00
?@ a [b (tuba (trip a))]~
^$(a q.a, b (styd p.a b))
::
|= [a=(pair stye (list @c)) b=stub]
2016-10-17 23:45:05 +03:00
?~ b [a ~]
?. =(p.a p.i.b) [a b]
[[p.a (weld q.a q.i.b)] t.b]
::
2016-10-17 23:45:05 +03:00
++ styd :: stye from styl
|= [a=styl b=stye] ^+ b :: with inheritance
2016-10-17 23:45:05 +03:00
:+ ?~ p.a p.b
?~ u.p.a ~
(~(put in p.b) u.p.a)
(fall p.q.a p.q.b)
(fall q.q.a q.q.b)
::
++ lent-char
|= a=stub ^- @
(roll (lnts-char a) add)
::
++ lnts-char :: stub pair tail lengths
|= a=stub ^- (list @)
%+ turn a
|= a=(pair stye (list @c))
(lent q.a)
::
++ brek :: index + incl-len of
|= [a=@ b=(list @)] :: stub pair w= idx a
=| [c=@ i=@]
|- ^- (unit (pair @ @))
?~ b ~
=. c (add c i.b)
?: (gte c a)
`[i c]
$(i +(i), b t.b)
::
2016-10-16 06:03:05 +03:00
++ slag :: slag stub, keep stye
|= [a=@ b=stub]
^- stub
=+ c=(lnts-char b)
=+ i=(brek a c)
?~ i b
=+ r=(^slag +(p.u.i) b)
?: =(a q.u.i)
r
=+ n=(snag p.u.i b)
:_ r :- p.n
(^slag (sub (snag p.u.i c) (sub q.u.i a)) q.n)
::
2016-10-16 06:03:05 +03:00
++ scag :: scag stub, keep stye
|= [a=@ b=stub]
^- stub
=+ c=(lnts-char b)
=+ i=(brek a c)
?~ i b
?: =(a q.u.i)
(^scag +(p.u.i) b)
%+ welp
(^scag p.u.i b)
=+ n=(snag p.u.i b)
:_ ~ :- p.n
(^scag (sub (snag p.u.i c) (sub q.u.i a)) q.n)
::
++ swag :: swag stub, keep stye
|= [[a=@ b=@] c=stub]
(scag b (slag a c))
--
2015-05-17 04:05:56 +03:00
--