- '''
- Given a dict and a iterable of (name, [alias, ...]) pairs, create
- additional entries in the dict mapping each alias to the named function
- if it's in the dict. Aliases for functions not in the dict are ignored.
- '''
- for name, aliases in A:
- try:
- F = D[name]
- except KeyError:
- continue
- for alias in aliases:
- D[alias] = F
-
-
-def yin_functions():
- '''
- Return a dict of named stack effects.
-
- "Yin" functions are those that only rearrange items in stacks and
- can be defined completely by their stack effects. This means they
- can be auto-compiled.
- '''
- # pylint: disable=unused-variable
- cons = ef(a1, s0)((a1, s0))
- ccons = compose(cons, cons)
- dup = ef(a1)(a1, a1)
- dupd = ef(a2, a1)(a2, a2, a1)
- dupdd = ef(a3, a2, a1)(a3, a3, a2, a1)
- first = ef((a1, s1),)(a1,)
- over = ef(a2, a1)(a2, a1, a2)
- pop = ef(a1)()
- popd = ef(a2, a1,)(a1)
- popdd = ef(a3, a2, a1,)(a2, a1,)
- popop = ef(a2, a1,)()
- popopd = ef(a3, a2, a1,)(a1)
- popopdd = ef(a4, a3, a2, a1,)(a2, a1)
- rest = ef((a1, s0),)(s0,)
- rolldown = ef(a1, a2, a3)(a2, a3, a1)
- rollup = ef(a1, a2, a3)(a3, a1, a2)
- rrest = compose(rest, rest)
- second = compose(rest, first)
- stack = s0, (s0, s0)
- swaack = (s1, s0), (s0, s1)
- swap = ef(a1, a2)(a2, a1)
- swons = compose(swap, cons)
- third = compose(rest, second)
- tuck = ef(a2, a1)(a1, a2, a1)
- uncons = ef((a1, s0),)(a1, s0)
- unswons = compose(uncons, swap)
- stuncons = compose(stack, uncons)
- stununcons = compose(stack, uncons, uncons)
- unit = ef(a1)((a1, ()))
-
- first_two = compose(uncons, uncons, pop)
- fourth = compose(rest, third)
-
- _Tree_add_Ee = compose(pop, swap, rolldown, rrest, ccons)
- _Tree_get_E = compose(popop, second)
- _Tree_delete_clear_stuff = compose(rollup, popop, rest)
- _Tree_delete_R0 = compose(over, first, swap, dup)
-
- return locals()
-
-
-definitions = ('''\
-of == swap at
-product == 1 swap [*] step
-flatten == [] swap [concat] step
-quoted == [unit] dip
-unquoted == [i] dip
-enstacken == stack [clear] dip
-? == dup truthy
-disenstacken == ? [uncons ?] loop pop
-dinfrirst == dip infra first
-nullary == [stack] dinfrirst
-unary == nullary popd
-binary == nullary [popop] dip
-ternary == unary [popop] dip
-pam == [i] map
-run == [] swap infra
-sqr == dup mul
-size == 0 swap [pop ++] step
-fork == [i] app2
-cleave == fork [popd] dip
-average == [sum 1.0 *] [size] cleave /
-gcd == 1 [tuck modulus dup 0 >] loop pop
-least_fraction == dup [gcd] infra [div] concat map
-*fraction == [uncons] dip uncons [swap] dip concat [*] infra [*] dip cons
-*fraction0 == concat [[swap] dip * [*] dip] infra
-down_to_zero == [0 >] [dup --] while
-range_to_zero == unit [down_to_zero] infra
-anamorphism == [pop []] swap [dip swons] genrec
-range == [0 <=] [1 - dup] anamorphism
-while == swap [nullary] cons dup dipd concat loop
-dupdipd == dup dipd
-primrec == [i] genrec
-step_zero == 0 roll> step
-codireco == cons dip rest cons
-make_generator == [codireco] ccons
-ifte == [nullary not] dipd branch
-'''
-#
-#
-# ifte == [nullary] dipd swap branch
-# genrec == [[genrec] cons cons cons cons] nullary swons concat ifte
-
-# Another definition for while. FWIW
-# while == over [[i] dip nullary] ccons [nullary] dip loop
-
-##ccons == cons cons
-##unit == [] cons
-##second == rest first
-##third == rest rest first
-##swons == swap cons
-##swoncat == swap concat
-
-##Zipper
-##z-down == [] swap uncons swap
-##z-up == swons swap shunt
-##z-right == [swons] cons dip uncons swap
-##z-left == swons [uncons swap] dip swap
-
-##Quadratic Formula
-##divisor == popop 2 *
-##minusb == pop neg
-##radical == swap dup * rollup * 4 * - sqrt
-##root1 == + swap /
-##root2 == - swap /
-##q0 == [[divisor] [minusb] [radical]] pam
-##q1 == [[root1] [root2]] pam
-##quadratic == [q0] ternary i [q1] ternary
-
-# Project Euler
-##'''\
-##PE1.1 == + dup [+] dip
-##PE1.2 == dup [3 & PE1.1] dip 2 >>
-##PE1.3 == 14811 swap [PE1.2] times pop
-##PE1 == 0 0 66 [7 PE1.3] times 4 PE1.3 pop
-##'''
-#PE1.2 == [PE1.1] step
-#PE1 == 0 0 66 [[3 2 1 3 1 2 3] PE1.2] times [3 2 1 3] PE1.2 pop
-)