mirror of
https://github.com/urbit/shrub.git
synced 2024-12-11 11:02:25 +03:00
671 lines
14 KiB
Plaintext
671 lines
14 KiB
Plaintext
!.
|
|
=> %a50
|
|
~% %a.50 ~ ~
|
|
|%
|
|
:: Types
|
|
::
|
|
+$ ship @p
|
|
+$ life @ud
|
|
+$ rift @ud
|
|
+$ pass @
|
|
+$ bloq @
|
|
+$ step _`@u`1
|
|
+$ bite $@(bloq [=bloq =step])
|
|
+$ octs [p=@ud q=@]
|
|
+$ mold $~(* $-(* *))
|
|
++ unit |$ [item] $@(~ [~ u=item])
|
|
++ list |$ [item] $@(~ [i=item t=(list item)])
|
|
++ lest |$ [item] [i=item t=(list item)]
|
|
++ tree |$ [node] $@(~ [n=node l=(tree node) r=(tree node)])
|
|
++ pair |$ [head tail] [p=head q=tail]
|
|
++ map
|
|
|$ [key value]
|
|
$| (tree (pair key value))
|
|
|=(a=(tree (pair)) ?:(=(~ a) & ~(apt by a)))
|
|
::
|
|
++ set
|
|
|$ [item]
|
|
$| (tree item)
|
|
|=(a=(tree) ?:(=(~ a) & ~(apt in a)))
|
|
::
|
|
++ jug |$ [key value] (map key (set value))
|
|
::
|
|
:: Bits
|
|
::
|
|
++ dec :: decrement
|
|
~/ %dec
|
|
|= a=@
|
|
~_ leaf+"decrement-underflow"
|
|
?< =(0 a)
|
|
=+ b=0
|
|
|- ^- @
|
|
?: =(a +(b)) b
|
|
$(b +(b))
|
|
::
|
|
++ add :: plus
|
|
~/ %add
|
|
|= [a=@ b=@]
|
|
^- @
|
|
?: =(0 a) b
|
|
$(a (dec a), b +(b))
|
|
::
|
|
++ sub :: subtract
|
|
~/ %sub
|
|
|= [a=@ b=@]
|
|
~_ leaf+"subtract-underflow"
|
|
:: difference
|
|
^- @
|
|
?: =(0 b) a
|
|
$(a (dec a), b (dec b))
|
|
::
|
|
++ mul :: multiply
|
|
~/ %mul
|
|
|: [a=`@`1 b=`@`1]
|
|
^- @
|
|
=+ c=0
|
|
|-
|
|
?: =(0 a) c
|
|
$(a (dec a), c (add b c))
|
|
::
|
|
++ div :: divide
|
|
~/ %div
|
|
|: [a=`@`1 b=`@`1]
|
|
^- @
|
|
~_ leaf+"divide-by-zero"
|
|
?< =(0 b)
|
|
=+ c=0
|
|
|-
|
|
?: (lth a b) c
|
|
$(a (sub a b), c +(c))
|
|
::
|
|
++ dvr :: divide w/remainder
|
|
~/ %dvr
|
|
|: [a=`@`1 b=`@`1]
|
|
^- [p=@ q=@]
|
|
[(div a b) (mod a b)]
|
|
::
|
|
++ mod :: modulus
|
|
~/ %mod
|
|
|: [a=`@`1 b=`@`1]
|
|
^- @
|
|
?< =(0 b)
|
|
(sub a (mul b (div a b)))
|
|
::
|
|
++ bex :: binary exponent
|
|
~/ %bex
|
|
|= a=bloq
|
|
^- @
|
|
?: =(0 a) 1
|
|
(mul 2 $(a (dec a)))
|
|
::
|
|
++ lsh :: left-shift
|
|
~/ %lsh
|
|
|= [a=bite b=@]
|
|
=/ [=bloq =step] ?^(a a [a *step])
|
|
(mul b (bex (mul (bex bloq) step)))
|
|
::
|
|
++ rsh :: right-shift
|
|
~/ %rsh
|
|
|= [a=bite b=@]
|
|
=/ [=bloq =step] ?^(a a [a *step])
|
|
(div b (bex (mul (bex bloq) step)))
|
|
::
|
|
++ con :: binary or
|
|
~/ %con
|
|
|= [a=@ b=@]
|
|
=+ [c=0 d=0]
|
|
|- ^- @
|
|
?: ?&(=(0 a) =(0 b)) d
|
|
%= $
|
|
a (rsh 0 a)
|
|
b (rsh 0 b)
|
|
c +(c)
|
|
d %+ add d
|
|
%+ lsh [0 c]
|
|
?& =(0 (end 0 a))
|
|
=(0 (end 0 b))
|
|
==
|
|
==
|
|
::
|
|
++ dis :: binary and
|
|
~/ %dis
|
|
|= [a=@ b=@]
|
|
=| [c=@ d=@]
|
|
|- ^- @
|
|
?: ?|(=(0 a) =(0 b)) d
|
|
%= $
|
|
a (rsh 0 a)
|
|
b (rsh 0 b)
|
|
c +(c)
|
|
d %+ add d
|
|
%+ lsh [0 c]
|
|
?| =(0 (end 0 a))
|
|
=(0 (end 0 b))
|
|
==
|
|
==
|
|
::
|
|
++ mix :: binary xor
|
|
~/ %mix
|
|
|= [a=@ b=@]
|
|
^- @
|
|
=+ [c=0 d=0]
|
|
|-
|
|
?: ?&(=(0 a) =(0 b)) d
|
|
%= $
|
|
a (rsh 0 a)
|
|
b (rsh 0 b)
|
|
c +(c)
|
|
d (add d (lsh [0 c] =((end 0 a) (end 0 b))))
|
|
==
|
|
::
|
|
++ lth :: less
|
|
~/ %lth
|
|
|= [a=@ b=@]
|
|
^- ?
|
|
?& !=(a b)
|
|
|-
|
|
?| =(0 a)
|
|
?& !=(0 b)
|
|
$(a (dec a), b (dec b))
|
|
== == ==
|
|
::
|
|
++ lte :: less or equal
|
|
~/ %lte
|
|
|= [a=@ b=@]
|
|
|(=(a b) (lth a b))
|
|
::
|
|
++ gte :: greater or equal
|
|
~/ %gte
|
|
|= [a=@ b=@]
|
|
^- ?
|
|
!(lth a b)
|
|
::
|
|
++ gth :: greater
|
|
~/ %gth
|
|
|= [a=@ b=@]
|
|
^- ?
|
|
!(lte a b)
|
|
::
|
|
++ swp :: naive rev bloq order
|
|
~/ %swp
|
|
|= [a=bloq b=@]
|
|
(rep a (flop (rip a b)))
|
|
::
|
|
++ met :: measure
|
|
~/ %met
|
|
|= [a=bloq b=@]
|
|
^- @
|
|
=+ c=0
|
|
|-
|
|
?: =(0 b) c
|
|
$(b (rsh a b), c +(c))
|
|
::
|
|
++ end :: tail
|
|
~/ %end
|
|
|= [a=bite b=@]
|
|
=/ [=bloq =step] ?^(a a [a *step])
|
|
(mod b (bex (mul (bex bloq) step)))
|
|
::
|
|
++ cat :: concatenate
|
|
~/ %cat
|
|
|= [a=bloq b=@ c=@]
|
|
(add (lsh [a (met a b)] c) b)
|
|
::
|
|
++ cut :: slice
|
|
~/ %cut
|
|
|= [a=bloq [b=step c=step] d=@]
|
|
(end [a c] (rsh [a b] d))
|
|
::
|
|
++ can :: assemble
|
|
~/ %can
|
|
|= [a=bloq b=(list [p=step q=@])]
|
|
^- @
|
|
?~ b 0
|
|
(add (end [a p.i.b] q.i.b) (lsh [a p.i.b] $(b t.b)))
|
|
::
|
|
++ cad :: assemble specific
|
|
~/ %cad
|
|
|= [a=bloq b=(list [p=step q=@])]
|
|
^- [=step @]
|
|
:_ (can a b)
|
|
|-
|
|
?~ b
|
|
0
|
|
(add p.i.b $(b t.b))
|
|
::
|
|
++ rep :: assemble fixed
|
|
~/ %rep
|
|
|= [a=bite b=(list @)]
|
|
=/ [=bloq =step] ?^(a a [a *step])
|
|
=| i=@ud
|
|
|- ^- @
|
|
?~ b 0
|
|
%+ add $(i +(i), b t.b)
|
|
(lsh [bloq (mul step i)] (end [bloq step] i.b))
|
|
::
|
|
++ rip :: disassemble
|
|
~/ %rip
|
|
|= [a=bite b=@]
|
|
^- (list @)
|
|
?: =(0 b) ~
|
|
[(end a b) $(b (rsh a b))]
|
|
::
|
|
::
|
|
:: Lists
|
|
::
|
|
++ lent :: length
|
|
~/ %lent
|
|
|= a=(list)
|
|
^- @
|
|
=+ b=0
|
|
|-
|
|
?~ a b
|
|
$(a t.a, b +(b))
|
|
::
|
|
++ slag :: suffix
|
|
~/ %slag
|
|
|* [a=@ b=(list)]
|
|
|- ^+ b
|
|
?: =(0 a) b
|
|
?~ b ~
|
|
$(b t.b, a (dec a))
|
|
::
|
|
++ snag :: index
|
|
~/ %snag
|
|
|* [a=@ b=(list)]
|
|
|- ^+ ?>(?=(^ b) i.b)
|
|
?~ b
|
|
~_ leaf+"snag-fail"
|
|
!!
|
|
?: =(0 a) i.b
|
|
$(b t.b, a (dec a))
|
|
::
|
|
++ homo :: homogenize
|
|
|* a=(list)
|
|
^+ =< $
|
|
|@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$])
|
|
--
|
|
a
|
|
::
|
|
++ flop :: reverse
|
|
~/ %flop
|
|
|* a=(list)
|
|
=> .(a (homo a))
|
|
^+ a
|
|
=+ b=`_a`~
|
|
|-
|
|
?~ a b
|
|
$(a t.a, b [i.a b])
|
|
::
|
|
++ welp :: concatenate
|
|
~/ %welp
|
|
=| [* *]
|
|
|@
|
|
++ $
|
|
?~ +<-
|
|
+<-(. +<+)
|
|
+<-(+ $(+<- +<->))
|
|
--
|
|
::
|
|
++ reap :: replicate
|
|
~/ %reap
|
|
|* [a=@ b=*]
|
|
|- ^- (list _b)
|
|
?~ a ~
|
|
[b $(a (dec a))]
|
|
::
|
|
:: Modular arithmetic
|
|
::
|
|
++ fe :: modulo bloq
|
|
|_ a=bloq
|
|
++ rol |= [b=bloq c=@ d=@] ^- @ :: roll left
|
|
=+ e=(sit d)
|
|
=+ f=(bex (sub a b))
|
|
=+ g=(mod c f)
|
|
(sit (con (lsh [b g] e) (rsh [b (sub f g)] e)))
|
|
++ sum |=([b=@ c=@] (sit (add b c))) :: wrapping add
|
|
++ sit |=(b=@ (end a b)) :: enforce modulo
|
|
--
|
|
::
|
|
:: Hashes
|
|
::
|
|
++ muk :: standard murmur3
|
|
~% %muk ..muk ~
|
|
=+ ~(. fe 5)
|
|
|= [syd=@ len=@ key=@]
|
|
=. syd (end 5 syd)
|
|
=/ pad (sub len (met 3 key))
|
|
=/ data (welp (rip 3 key) (reap pad 0))
|
|
=/ nblocks (div len 4) :: intentionally off-by-one
|
|
=/ h1 syd
|
|
=+ [c1=0xcc9e.2d51 c2=0x1b87.3593]
|
|
=/ blocks (rip 5 key)
|
|
=/ i nblocks
|
|
=. h1 =/ hi h1 |-
|
|
?: =(0 i) hi
|
|
=/ k1 (snag (sub nblocks i) blocks) :: negative array index
|
|
=. k1 (sit (mul k1 c1))
|
|
=. k1 (rol 0 15 k1)
|
|
=. k1 (sit (mul k1 c2))
|
|
=. hi (mix hi k1)
|
|
=. hi (rol 0 13 hi)
|
|
=. hi (sum (sit (mul hi 5)) 0xe654.6b64)
|
|
$(i (dec i))
|
|
=/ tail (slag (mul 4 nblocks) data)
|
|
=/ k1 0
|
|
=/ tlen (dis len 3)
|
|
=. h1
|
|
?+ tlen h1 :: fallthrough switch
|
|
%3 =. k1 (mix k1 (lsh [0 16] (snag 2 tail)))
|
|
=. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
|
|
=. k1 (mix k1 (snag 0 tail))
|
|
=. k1 (sit (mul k1 c1))
|
|
=. k1 (rol 0 15 k1)
|
|
=. k1 (sit (mul k1 c2))
|
|
(mix h1 k1)
|
|
%2 =. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
|
|
=. k1 (mix k1 (snag 0 tail))
|
|
=. k1 (sit (mul k1 c1))
|
|
=. k1 (rol 0 15 k1)
|
|
=. k1 (sit (mul k1 c2))
|
|
(mix h1 k1)
|
|
%1 =. k1 (mix k1 (snag 0 tail))
|
|
=. k1 (sit (mul k1 c1))
|
|
=. k1 (rol 0 15 k1)
|
|
=. k1 (sit (mul k1 c2))
|
|
(mix h1 k1)
|
|
==
|
|
=. h1 (mix h1 len)
|
|
|^ (fmix32 h1)
|
|
++ fmix32
|
|
|= h=@
|
|
=. h (mix h (rsh [0 16] h))
|
|
=. h (sit (mul h 0x85eb.ca6b))
|
|
=. h (mix h (rsh [0 13] h))
|
|
=. h (sit (mul h 0xc2b2.ae35))
|
|
=. h (mix h (rsh [0 16] h))
|
|
h
|
|
--
|
|
::
|
|
++ mug :: mug with murmur3
|
|
~/ %mug
|
|
|= a=*
|
|
|^ ?@ a (mum 0xcafe.babe 0x7fff a)
|
|
=/ b (cat 5 $(a -.a) $(a +.a))
|
|
(mum 0xdead.beef 0xfffe b)
|
|
::
|
|
++ mum
|
|
|= [syd=@uxF fal=@F key=@]
|
|
=/ wyd (met 3 key)
|
|
=| i=@ud
|
|
|- ^- @F
|
|
?: =(8 i) fal
|
|
=/ haz=@F (muk syd wyd key)
|
|
=/ ham=@F (mix (rsh [0 31] haz) (end [0 31] haz))
|
|
?.(=(0 ham) ham $(i +(i), syd +(syd)))
|
|
--
|
|
::
|
|
++ gor :: mug order
|
|
~/ %gor
|
|
|= [a=* b=*]
|
|
^- ?
|
|
=+ [c=(mug a) d=(mug b)]
|
|
?: =(c d)
|
|
(dor a b)
|
|
(lth c d)
|
|
::
|
|
++ mor :: more mug order
|
|
~/ %mor
|
|
|= [a=* b=*]
|
|
^- ?
|
|
=+ [c=(mug (mug a)) d=(mug (mug b))]
|
|
?: =(c d)
|
|
(dor a b)
|
|
(lth c d)
|
|
::
|
|
++ dor :: tree order
|
|
~/ %dor
|
|
|= [a=* b=*]
|
|
^- ?
|
|
?: =(a b) &
|
|
?. ?=(@ a)
|
|
?: ?=(@ b) |
|
|
?: =(-.a -.b)
|
|
$(a +.a, b +.b)
|
|
$(a -.a, b -.b)
|
|
?. ?=(@ b) &
|
|
(lth a b)
|
|
::
|
|
++ por :: parent order
|
|
~/ %por
|
|
|= [a=@p b=@p]
|
|
^- ?
|
|
?: =(a b) &
|
|
=| i=@
|
|
|-
|
|
?: =(i 2)
|
|
:: second two bytes
|
|
(lte a b)
|
|
:: first two bytes
|
|
=+ [c=(end 3 a) d=(end 3 b)]
|
|
?: =(c d)
|
|
$(a (rsh 3 a), b (rsh 3 b), i +(i))
|
|
(lth c d)
|
|
::
|
|
:: Maps
|
|
::
|
|
++ by
|
|
~/ %by
|
|
=| a=(tree (pair)) :: (map)
|
|
=* node ?>(?=(^ a) n.a)
|
|
|@
|
|
++ get
|
|
~/ %get
|
|
|* b=*
|
|
=> .(b `_?>(?=(^ a) p.n.a)`b)
|
|
|- ^- (unit _?>(?=(^ a) q.n.a))
|
|
?~ a
|
|
~
|
|
?: =(b p.n.a)
|
|
`q.n.a
|
|
?: (gor b p.n.a)
|
|
$(a l.a)
|
|
$(a r.a)
|
|
::
|
|
++ put
|
|
~/ %put
|
|
|* [b=* c=*]
|
|
|- ^+ a
|
|
?~ a
|
|
[[b c] ~ ~]
|
|
?: =(b p.n.a)
|
|
?: =(c q.n.a)
|
|
a
|
|
a(n [b c])
|
|
?: (gor b p.n.a)
|
|
=+ d=$(a l.a)
|
|
?> ?=(^ d)
|
|
?: (mor p.n.a p.n.d)
|
|
a(l d)
|
|
d(r a(l r.d))
|
|
=+ d=$(a r.a)
|
|
?> ?=(^ d)
|
|
?: (mor p.n.a p.n.d)
|
|
a(r d)
|
|
d(l a(r l.d))
|
|
::
|
|
++ del
|
|
~/ %del
|
|
|* b=*
|
|
|- ^+ a
|
|
?~ a
|
|
~
|
|
?. =(b p.n.a)
|
|
?: (gor b p.n.a)
|
|
a(l $(a l.a))
|
|
a(r $(a r.a))
|
|
|- ^- [$?(~ _a)]
|
|
?~ l.a r.a
|
|
?~ r.a l.a
|
|
?: (mor p.n.l.a p.n.r.a)
|
|
l.a(r $(l.a r.l.a))
|
|
r.a(l $(r.a l.r.a))
|
|
::
|
|
++ apt
|
|
=< $
|
|
~/ %apt
|
|
=| [l=(unit) r=(unit)]
|
|
|. ^- ?
|
|
?~ a &
|
|
?& ?~(l & &((gor p.n.a u.l) !=(p.n.a u.l)))
|
|
?~(r & &((gor u.r p.n.a) !=(u.r p.n.a)))
|
|
?~ l.a &
|
|
&((mor p.n.a p.n.l.a) !=(p.n.a p.n.l.a) $(a l.a, l `p.n.a))
|
|
?~ r.a &
|
|
&((mor p.n.a p.n.r.a) !=(p.n.a p.n.r.a) $(a r.a, r `p.n.a))
|
|
==
|
|
--
|
|
::
|
|
++ on :: ordered map
|
|
~/ %on
|
|
|* [key=mold val=mold]
|
|
=> |%
|
|
+$ item [key=key val=val]
|
|
--
|
|
::
|
|
~% %comp +>+ ~
|
|
|= compare=$-([key key] ?)
|
|
~% %core + ~
|
|
|%
|
|
::
|
|
++ apt
|
|
~/ %apt
|
|
|= a=(tree item)
|
|
=| [l=(unit key) r=(unit key)]
|
|
|- ^- ?
|
|
?~ a %.y
|
|
?& ?~(l %.y (compare key.n.a u.l))
|
|
?~(r %.y (compare u.r key.n.a))
|
|
?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a)))
|
|
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
|
|
==
|
|
::
|
|
++ get
|
|
~/ %get
|
|
|= [a=(tree item) b=key]
|
|
^- (unit val)
|
|
?~ a ~
|
|
?: =(b key.n.a)
|
|
`val.n.a
|
|
?: (compare b key.n.a)
|
|
$(a l.a)
|
|
$(a r.a)
|
|
::
|
|
++ has
|
|
~/ %has
|
|
|= [a=(tree item) b=key]
|
|
^- ?
|
|
!=(~ (get a b))
|
|
::
|
|
++ put
|
|
~/ %put
|
|
|= [a=(tree item) =key =val]
|
|
^- (tree item)
|
|
?~ a [n=[key val] l=~ r=~]
|
|
?: =(key.n.a key) a(val.n val)
|
|
?: (compare key key.n.a)
|
|
=/ l $(a l.a)
|
|
?> ?=(^ l)
|
|
?: (mor key.n.a key.n.l)
|
|
a(l l)
|
|
l(r a(l r.l))
|
|
=/ r $(a r.a)
|
|
?> ?=(^ r)
|
|
?: (mor key.n.a key.n.r)
|
|
a(r r)
|
|
r(l a(r l.r))
|
|
--
|
|
::
|
|
:: Sets
|
|
::
|
|
++ in
|
|
~/ %in
|
|
=| a=(tree) :: (set)
|
|
|@
|
|
++ put
|
|
~/ %put
|
|
|* b=*
|
|
|- ^+ a
|
|
?~ a
|
|
[b ~ ~]
|
|
?: =(b n.a)
|
|
a
|
|
?: (gor b n.a)
|
|
=+ c=$(a l.a)
|
|
?> ?=(^ c)
|
|
?: (mor n.a n.c)
|
|
a(l c)
|
|
c(r a(l r.c))
|
|
=+ c=$(a r.a)
|
|
?> ?=(^ c)
|
|
?: (mor n.a n.c)
|
|
a(r c)
|
|
c(l a(r l.c))
|
|
::
|
|
++ del
|
|
~/ %del
|
|
|* b=*
|
|
|- ^+ a
|
|
?~ a
|
|
~
|
|
?. =(b n.a)
|
|
?: (gor b n.a)
|
|
a(l $(a l.a))
|
|
a(r $(a r.a))
|
|
|- ^- [$?(~ _a)]
|
|
?~ l.a r.a
|
|
?~ r.a l.a
|
|
?: (mor n.l.a n.r.a)
|
|
l.a(r $(l.a r.l.a))
|
|
r.a(l $(r.a l.r.a))
|
|
::
|
|
++ apt
|
|
=< $
|
|
~/ %apt
|
|
=| [l=(unit) r=(unit)]
|
|
|. ^- ?
|
|
?~ a &
|
|
?& ?~(l & (gor n.a u.l))
|
|
?~(r & (gor u.r n.a))
|
|
?~(l.a & ?&((mor n.a n.l.a) $(a l.a, l `n.a)))
|
|
?~(r.a & ?&((mor n.a n.r.a) $(a r.a, r `n.a)))
|
|
==
|
|
--
|
|
::
|
|
:: Jugs
|
|
::
|
|
++ ju
|
|
=| a=(tree (pair * (tree))) :: (jug)
|
|
|@
|
|
++ get
|
|
|* b=*
|
|
=+ c=(~(get by a) b)
|
|
?~(c ~ u.c)
|
|
::
|
|
++ del
|
|
|* [b=* c=*]
|
|
^+ a
|
|
=+ d=(get b)
|
|
=+ e=(~(del in d) c)
|
|
?~ e
|
|
(~(del by a) b)
|
|
(~(put by a) b e)
|
|
::
|
|
++ put
|
|
|* [b=* c=*]
|
|
^+ a
|
|
=+ d=(get b)
|
|
(~(put by a) b (~(put in d) c))
|
|
--
|
|
--
|