ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-17 11:51:32 +03:00
Code Issues Packages Projects Releases Wiki Activity

Various fixes and improvemnts

Browse Source
This commit is contained in:
C. Guy Yarvin 2016-10-05 17:37:51 -07:00
parent d52637f09e
commit 602843c9ac
1 changed files with 122 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
arvo/jael.hoon
View File

@ -551,23 +551,134 @@
:: ::::
=> |%
:: :: ++py
:::: ## 3.a :: sparse ship set
:::: ## 3.a :: sparse range
:: ::::
++ py
:: because when you're a star with 2^16 unissued
:: planets, a (set) is kind of lame...
::::
|_ pyl/pile
:: :: ++dif:py
++ dif :: pyl->lyp, add rem
|= lyp/pile
^- (pair pile pile)
!!
|_ a/pile
:: :: ++uni:py
++ uni :: unify ship sets
|= lyp/pile
++ uni :: merge two piles
|= b/pile
^- pile
!!
?~ b a
?~ a b
?. (vor p.n.a p.n.b) $(a b, b a)
?: (lth +(q.n.b) p.n.a)
$(b r.b, l.a $(a l.a, r.b ~))
?: (lth +(q.n.a) p.n.b)
$(b l.b, r.a $(a r.a, l.b ~))
?: =(n.a n.b) [n.a $(a l.a, b l.b) $(a r.a, b r.b)]
?: (lth p.n.a p.n.b)
?: (gth q.n.a q.n.b)
$(b l.b, a $(b r.b))
$(b l.b, a $(b r.b, a $(b r.a, r.a ~, q.n.a q.n.b)))
?: (gth q.n.a q.n.b)
$(a l.a, b $(a r.a, b $(a r.b, r.b ~, q.n.b q.n.a)))
$(a l.a, b $(a r.a))
:: :: ++div:py
++ div :: allocate
|= b/@ud
^- (unit (pair pile pile))
=< ?-(- $& [~ p], $| ~)
|- ^- (each (pair pile pile) @u)
?: =(0 b)
[%& ~ a]
?~ a [%| 0]
=/ al $(a l.a)
?- -.al
$& [%& p.p.al a(l q.p.al)]
$|
=. b (^sub b p.al)
=/ top +((^sub q.n.a p.n.a))
?: =(b top)
[%& a(r ~) r.a]
?: (lth b top)
:+ %& a(r ~, q.n (add p.n.a (dec b)))
=. p.n.a (add p.n.a b)
(uni(a r.a) [n.a ~ ~])
=/ ar $(a r.a, b (^sub b top))
?- -.ar
$& [%& a(r p.p.ar) q.p.ar]
$| [%| :(add top p.al p.ar)]
==
==
:: :: ++dif:py
++ dif :: add/remove a->b
|= b/pile
^- (pair pile pile)
[(sub(a b) a) (sub b)]
::
++ sub
|= b/pile ^- pile
?~ b a
?~ a a
?: (gth p.n.a q.n.b)
$(b r.b, l.a $(a l.a, r.b ~))
?: (lth q.n.a p.n.b)
$(b l.b, r.a $(a r.a, l.b ~))
%- uni(a $(a l.a, r.b ~))
%- uni(a $(a r.a, l.b ~))
?: (gte p.n.a p.n.b)
?: (lte q.n.a q.n.b)
~
$(b r.b, a [[+(q.n.b) q.n.a] ~ ~])
?: (lte q.n.a q.n.b)
$(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~])
%- uni(a $(b r.b, a [[+(q.n.b) q.n.a] ~ ~]))
$(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~])
:: :: ++int:py
++ int :: intersection
|= b/pile ^- pile
?~ a ~
?~ b ~
?. (vor p.n.a p.n.b) $(a b, b a)
?: (gth p.n.a q.n.b)
(uni(a $(b r.b)) $(a l.a, r.b ~))
?: (lth q.n.a p.n.b)
(uni(a $(b l.b)) $(a r.a, l.b ~))
?: (gte p.n.a p.n.b)
?: (lte q.n.a q.n.b)
[n.a $(a l.a, r.b ~) $(a r.a, l.b ~)]
[n.a(q q.n.b) $(a l.a, r.b ~) $(l.a ~, b r.b)]
%- uni(a $(r.a ~, b l.b))
?: (lte q.n.a q.n.b)
%- uni(a $(l.b ~, a r.a))
[n.b(q q.n.a) ~ ~]
%- uni(a $(l.a ~, b r.b))
[n.b ~ ~]
::
::
++ put
|= b/ship ^- pile
(uni [b b] ~ ~)
::
++ gas
|= b/(list ship) ^- pile
?~ b a
$(b t.b, a (put i.b))
::
++ tap
=| out/(list (pair ship ship))
|- ^+ out
?~ a out
$(a l.a, out [n.a $(a r.a)])
:: :: ++gud:py
++ gud :: validate
=| {bot/(unit ship) top/(unit ship)}
|- ^- ?
?~ a &
?& (lte p.n.a q.n.a)
?~(top & (lth +(q.n.a) u.top))
?~(bot & (gth p.n.a +(u.bot)))
::
?~(l.a & (vor p.n.a p.n.l.a))
$(a l.a, top `p.n.a)
::
?~(l.a & (vor p.n.a p.n.l.a))
$(a r.a, bot `q.n.a)
==
--
:: :: ++ry
:::: ## 3.b :: rights algebra
@ -609,7 +720,7 @@
:: :: ++bible:dif:ry
++ bible :: diff pile
|* {nut/@tas new/pile old/pile}
=/ hep (~(dep by old) new)
=/ hep (~(dif py old) new)
:- ?~(p.hep ~ `[nut p.hep])
?~(q.hep ~ `[nut q.hep])
:: :: ++noble:dif:ry