From 387d9d4ed4eb381e24c77f5fccb1bbd950da1726 Mon Sep 17 00:00:00 2001 From: sforman Date: Wed, 16 Aug 2023 10:04:52 -0700 Subject: [PATCH] Working on the notebooks. --- docs/html/notebooks/BigInts.html | 21514 +----------------- docs/html/notebooks/Generator_Programs.html | 199 +- docs/misc/misc.txt | 40 + docs/source/notebooks/BigInts.md | 2198 ++ docs/source/notebooks/Generator_Programs.md | 215 +- 5 files changed, 3567 insertions(+), 20599 deletions(-) create mode 100644 docs/source/notebooks/BigInts.md diff --git a/docs/html/notebooks/BigInts.html b/docs/html/notebooks/BigInts.html index 79f3970..978240d 100644 --- a/docs/html/notebooks/BigInts.html +++ b/docs/html/notebooks/BigInts.html @@ -1,16724 +1,613 @@ - + - - - -BigInts - - - - - - - - - - - - + + +BigNums in Joy + + + -
-
- -
-
-
-

BigInts in Joy

Part of the puzzle is implementing "bigints", unbounded integers, by means of Oberon RISC signed 32-bit ints and their operations.

-

We can model bigints as a pair of a Boolean value for the sign and a list of integers for the digits, to keep things simple let the bool be the first item on a list followed by zero or more int digits. The Least Signifigant digit is at the top or head of the list. Our base for the digits is:

-$$2^{31}$$

Our digits are 0..2147483647 (our "nine".)

- -
-
-
-
-
-
In [2]:
-
-
-
1 31 lshift 
-
- -
-
-
- -
-
- - -
- -
- - -
-
2147483648
-
-
- -
-
- -
-
-
-
+

BigNums in Joy

+

Most of the implementations of Thun support +BigNums, either built-in or as +libraries, but some host languages and systems do not. In those cases it +would be well to have a pure-Joy implementation.

+

We can model bignums as a pair of a Boolean value for the sign and a list +of integers for the digits. The bool will be the first item on a list +followed by zero or more integer digits, with the Least Significant digit +at the top (closest to the head of the list.) E.g.:

+
[true 1]
+
+

Our base for the digits will be dictated by the size of the integers +supported by the host system. Let's imagine we're using 32-bit signed +ints, so our base will be not 10, but 2³¹. (We're ignoring the sign +bit.)

+
joy? 2 31 pow
+2147483648
+
+

So our digits are not 0..9, but 0..2147483647

+

base

We can inscribe a constant function base to keep this value handy.

- -
-
-
-
-
-
In [2]:
-
-
-
unit 
-
- -
-
-
- -
-
-
-
In [3]:
-
-
-
[base] swoncat
-
- -
-
-
- -
-
-
-
In [4]:
-
-
-
 inscribe
-
- -
-
-
- -
-
-
-
-

This also permits a kind of parameterization. E.g. let's say we wanted to use base 10 for our digits, maybe during debugging. All that requires is to rebind the symbol base to 10.

- -
-
-
-
-
-
-

We could define a Boolean predicate that returns true for integers that are valid as digits and false otherwise:

- -
-
-
-
-
-
In [5]:
-
-
-
[valid_digit [0 >] [base <] &&] inscribe
-
- -
-
-
- -
-
-
-
In [6]:
-
-
-
32 valid_digit 1232147483648 valid_digit
-
- -
-
-
- -
-
- - -
- -
- - -
-
32 true 1232147483648 false
-
-
- -
-
- -
-
-
-
In [7]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Converting to and from Python Integers

Because we are working with Python Joy right now we can convert ints to bigints and vice versa. THis will be helpful to check our work. Later we can deal with converting to and from strings (which this Joy doesn't have anyway, so it's probably fine to defer.)

- -
-
-
-
-
-
-

To get the sign bool we can just use !- ("not negative"), to get the list of digits we repeatedly divmod the number by our base:

- -
-
-
-
-
-
In [8]:
-
-
-
12345678901234567890 base divmod swap
-
- -
-
-
- -
-
- - -
- -
- - -
-
1797196498 5748904729
-
-
- -
-
- -
-
-
-
In [9]:
-
-
-
base divmod swap
-
- -
-
-
- -
-
- - -
- -
- - -
-
1797196498 1453937433 2
-
-
- -
-
- -
-
-
-
In [10]:
-
-
-
base divmod swap
-
- -
-
-
- -
-
- - -
- -
- - -
-
1797196498 1453937433 2 0
-
-
- -
-
- -
-
-
-
+
2147483648
+joy? unit [base] swoncat
+[base 2147483648]
+joy? inscribe
+
+

This is sort of like a constant, and it's a little "wrong" to use the +dictionary to store values like this, however, this is how Forth does it +and if your design is good it works fine. Just be careful, and wash +your hand afterward.

+

This also permits a kind of parameterization. E.g. let's say we wanted +to use base 10 for our digits, maybe during debugging. All that requires +is to rebind the symbol base to 10.

+

Converting Between Host BigNums and Joy BigNums

+

We will work with one of the Joy interpreters that has bignums already so +we can convert "native" ints to our Joy bignums and vice versa. This +will be helpful to check our work. Later we can deal with converting to +and from strings (which this Joy doesn't have anyway, so it's probably +fine to defer.)

+

To get the sign bool we can just use !- ("not negative") and to get the +list of digits we repeatedly divmod the number by our base:

+

moddiv

+

We will want the results in the opposite order, so let's define a little +helper function to do that:

+
[moddiv divmod swap] inscribe
+
+

get-digit

+
[get-digit base moddiv] inscribe
+

We keep it up until we get to zero. This suggests a while loop:

+
[0 >] [get-digit] while
+
+

Let's try it:

+
joy? 1234567890123456789012345678901234567890
+1234567890123456789012345678901234567890
 
-
[0 >=] [base divmod swap] while
+joy? [0 >] [get-digit] while +1312754386 1501085485 57659106 105448366 58 0 +
+

We need to pop at the end to ditch that zero.

+
[0 >] [get-digit] while pop
+
+

But we want these numbers in a list. The naive way using infra +generates them in the reverse order of what we would like.

+
joy? [1234567890123456789012345678901234567890]
+[1234567890123456789012345678901234567890]
 
-
-
-
-
-
-
In [11]:
-
-
-
clear 1234567890123456789012345678901234567890
+joy? [[0 >] [get-digit] while pop]
+[1234567890123456789012345678901234567890] [[0 >] [get-digit] while pop]
 
-[0 >] [base divmod swap] while pop
-
+joy? infra +[58 105448366 57659106 1501085485 1312754386] +
+

We could just reverse the list, but it's more efficient to build the result list in the order we want. +We construct a simple recursive function. (TODO: link to the recursion combinators notebook.)

+

The predicate will check that our number is yet positive:

+
[0 <=]
+
+

When we find the zero we will discard it and start a list:

+
[pop []]
+
+

But until we do find the zero, get digits:

+
[get-digit]
+
+

Once we have found all the digits and ditched the zero and put our initial empty list on the stack we +cons up the digits we have found:

+
[i cons] genrec
+
+

Let's try it:

+
joy? 1234567890123456789012345678901234567890
+1234567890123456789012345678901234567890
 
-    
-
-
- -
-
- - -
- -
- - -
-
1312754386 1501085485 57659106 105448366 58
-
-
- -
-
- -
-
-
-
-

But we want these numbers in a list. The naive way using infra generates them in the reverse order of what we would like.

- -
-
-
-
-
-
In [12]:
-
-
-
clear [1234567890123456789012345678901234567890]
-
-[ [0 >] [base divmod swap] while pop ]
-
-infra
-
- -
-
-
- -
-
- - -
- -
- - -
-
[58 105448366 57659106 1501085485 1312754386]
-
-
- -
-
- -
-
-
-
-

We could just reverse the list, but it's more efficient to build the result list in the order we want, LSB to MSB:

- -
-
-
-
-
-
In [13]:
-
-
-
clear 1234567890123456789012345678901234567890
-
-[0 <=]
-[pop []]
-[base divmod swap]
-[i cons]
-genrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
[1312754386 1501085485 57659106 105448366 58]
-
-
- -
-
- -
-
-
-
-

Representing Zero

This will return the empty list for zero:

- -
-
-
-
-
-
In [14]:
-
-
-
clear
-
-0 [0 <=] [pop []] [base divmod swap] [i cons] genrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
[]
-
-
- -
-
- -
-
-
-
+joy? [0 <=] [pop []] [get-digit] [i cons] genrec +[1312754386 1501085485 57659106 105448366 58] + +

Okay.

+

Representing Zero

+

This will return the empty list for zero:

+
joy? 0 [0 <=] [pop []] [get-digit] [i cons] genrec
+[]
+

I think this is better than returning [0] because that amounts to a single leading zero.

- -
[bool]   is "0"
-[bool 0] is "00"
-
+
[true]   is "0"
+[true 0] is "00"
 

Eh?

- -
-
-
-
-
-
-

digitalize

Let's inscribe this function under the name digitalize:

- -
-
-
-
-
-
In [15]:
-
-
-
clear
-
-[digitalize [0 <=] [pop []] [base divmod swap] [i cons] genrec] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Try it out:

- -
-
-
-
-
-
In [16]:
-
-
-
clear
-
-1234567890123456789012345678901234567890 digitalize
-
- -
-
-
- -
-
- - -
- -
- - -
-
[1312754386 1501085485 57659106 105448366 58]
-
-
- -
-
- -
-
-
-
-

Putting it all together we have !- for the sign and abs digitalize for the digits, followed by cons:

- -
-
-
-
-
-
In [17]:
-
-
-
clear 1234567890123456789012345678901234567890
-
-[!-] [abs digitalize] cleave cons
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 1312754386 1501085485 57659106 105448366 58]
-
-
- -
-
- -
-
-
-
In [18]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

to-bigint

-
-
-
-
-
-
In [19]:
-
-
-
[to-bigint [!-] [abs digitalize] cleave cons] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Try it out:

- -
-
-
-
-
-
In [20]:
-
-
-
clear 1234567890123456789012345678901234567890 to-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 1312754386 1501085485 57659106 105448366 58]
-
-
- -
-
- -
-
-
-
-

With negative numbers:

- -
-
-
-
-
-
In [21]:
-
-
-
clear -1234567890123456789012345678901234567890 to-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
[false 1312754386 1501085485 57659106 105448366 58]
-
-
- -
-
- -
-
-
-
In [22]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Converting from bigint to Python ints

To convert a bigint into a Python integer we need to keep a "power" parameter on the stack, setting it up and discarding it at the end, as well as an accumulator value starting at zero:

- -
prep == rest 1 0 rolldown
-
-[true 3 2 1] rest 1 0 rolldown
-1 0 [3 2 1]
-
+

digitalize

+

Let's inscribe this function under the name digitalize:

+
[digitalize [0 <=] [pop []] [get-digit] [i cons] genrec] inscribe
+
+

Putting it all together we have !- for the sign and abs digitalize for the digits, followed by cons:

+
[!-] [abs digitalize] cleave cons
+
+

to-bignum

+
[to-bignum [!-] [abs digitalize] cleave cons] inscribe
+
+

Converting from Joy BigNums to Host BigNums

+

To convert a bignum into a host integer we need to keep a "power" value on the stack, +setting it up and discarding it at the end, as well as an accumulator value starting at zero. +We will deal with the sign bit later.

+
rest 1 0 rolldown
 
-

We will deal with the sign bit later.

- -
-
-
-
-
-

So the problem is to derive:

-
   1 0 [digits...] [F] step
--------------------------
-       result
-
+------------------------------
+          result
 

Where F is:

-
          power acc digit F
 ---------------------------------------
-   (power*base) (acc + (power*digit)
- -
-
-
-
-
-
-

Now this is an interesting function. The first thing I noticed is that it has two results that can be computed independently, suggesting a form like:

- -
F == [G] [H] clop
-
+   (power*base) (acc + (power*digit)
 
-

Then I noticed that power * is a sub-function of both G and H, but let's not overthink it, eh?

- +

Now this is an interesting function. +The first thing I noticed is that it has two results that can be computed independently, suggesting a form like:

+
[G] [H] clop popdd
+
+

(Then I noticed that power * is a sub-function of both G and H, but let's not overthink it, eh?)

+

So for the first result (the next power) we want:

G == popop base *
-H == rolldown * +
-
-F == [G] [H] clop popdd
- -
-
-
-
-
-
In [23]:
-
-
-
clear 1 0 23 [popop base *] trace
-
- -
-
-
- -
-
- - -
- -
- - -
-
      1 0 23 • popop base *
-           1 • base *
-           1 • 2147483648 *
-1 2147483648 • *
-1 2147483648 • mul
-  2147483648 • 
-
-2147483648
-
-
- -
-
- -
-
-
-
In [24]:
-
-
-
clear 1 0 23 [rolldown * +] trace
-
- -
-
-
- -
-
- - -
- -
- - -
-
1 0 23 • rolldown * +
-0 23 1 • * +
-0 23 1 • mul +
-  0 23 • +
-  0 23 • add
-    23 • 
-
-23
-
-
- -
-
- -
-
-
-
In [25]:
-
-
-
clear 1 0 23
-
-[popop base *]
-[rolldown * +]
-clop
-popdd
-
- -
-
-
- -
-
- - -
- -
- - -
-
2147483648 23
-
-
- -
-
- -
-
-
-
In [26]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

prep and from-bigint'

-
-
-
-
-
-
In [27]:
-
-
-
[prep rest 1 0 rolldown] inscribe
-[from-bigint' [F] step popd] inscribe
-[F [G] [H] clop popdd] inscribe
-[G popop base *] inscribe
-[H rolldown * +] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [28]:
-
-
-
1 0 [1312754386 1501085485 57659106 105448366 58]
-
-from-bigint'
-
- -
-
-
- -
-
- - -
- -
- - -
-
1234567890123456789012345678901234567890
-
-
- -
-
- -
-
-
-
In [29]:
-
-
-
to-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 1312754386 1501085485 57659106 105448366 58]
-
-
- -
-
- -
-
-
-
In [30]:
-
-
-
prep
-
- -
-
-
- -
-
- - -
- -
- - -
-
1 0 [1312754386 1501085485 57659106 105448366 58]
-
-
- -
-
- -
-
-
-
In [31]:
-
-
-
from-bigint'
-
- -
-
-
- -
-
- - -
- -
- - -
-
1234567890123456789012345678901234567890
-
-
- -
-
- -
-
-
-
In [32]:
-
-
-
to-bigint prep from-bigint'
-
- -
-
-
- -
-
- - -
- -
- - -
-
1234567890123456789012345678901234567890
-
-
- -
-
- -
-
-
-
-

What about that sign bit?

- -
-
-
-
-
-
In [33]:
-
-
-
neg
-
- -
-
-
- -
-
- - -
- -
- - -
-
-1234567890123456789012345678901234567890
-
-
- -
-
- -
-
-
-
In [34]:
-
-
-
to-bigint prep from-bigint'
-
- -
-
-
- -
-
- - -
- -
- - -
-
1234567890123456789012345678901234567890
-
-
- -
-
- -
-
-
-
-

That's no good, we lose the sign. Time to deal with that.

- -
-
-
-
-
-
In [35]:
-
-
-
to-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 1312754386 1501085485 57659106 105448366 58]
-
-
- -
-
- -
-
-
-
-

We want to get the sign bit and the Python int,

- -
-
-
-
-
-
In [36]:
-
-
-
[first] [prep from-bigint'] cleave
-
- -
-
-
- -
-
- - -
- -
- - -
-
true 1234567890123456789012345678901234567890
-
-
- -
-
- -
-
-
-
-

and then use the sign bit to negate the Python int if the bigint was negative:

- -
-
-
-
-
-
In [37]:
-
-
-
swap [] [neg] branch
-
- -
-
-
- -
-
- - -
- -
- - -
-
-1234567890123456789012345678901234567890
-
-
- -
-
- -
-
-
-
+ +

And for the result:

+
H == rolldown * +
+
+

add-digit

+

Let's call this add-digit:

+
[add-digit [popop base *] [rolldown * +] clop popdd] inscribe
+
+

Try it out:

+
[true 1312754386 1501085485 57659106 105448366 58]
+joy? rest 1 0 rolldown
+
+1 0 [1312754386 1501085485 57659106 105448366 58]
+
+joy? [add-digit] step
+45671926166590716193865151022383844364247891968 1234567890123456789012345678901234567890
+
+joy? popd
+1234567890123456789012345678901234567890
+
+

from-bignum′

+
[from-bignum′ rest 1 0 rolldown [add-digit] step popd] inscribe
+
+

Try it out:

+
joy? 1234567890123456789012345678901234567890 to-bignum
+[true 1312754386 1501085485 57659106 105448366 58]
+
+joy? from-bignum′
+1234567890123456789012345678901234567890
+
+

Not bad.

+

What about that sign bit?

+

Time to deal with that.

+

Consider a Joy bignum:

+
[true 1312754386 1501085485 57659106 105448366 58]
+
+

To get the sign bit would just be first.

+
[true 1312754386 1501085485 57659106 105448366 58]
+
+joy? [from-bignum′] [first] cleave
+1234567890123456789012345678901234567890 true
+
+

Then use the sign flag to negate the int if the bignum was negative:

+
[neg] [] branch
+
+

from-bignum

This gives:

+
[from-bignum [from-bignum′] [first] cleave [neg] [] branch] inscribe
+
+

Our Source Code So Far

+

(Note that this is a list of definitions, and then we can [inscribe] step them into the dictionary all at once. +This is for convenience when entering definitions into an interpreter as one is following along, eh?)

+
[base 2147483648] inscribe
+[moddiv divmod swap] inscribe
+[get-digit base moddiv] inscribe
+[digitalize [0 <=] [pop []] [get-digit] [i cons] genrec] inscribe
+[to-bignum [!-] [abs digitalize] cleave cons] inscribe
 
-
foo == [first] [prep from-bigint'] cleave
-bar == swap [] [neg] branch
-from-bigint == foo bar
- -
-
-
-
-
-
-

(I just realize that if you pre-swap the two quoted programs in foo then you can omit swap from bar.)

- -
foo == [prep from-bigint'] [first] cleave
-bar == [] [neg] branch
-from-bigint == foo bar
- -
-
-
-
-
-
-

from-bigint

-
-
-
-
-
-
In [38]:
-
-
-
clear
-[foo [prep from-bigint'] [first] cleave] inscribe
-[bar [neg] [] branch] inscribe
-[from-bigint foo bar] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [39]:
-
-
-
1234567890123456789012345678901234567890 to-bigint from-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
1234567890123456789012345678901234567890
-
-
- -
-
- -
-
-
-
In [40]:
-
-
-
neg to-bigint from-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
-1234567890123456789012345678901234567890
-
-
- -
-
- -
-
-
-
In [41]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Addition of Like Signs add-digits

Let's figure out how to add two lists of digits (we will assume that the signs are the same.) We need to put an inital false value for a carry flag, and then there's a genrec.

- -
initial-carry == false rollup
-  add-digits' ≡ [P] [THEN] [R0] [R1] genrec
-
-   add-digits ≡ initial-carry add-digits'
- -
-
-
-
-
-
-

The predicate

I think we're going to want a recursive function (duh!?) but it's not quite a standard hylomorphism for (at least) two reasons:

+[add-digit [popop base *] [rolldown * +] clop popdd] inscribe +[from-bignum′.prep rest 1 0 rolldown] inscribe +[from-bignum′ from-bignum′.prep [add-digit] step popd] inscribe +[from-bignum [from-bignum′] [first] cleave [neg] [] branch] inscribe +
+

Addition of Like Signs

+

add-digits

+

Let's figure out how to add two lists of digits. We will assume that the signs are the same (both lists of digits represent +numbers of the same sign, both positive or both negative.) +We're going to want a recursive function, of course, but it's not quite a standard hylomorphism for (at least) two reasons:

  • We're tearing down two lists simultaneously.
  • They might not be the same length.

There are two base cases: two empty lists or one empty list, the recursive branch is taken only if both lists are non-empty.

+

We will also need an inital false value for a carry flag. This implies the following structure:

+
false rollup [add-digits.P] [add-digits.THEN] [add-digits.R0] [add-digits.R1] genrec
+
+

The predicate

+

The situation will be like this, a Boolean flag followed by two lists of digits:

+
bool [a ...] [b ...] add-digits.P
+
+

The predicate must evaluate to false iff both lists are non-null:

+
add-digits.P == [null] ii \/
+
+

The base cases

+

On the non-recursive branch of the genrec we have to decide between three cases, +but because addition is commutative we can lump together the first two:

+
bool [] [b ...] add-digits.THEN
+bool [a ...] [] add-digits.THEN
 
-
bool [a ...] [b ...] P
- -
-
-
-
-
-
-

The first thing to do is convert them to Booleans. Let's make a little truth table to work with:

- -
-
-
-
-
-
In [42]:
-
-
-
clear
-[
-[[a] [b]]
-[[a] []]
-[[] [b]]
-[[] []]
-]
-
- -
-
-
- -
-
- - -
- -
- - -
-
[[[a] [b]] [[a] []] [[] [b]] [[] []]]
-
-
- -
-
- -
-
-
-
-

Then we can map our predicate over this list to be sure ti does what we want:

- -
-
-
-
-
-
In [43]:
-
-
-
[[[bool] ii] infra] map
-
- -
-
-
- -
-
- - -
- -
- - -
-
[[true true] [true false] [false true] [false false]]
-
-
- -
-
- -
-
-
-
-

We want to and the bools and invert the result:

- -
-
-
-
-
-
In [44]:
-
-
-
clear [[[a] [b]] [[a] []] [[] [b]] [[] []]] 
-
-[[[bool] ii & not] infra] map
-
- -
-
-
- -
-
- - -
- -
- - -
-
[[false] [true] [true] [true]]
-
-
- -
-
- -
-
-
-
-

So the predicate function we want here is:

- -
P == [bool] ii & not
- -
-
-
-
-
-
-

The base cases

On the non-recursive branch of the genrec we have to decide between three cases, but because addition is commutative we can lump together the first two:

- -
bool [] [b ...] THEN
-bool [a ...] [] THEN
-
-bool [] [] THEN
-
+bool [] [] add-digits.THEN
 

So we have an ifte expression:

- -
THEN ≡ [P'] [THEN'] [ELSE] ifte
-
+
add-digits.THEN == [add-digits.THEN.P] [add-digits.THEN.THEN] [add-digits.THEN.ELSE] ifte
 

Let's define the predicate:

- -
-
-
-
-
-
In [45]:
-
-
-
clear
-[
-[[a] []]
-[[] [b]]
-[[] []]
-]
-
-[[[bool] ii |] infra] map
-
- -
-
-
- -
-
- - -
- -
- - -
-
[[true] [true] [false]]
-
-
- -
-
- -
-
-
-
- -
P' ≡ [bool] ii |
-
+
add-digits.THEN.P == [null] ii /\
 
-

So THEN' deals with one number (list of digits) being longer than the other, while the ELSE branch deals with the case of both lists being empty.

- -
-
-
-
-
-
-

One list empty

In the cases where one of the two lists (but not both) is empty:

- -
carry [a ...] [] THEN'
-carry [] [b ...] THEN'
-
+

So add-digits.THEN.THEN deals with the case of both lists being empty, +and the add-digits.THEN.ELSE branch deals with one list of digits being longer than the other.

+

One list empty

+

In the cases where one of the two lists (but not both) is empty:

+
carry [a ...] [] add-digits.THEN.ELSE
+carry [] [b ...] add-digits.THEN.ELSE
 

We first get rid of the empty list:

+
[null] [pop] [popd] ifte
+
+

ditch-empty-list

+
[ditch-empty-list [null] [pop] [popd] ifte] inscribe
 
-
ditch-empty-list ≡ [bool] [popd] [pop] ifte
- -
-
-
-
-
-
In [46]:
-
-
-
clear
-[ditch-empty-list [bool] [popd] [pop] ifte] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Try it out:

- -
-
-
-
-
-
In [47]:
-
-
-
[1][] ditch-empty-list
-
- -
-
-
- -
-
- - -
- -
- - -
-
[1]
-
-
- -
-
- -
-
-
-
In [48]:
-
-
-
clear
-[][1] ditch-empty-list
-
- -
-
-
- -
-
- - -
- -
- - -
-
[1]
-
-
- -
-
- -
-
-
-
- -
THEN' ≡ ditch-empty-list THEN''
-
+add-digits.THEN.ELSE == ditch-empty-list add-digits.THEN.ELSE′
 

Now we have:

- -
carry [n ...] THEN''
-
+
carry [n ...] add-digits.THEN.ELSE′
 
-

This is add-carry-to-digits...

- -
-
-
-
-
-
-

But first add-with-carry

We will want some function F that accepts a bool and two ints and leaves behind a new int and a new Boolean carry flag:

- -
        carry0 a b F
---------------------------
-     (a+b+carry0) carry
-
+

This is just add-carry-to-digits which we will derive in a moment, but first a side-quest...

+

add-with-carry

+

To get ahead of ourselves a bit, +we will want some function add-with-carry that accepts a bool and two ints and leaves behind a new int and a new Boolean carry flag. +With some abuse of notation we can treat bools as ints (type punning as in Python) and write:

+
      carry a b add-with-carry
+---------------------------------
+        (a+b+carry) carry′
 

(I find it interesting that this function accepts the carry from below the int args but returns it above the result. Hmm...)

- -
-
-
-
-
-
-

bool-to-int

-
-
-
-
-
-
In [49]:
-
-
-
clear
-
-[bool-to-int [0] [1] branch] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Try it out:

- -
-
-
-
-
-
In [50]:
-
-
-
false bool-to-int
-true bool-to-int
-
- -
-
-
- -
-
- - -
- -
- - -
-
0 1
-
-
- -
-
- -
-
-
-
-

We can use this function to convert the carry flag to an integer and then add it to the sum of the two digits:

- -
-
-
-
-
-
In [51]:
-
-
-
clear
-
-false 1 2 [bool-to-int] dipd + +
-
- -
-
-
- -
-
- - -
- -
- - -
-
3
-
-
- -
-
- -
-
-
-
In [52]:
-
-
-
clear
-
-true 1 2 [bool-to-int] dipd + +
-
- -
-
-
- -
-
- - -
- -
- - -
-
4
-
-
- -
-
- -
-
-
-
-

So the first part of F is [bool-to-int] dipd + + to get the total, then we need to do

-

base mod to get the new digit and base >= to get the new carry flag:

- -
-
-
-
-
-
In [53]:
-
-
-
clear
-
-4 base [mod] [>=] clop
-
- -
-
-
- -
-
- - -
- -
- - -
-
4 false
-
-
- -
-
- -
-
-
-
In [54]:
-
-
-
clear
-
-base 100 +
-
-base [mod] [>=] clop
-
- -
-
-
- -
-
- - -
- -
- - -
-
100 true
-
-
- -
-
- -
-
-
-
-

Put it all together and we have:

- -
_add-with-carry0 ≡ [bool-to-int] dipd + +
-_add-with-carry1 ≡ base [mod] [>=] clop
-
-add-with-carry ≡ _add-with-carry0 _add-with-carry1
- -
-
-
-
-
-
-

add-with-carry

-
-
-
-
-
-
In [55]:
-
-
-
clear
-[_add-with-carry0 [bool-to-int] dipd + +] inscribe
-[_add-with-carry1 base [mod] [>=] clop] inscribe
-[add-with-carry _add-with-carry0 _add-with-carry1] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Try it out:

- -
-
-
-
-
-
In [56]:
-
-
-
clear
-
-false base 100 add-with-carry
-
- -
-
-
- -
-
- - -
- -
- - -
-
100 true
-
-
- -
-
- -
-
-
-
In [57]:
-
-
-
clear
-
-true base 100 add-with-carry
-
- -
-
-
- -
-
- - -
- -
- - -
-
101 true
-
-
- -
-
- -
-
-
-
In [58]:
-
-
-
clear
-
-false 2 100 add-with-carry
-
- -
-
-
- -
-
- - -
- -
- - -
-
102 false
-
-
- -
-
- -
-
-
-
In [59]:
-
-
-
clear
-
-true 2 100 add-with-carry
-
- -
-
-
- -
-
- - -
- -
- - -
-
103 false
-
-
- -
-
- -
-
-
-
In [60]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Now back to add-carry-to-digits

This should be a very simple recursive function.

- -
add-carry-to-digits ≡ [_actd_P] [_actd_THEN] [_actd_R0] [_actd_R1] genrec
-
-carry [n ...] add-carry-to-digits
-carry [n ...] [_actd_P] [_actd_THEN] [_actd_R0] [_actd_R1] genrec
-
+

bool-to-int

+
[bool-to-int [0] [1] branch] inscribe
 
-

The predicate is the carry flag itself inverted (but when we recur we will need to check if the list is non-empty because it may eventually be empty):

- -
_actd_P ≡ pop not
-
+

We can use this function to convert the carry flag to an integer and then add it to the sum of the two digits:

+
[bool-to-int] dipd + +
+
+

So the first part of add-with-carry is [bool-to-int] dipd + + to get the total, then we need to do +base mod to get the new digit and base >= to get the new carry flag. Factoring give us:

+
base [mod] [>=] clop
+
+

Put it all together and we have:

+
[add-with-carry.0 [bool-to-int] dipd + +] inscribe
+[add-with-carry.1 base [mod] [>=] clop] inscribe
+[add-with-carry add-with-carry.0 add-with-carry.1] inscribe
+
+

Now back to add-carry-to-digits

+

This should be a very simple recursive function. It accepts a Boolean carry flag +and a non-empty list of digits (the list is only going to be non-empty on the +first iteration, after that we have to check it ourselves because we may have emptied +it of digits and still have a true carry flag) and it returns a list of digits, consuming the carry flag.

+
add-carry-to-digits == [actd.P] [actd.THEN] [actd.R0] [actd.R1] genrec
+
+

The predicate is the carry flag itself inverted:

+
actd.P == pop not
 

The base case simply discards the carry flag:

- -
_actd_THEN ≡ popd
- -
-
-
-
-
-
+
actd.THEN == popd
+
+

So:

+
add-carry-to-digits == [pop not] [popd] [actd.R0] [actd.R1] genrec
+

That leaves the recursive branch:

- -
true [n ...] R0 [add-carry-to-digits] R1
-
+
true [n ...] actd.R0 [add-carry-to-digits] actd.R1
 

-or-

- -
true [] R0 [add-carry-to-digits] R1
- -
-
-
-
-
-
-

We know that the Boolean value is true. We also know that the list will be non-empty, but only on the first iteration of the genrec. It may be that the list is empty on a later iteration.

-

The R0 function should check the list.

- -
_actd_R0 ≡ [bool] [_actd_R0.then] [_actd_R0.else] ifte
- -
-
-
-
-
-
-

If it's empty... (omitting the "_actd_" prefix for clarity)

- -
   true [] R0.else [add-carry-to-digits] R1
-----------------------------------------------
-    1 false [] [add-carry-to-digits] i cons
- -
-
-
-
-
-
-

Note that this implies:

- -
R1 == i cons
-
+
true [] actd.R0 [add-carry-to-digits] actd.R1
 
-

We have 1 false [] (rather than some other arrangement) to be compatible (same types and order) with the result of the other branch, which we now derive.

- -
-
-
-
-
-
-

If the list of digits isn't empty...

- -
            true [a ...] R0.then [add-carry-to-digits] i cons
+

We know that the Boolean value is true. +We also know that the list will be non-empty, but only on the first iteration of the genrec. +It may be that the list is empty on a later iteration.

+

The actd.R0 function should check the list.

+
actd.R0 == [null] [actd.R0.THEN] [actd.R0.ELSE] ifte
+
+

If it's empty...

+
   true [] actd.R0.THEN [add-carry-to-digits] actd.R1
+--------------------------------------------------------
+             1 false [] [add-carry-to-digits] i cons
+
+

What we're seeing here is that actd.R0.THEN leaves the empty list of digits on the stack, +converts the carry flag to false and leave 1 on the stack to be picked up by actd.R1 +and cons'd onto the list of digits (e.g.: 999 -> 1000, it's the new 1.)

+

This implies:

+
actd.R1 == i cons
+
+

And:

+
actd.R0.THEN == popd 1 false rolldown
+
+

We have the results in this order 1 false [] rather than some other arrangement to be compatible (same types and order) +with the result of the other branch, which we now derive.

+

If the list of digits isn't empty...

+

With actd.R1 == i cons as above we have:

+
true [a ...] actd.R0.ELSE [add-carry-to-digits] i cons
+
+

We want to get out that a value and use add-with-carry here:

+
   true 0 a add-with-carry [...] [add-carry-to-digits] i cons
 ----------------------------------------------------------------
-   true 0 a add-with-carry [...] [add-carry-to-digits] i cons
-----------------------------------------------------------------
-               (a+1) carry [...] [add-carry-to-digits] i cons
- -
-
-
-
-
-
-

There we go.

- -
_actd_R0.else ≡ popd 1 false rolldown
-
-_actd_R0.then ≡ 0 swap uncons [add-with-carry] dip
-
-_actd_R1 ≡ i cons
- -
-
-
-
-
-
-

add-carry-to-digits

-
-
-
-
-
-
In [61]:
-
-
-
[add-carry-to-digits [_actd_P] [_actd_THEN] [_actd_R0] [_actd_R1] genrec] inscribe
-[_actd_P pop not] inscribe
-[_actd_THEN popd] inscribe
-[_actd_R0 [bool] [_actd_R0.then] [_actd_R0.else] ifte] inscribe
-[_actd_R0.else popd 1 false rolldown] inscribe
-[_actd_R0.then 0 swap uncons [add-with-carry] dip] inscribe
-[_actd_R1 i cons] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Try it out:

- -
-
-
-
-
-
In [62]:
-
-
-
clear
-
-false [3 2 1] add-carry-to-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[3 2 1]
-
-
- -
-
- -
-
-
-
In [63]:
-
-
-
clear
-
-true [] add-carry-to-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[1]
-
-
- -
-
- -
-
-
-
In [64]:
-
-
-
clear
-
-true [3 2 1] add-carry-to-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[4 2 1]
-
-
- -
-
- -
-
-
-
In [65]:
-
-
-
clear
-
-true base -- [2 1] cons 
-
- -
-
-
- -
-
- - -
- -
- - -
-
true [2147483647 2 1]
-
-
- -
-
- -
-
-
-
In [66]:
-
-
-
add-carry-to-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[0 3 1]
-
-
- -
-
- -
-
-
-
In [67]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
+ (a+1) carry [...] [add-carry-to-digits] i cons + +

This leaves behind the new digit (a+1) for actd.R1 and the new carry flag for the next iteration.

+

So here is the specification of actd.R0.ELSE:

+
     true [a ...] actd.R0.ELSE
+-----------------------------------
+   true 0 a add-with-carry [...]
+
+

It accepts a Boolean value and a non-empty list on the stack and is responsible +for uncons'ing a and add-with-carry and the initial 0:

+
                 true [a ...] . 0 swap
+               true 0 [a ...] . uncons
+               true 0 a [...] . [add-with-carry] dip
+true 0 a add-with-carry [...] .
+
+

actd.R0.ELSE

+
[actd.R0.ELSE 0 swap uncons [add-with-carry] dip] inscribe
+
+

Putting it all together:

+
[bool-to-int [0] [1] branch] inscribe
+[ditch-empty-list [null] [pop] [popd] ifte] inscribe
+
+[add-with-carry.0 [bool-to-int] dipd + +] inscribe
+[add-with-carry.1 base [mod] [>=] clop] inscribe
+[add-with-carry add-with-carry.0 add-with-carry.1] inscribe
+
+[actd.R0.THEN popd 1 false rolldown] inscribe
+[actd.R0.ELSE 0 swap uncons [add-with-carry] dip] inscribe
+[actd.R0 [null] [actd.R0.THEN] [actd.R0.ELSE] ifte] inscribe
+
+[add-carry-to-digits [pop not] [popd] [actd.R0] [i cons] genrec] inscribe
+
+

We can set base to 10 to see it in action with familiar decimal digits:

+
joy? [base 10] inscribe
+
+

Let's add a carry to 999:

+
joy? true [9 9 9]
+true [9 9 9]
+
+joy? add-carry-to-digits
+[0 0 0 1]
+
+

Not bad! Recall that our digits are stored in with the Most Significant Digit at the bottom of the list.

+

Let's add another carry:

+
joy? true swap
+true [0 0 0 1]
+
+joy? add-carry-to-digits
+[1 0 0 1]
+
+

What if we make the just the first digit into 9?

+
joy? 9 swons
+[9 1 0 0 1]
+
+joy? true swap
+true [9 1 0 0 1]
+
+joy? add-carry-to-digits
+[0 2 0 0 1]
+
+

Excellent!

+

And adding false does nothing, yes?

+
joy? false swap
+false [0 2 0 0 1]
+
+joy? add-carry-to-digits
+[0 2 0 0 1]
+
+

Wonderful!

So that handles the cases where one of the two lists (but not both) is empty.

-

Both lists empty

If both lists are empty we discard one list and check the carry to determine our result as decribed above:

- -
ELSE == pop swap [] [1 swons] branch
- -
-
-
-
-
-
In [68]:
-
-
-
[carry [] [1 swons] branch] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Try it out:

- -
-
-
-
-
-
In [69]:
-
-
-
clear
-
-true [] [] pop swap carry
-
- -
-
-
- -
-
- - -
- -
- - -
-
[1]
-
-
- -
-
- -
-
-
-
In [70]:
-
-
-
clear
-
-false [] [] pop swap carry
-
- -
-
-
- -
-
- - -
- -
- - -
-
[]
-
-
- -
-
- -
-
-
-
In [71]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

The story so far...

- -
add-digits == initial-carry add-digits'
-
-add-digits' == [P] [THEN] [R0] [R1] genrec
-
-initial-carry == false rollup
-
-P == [bool] ii & not
-
-THEN == [P'] [THEN'] [ELSE] ifte
-
-P' == [bool] ii |
-
-THEN' == ditch-empty-list add-carry-to-digits
-
-carry == [] [1 swons] branch
-
-ELSE == pop swap carry
-
+
add-digits.THEN.ELSE == ditch-empty-list add-carry-to-digits
 
-

We just need to knock out those recursive functions R0 and R1 and we're done.

- -
-
-
-
-
-
-

And recur...

-
bool [a ...] [b ...] R0 [add-digits'] R1
- -
-
-
-
-
-
-

First we will want to uncons the digits

- -
-
-
-
-
-
In [72]:
-
-
-
clear
-
-false [1 2 3] [4 5 6] [uncons] ii swapd
-
- -
-
-
- -
-
- - -
- -
- - -
-
false 1 4 [2 3] [5 6]
-
-
- -
-
- -
-
-
-
-

uncons-two

We could call this uncons-two:

- -
-
-
-
-
-
In [73]:
-
-
-
clear
-
-[uncons-two [uncons] ii swapd] inscribe
-
-[1 2 3] [4 5 6] uncons-two
-
- -
-
-
- -
-
- - -
- -
- - -
-
1 4 [2 3] [5 6]
-
-
- -
-
- -
-
-
-
In [74]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
- -
bool a b [...] [...] R0' [add-digits'] R1
+

Both lists empty

+

If both lists are empty we discard one list and check the carry to determine our result as described above:

+
bool [] [] add-digits.THEN.THEN
+
+

Simple enough:

+
bool [] [] . pop
+bool [] . swap
+[] bool . [] [1 swons] branch
+
+

True branch:

+
[] true . [] [1 swons] branch
+[] .
+
+

False branch:

+
[] false . [] [1 swons] branch
+[] . 1 swons
+[1] .
+
+

So:

+
add-digits.THEN.THEN == pop swap [] [1 swons] branch
+
+

Here are the definitions, ready to inscribe:

+
[add-digits.THEN.THEN pop swap [] [1 swons] branch] inscribe
+[add-digits.THEN.ELSE ditch-empty-list add-carry-to-digits] inscribe
+[add-digits.THEN [[null] ii /\] [add-digits.THEN.THEN] [add-digits.THEN.ELSE] ifte] inscribe
+
+

And recur...

+

Now we go back and derive the recursive branch that is taken only if both lists are non-empty.

+
bool [a ...] [b ...] add-digits.R0 [add-digits′] add-digits.R1
+
+

We just need to knock out those recursive branch functions add-digits.R0 and add-digits.R1 and we're done.

+

First we will want to uncons the digits. Let's write a function that just does that:

+
[uncons] ii swapd
+
+

Try it:

+
joy? [1 2 3] [4 5 6]
+[1 2 3] [4 5 6]
 
+joy? [uncons] ii swapd
+1 4 [2 3] [5 6]
+
+

uncons-two

+

We could call this uncons-two:

+
[uncons-two [uncons] ii swapd] inscribe
+
+

This brings us to:

+
bool a b [...] [...] add-digits.R0′ [add-digits′] add-digits.R1
 

It's at this point that we'll want to employ the add-with-carry function:

+
bool a b [...] [...] [add-with-carry] dipd add-digits.R0″ [add-digits'] add-digits.R1
 
-
bool a b [...] [...] [add-with-carry] dipd R0'' [add-digits'] R1
-
-bool a b add-with-carry [...] [...] R0'' [add-digits'] R1
-
-(a+b) bool [...] [...] R0'' [add-digits'] R1
+bool a b add-with-carry [...] [...] add-digits.R0″ [add-digits'] add-digits.R1
 
+(a+b) bool [...] [...] add-digits.R0″ [add-digits'] add-digits.R1
 
-

If we postulate a cons in our R1 function...

- -
(a+b) bool [...] [...] R0'' [add-digits'] i cons
-
+

If we postulate a cons in our add-digits.R1 function...

+
(a+b) bool [...] [...] add-digits.R0″ [add-digits'] i cons
 
-

Then it seems like we're done? R0'' is nothing?

- -
R0 ≡ uncons-two [add-with-carry] dipd
-
-R1 ≡ i cons
- -
-
-
-
-
-
-

add-digits

-
-
-
-
-
-
In [75]:
-
-
-
[add-digits initial-carry add-digits'] inscribe
-[add-digits' [P] [THEN] [R0] [R1] genrec] inscribe
-[initial-carry false rollup] inscribe
-[P [bool] ii & not] inscribe
-[THEN [P'] [THEN'] [ELSE] ifte] inscribe
-[P' [bool] ii |] inscribe
-[THEN' ditch-empty-list add-carry-to-digits] inscribe
-[ELSE pop swap [] [1 swons] branch] inscribe
-[R0 uncons-two [add-with-carry] dipd] inscribe
-[R1 i cons] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [76]:
-
-
-
[3 2 1] [1 1 1]
-
- -
-
-
- -
-
- - -
- -
- - -
-
[3 2 1] [1 1 1]
-
-
- -
-
- -
-
-
-
In [77]:
-
-
-
add-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[4 3 2]
-
-
- -
-
- -
-
-
-
In [78]:
-
-
-
base -- unit
-
- -
-
-
- -
-
- - -
- -
- - -
-
[4 3 2] [2147483647]
-
-
- -
-
- -
-
-
-
In [79]:
-
-
-
add-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[3 4 2]
-
-
- -
-
- -
-
-
-
In [80]:
-
-
-
base -- dup dup unit ccons
-
- -
-
-
- -
-
- - -
- -
- - -
-
[3 4 2] [2147483647 2147483647 2147483647]
-
-
- -
-
- -
-
-
-
In [81]:
-
-
-
add-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[2 4 2 1]
-
-
- -
-
- -
-
-
-
-

243 + 999 =

- -
-
-
-
-
-
In [82]:
-
-
-
clear 243 999 +
-
- -
-
-
- -
-
- - -
- -
- - -
-
1242
-
-
- -
-
- -
-
-
-
-

add-bigints

There is one more thing we have to do to use this: we have to deal with the signs.

- -
add-bigints 
-[[first] ii xor not]                 # are they the same sign?
-[[uncons] dip rest add-digits cons]  # add the digits and set the sign.
-[neg-bigint sub-bigints]             # adding unlikes is actually subtraction.
-ifte
+

Then it seems like we're done? add-digits.R0″ is nothing?

+
add-digits.R0 == uncons-two [add-with-carry] dipd
 
+add-digits.R1 == i cons
 
-

But we haven't implemented neg-bigint or sub-bigints yet...

- -
-
-
-
-
-
In [83]:
-
-
-
clear
-
-123 to-bigint 456 to-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 123] [true 456]
-
-
- -
-
- -
-
-
-
In [84]:
-
-
-
[first] ii xor not
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [85]:
-
-
-
clear
-
-123 to-bigint 456 to-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 123] [true 456]
-
-
- -
-
- -
-
-
-
In [86]:
-
-
-
[uncons] dip
-
- -
-
-
- -
-
- - -
- -
- - -
-
true [123] [true 456]
-
-
- -
-
- -
-
-
-
In [87]:
-
-
-
rest 
-
- -
-
-
- -
-
- - -
- -
- - -
-
true [123] [456]
-
-
- -
-
- -
-
-
-
In [88]:
-
-
-
add-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
true [579]
-
-
- -
-
- -
-
-
-
In [89]:
-
-
-
 cons
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 579]
-
-
- -
-
- -
-
-
-
-

add-bigints

-
-
-
-
-
-
In [90]:
-
-
-
[same-sign [first] ii xor not] inscribe
-[add-like-bigints [uncons] dip rest add-digits cons] inscribe
-[add-bigints [same-sign] [add-like-bigints] [1 0 /] ifte] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 579]
-
-
- -
-
- -
-
-
-
In [91]:
-
-
-
base -- to-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 579] [true 2147483647]
-
-
- -
-
- -
-
-
-
In [92]:
-
-
-
add-bigints
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 578 1]
-
-
- -
-
- -
-
-
-
In [93]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Subtraction of Like Signs sub-digits

Subtraction is similar to addition in that it's a simple recursive algorithm that works digit-by-digit. It has the same four cases as well, we can reuse P and P'.

- +

add-digits

+
add-digits == false rollup [add-digits.P] [add-digits.THEN] [add-digits.R0] [i cons] genrec
+
+

The source code so far is now:

+
[bool-to-int [0] [1] branch] inscribe
+[ditch-empty-list [null] [pop] [popd] ifte] inscribe
+[uncons-two [uncons] ii swapd] inscribe
+
+[add-with-carry.0 [bool-to-int] dipd + +] inscribe
+[add-with-carry.1 base [mod] [>=] clop] inscribe
+[add-with-carry add-with-carry.0 add-with-carry.1] inscribe
+
+[actd.R0.THEN popd 1 false rolldown] inscribe
+[actd.R0.ELSE 0 swap uncons [add-with-carry] dip] inscribe
+[actd.R0 [null] [actd.R0.THEN] [actd.R0.ELSE] ifte] inscribe
+
+[add-carry-to-digits [pop not] [popd] [actd.R0] [i cons] genrec] inscribe
+
+[add-digits.R0 uncons-two [add-with-carry] dipd] inscribe
+
+[add-digits.THEN.THEN pop swap [] [1 swons] branch] inscribe
+[add-digits.THEN.ELSE ditch-empty-list add-carry-to-digits] inscribe
+[add-digits.THEN [[null] ii /\] [add-digits.THEN.THEN] [add-digits.THEN.ELSE] ifte] inscribe
+
+[add-digits′ [[null] ii \/] [add-digits.THEN] [add-digits.R0] [i cons] genrec] inscribe
+[add-digits false rollup add-digits′] inscribe
+
+

Let's set base to 10 and try it out:

+
joy? [base 10] inscribe
+
+joy? 12345 to-bignum
+[true 5 4 3 2 1]
+
+joy? rest
+[5 4 3 2 1]
+
+joy? 999 to-bignum
+[5 4 3 2 1] [true 9 9 9]
+
+joy? rest
+[5 4 3 2 1] [9 9 9]
+
+joy? add-digits
+[4 4 3 3 1]
+
+joy? true swons
+[true 4 4 3 3 1]
+
+joy? from-bignum
+13344
+
+joy? 12345 999 +
+13344 13344
+
+

Neat!

+

add-bignums

+

There is one more thing we have to do to use this: we have to deal with the signs.

+
add-bignums [add-bignums.P] [add-bignums.THEN] [add-bignums.ELSE] ifte
+
+

To check are they the same sign?

+

With:

+
[xor [] [not] branch] inscribe
+[nxor xor not] inscribe
+
+

We have:

+
add-bignums.P == [first] ii nxor
+
+

If they are the same sign (both positive or both negative) we can +use uncons to keep one of the sign Boolean flags around and reuse +it at the end, and rest to discard the other, then add-digits +to add the digits, then cons that flag we saved onto the result +digits list:

+
add-bignums.THEN == [uncons] dip rest add-digits cons
+
+

If they are not both positive or both negative then we negate one of +them and subtract instead (adding unlikes is actually subtraction):

+
add-bignums.ELSE == neg-bignum sub-bignums
+
+

So here we go:

+
[same-sign [first] ii xor not] inscribe
+[add-like-bignums [uncons] dip rest add-digits cons] inscribe
+
+[add-bignums [same-sign] [add-like-bignums] [neg-bignum sub-bignums] ifte] inscribe
+
+

But we haven't implemented neg-bignum or sub-bignums yet...

+
[actd.R0.ELSE 0 swap uncons [add-with-carry] dip] inscribe
+[actd.R0 [null] [actd.R0.THEN] [actd.R0.ELSE] ifte] inscribe
+[actd.R0.THEN popd 1 false rolldown] inscribe
+[add-bignums [same-sign] [add-like-bignums] [neg-bignum sub-bignums] ifte] inscribe
+[add-carry-to-digits [pop not] [popd] [actd.R0] [i cons] genrec] inscribe
+[add-digit [popop base *] [rolldown * +] clop popdd] inscribe
+[add-digits false rollup add-digits′] inscribe
+[add-digits′ [[null] ii \/] [add-digits.THEN] [add-digits.R0] [i cons] genrec] inscribe
+[add-digits.R0 uncons-two [add-with-carry] dipd] inscribe
+[add-digits.THEN.ELSE ditch-empty-list add-carry-to-digits] inscribe
+[add-digits.THEN [[null] ii /\] [add-digits.THEN.THEN] [add-digits.THEN.ELSE] ifte] inscribe
+[add-digits.THEN.THEN pop swap [] [1 swons] branch] inscribe
+[add-like-bignums [uncons] dip rest add-digits cons] inscribe
+[add-with-carry.0 [bool-to-int] dipd + +] inscribe
+[add-with-carry.1 base [mod] [>=] clop] inscribe
+[add-with-carry add-with-carry.0 add-with-carry.1] inscribe
+[base 10] inscribe
+[bool-to-int [0] [1] branch] inscribe
+[digitalize [0 <=] [pop []] [get-digit] [i cons] genrec] inscribe
+[ditch-empty-list [null] [pop] [popd] ifte] inscribe
+[from-bignum [from-bignum′] [first] cleave [neg] [] branch] inscribe
+[from-bignum′ from-bignum′.prep [add-digit] step popd] inscribe
+[from-bignum′.prep rest 1 0 rolldown] inscribe
+[get-digit base moddiv] inscribe
+[moddiv divmod swap] inscribe
+[nxor xor not] inscribe
+[same-sign [first] ii xor not] inscribe
+[to-bignum [!-] [abs digitalize] cleave cons] inscribe
+[uncons-two [uncons] ii swapd] inscribe
+[xor [] [not] branch] inscribe
+
+

Subtraction of Like Signs sub-digits

+

Subtraction is similar to addition in that it's a simple recursive algorithm that works digit-by-digit. It has the same four cases as well, we can reuse P and P'.

initial-carry == false rollup
   sub-digits' == [P] [sub.THEN] [sub.R0] [sub.R1] genrec
    sub-digits == initial-carry add-digits'
-     sub.THEN == [P'] [sub.THEN'] [sub.ELSE] ifte
- -
-
-
-
-
-
-

Refactoring For The Win

We noted above that the algorithm for subtraction is similar to that for addition. Maybe we can reuse more than just P and P'? In fact, I think we could refactor (prematurely, two cases is one too few) something like this?

- + sub.THEN == [P'] [sub.THEN'] [sub.ELSE] ifte +
+

Refactoring For The Win

+

We noted above that the algorithm for subtraction is similar to that for addition. Maybe we can reuse more than just P and P'? In fact, I think we could refactor (prematurely, two cases is one too few) something like this?

             [sub.THEN'] [sub.ELSE] [sub.R0] [sub.R1] foo
 ---------------------------------------------------------------------
-   [P] [[P'] [sub.THEN'] [sub.ELSE] ifte] [sub.R0] [sub.R1] genrec
- -
-
-
-
-
-
+ [P] [[P'] [sub.THEN'] [sub.ELSE] ifte] [sub.R0] [sub.R1] genrec +

or just

-
             [THEN] [ELSE] [R0] [R1] foo
 ----------------------------------------------------
    [P] [[P'] [THEN] [ELSE] ifte] [R0] [R1] genrec
-
 

eh?

- -
-
-
-
-
-

foo is something like:

-
F == [ifte] ccons [P'] swons
 G == [F] dipdd
 
@@ -16726,44 +615,23 @@ G == [F] dipdd
 [THEN] [ELSE] F [R0] [R1] foo'
 [THEN] [ELSE] [ifte] ccons [P'] swons [R0] [R1] foo'
 [[THEN] [ELSE] ifte] [P'] swons [R0] [R1] foo'
-[[P'] [THEN] [ELSE] ifte] [R0] [R1] foo'
- -
-
-
-
-
-
+[[P'] [THEN] [ELSE] ifte] [R0] [R1] foo' +

That leaves [P]...

-
F == [ifte] ccons [P'] swons [P] swap
 G == [F] dipdd
 
 [THEN] [ELSE] [ifte] ccons [P'] swons [P] swap [R0] [R1] foo'
 [[THEN] [ELSE] ifte] [P'] swons [P] swap [R0] [R1] foo'
 [[P'] [THEN] [ELSE] ifte] [P] swap [R0] [R1] foo'
-[P] [[P'] [THEN] [ELSE] ifte] [R0] [R1] genrec
- -
-
-
-
-
-
+[P] [[P'] [THEN] [ELSE] ifte] [R0] [R1] genrec +

Ergo:

-
  F == [ifte] ccons [P'] swons [P] swap
 foo == [F] dipdd genrec
-combine-two-lists == [i cons] foo
- -
-
-
-
-
-
+combine-two-lists == [i cons] foo +

-and-

-
add-digits' == [one-empty-list]
                [both-empty]
                [both-full]
@@ -16772,76 +640,32 @@ combine-two-lists == [i cons] foo
one-empty-list == ditch-empty-list add-carry-to-digits both-empty == pop swap carry both-full == uncons-two [add-with-carry] dipd -

This illustrates how refactoring creates denser yet more readable code.

- -
-
-
-
-
-

But this doesn't go quite far enough, I think.

- -
R0 == uncons-two [add-with-carry] dipd
- -
-
-
-
-
-
+
R0 == uncons-two [add-with-carry] dipd
+

I think R0 will pretty much always do:

- -
uncons-two [combine-two-values] dipd
- -
-
-
-
-
-
+
uncons-two [combine-two-values] dipd
+

And so it should be refactored further to something like:

-
         [F] R0
 -------------------------
-   uncons-two [F] dipd
- -
-
-
-
-
-
+ uncons-two [F] dipd +

And then add-digits' becomes just:

-
add-digits' == [one-empty-list]
                [both-empty]
                [add-with-carry]
-               combine-two-lists
- -
-
-
-
-
-
+ combine-two-lists +

If we factor ditch-empty-list out of one-empty-list, and pop from both-empty:

-
add-digits' == [add-carry-to-digits]
                [swap carry]
                [add-with-carry]
-               combine-two-lists
- -
-
-
-
-
-
+ combine-two-lists +

Let's figure out the new form.

-
   [ONE-EMPTY] [BOTH-EMPTY] [COMBINE-VALUES] foo
 ---------------------------------------------------
    [P]
@@ -16853,290 +677,68 @@ both-full == uncons-two [add-with-carry] dipd
    ]
    [uncons-two [COMBINE-VALUES] dipd]
    [i cons] genrec
-
 

eh?

- -
-
-
-
-
-

Let's not over think it.

-
   [ONE-EMPTY] [ditch-empty-list] swoncat [BOTH-EMPTY] [pop] swoncat [COMBINE-VALUES] 
-   [ditch-empty-list ONE-EMPTY] [pop BOTH-EMPTY] [COMBINE-VALUES]
- -
-
-
-
-
-
+ [ditch-empty-list ONE-EMPTY] [pop BOTH-EMPTY] [COMBINE-VALUES] +

With:

-
   [C] [A] [B] sandwich
 --------------------------
-        [A [C] B]
- -
-
-
-
-
-
In [94]:
-
-
-
[sandwich swap [cons] dip swoncat] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [95]:
-
-
-
clear [B] [A] [C]
-
- -
-
-
- -
-
- - -
- -
- - -
-
[B] [A] [C]
-
-
- -
-
- -
-
-
-
In [96]:
-
-
-
sandwich
-
- -
-
-
- -
-
- - -
- -
- - -
-
[A [B] C]
-
-
- -
-
- -
-
-
-
-

So to get from

- + [A [C] B] + +

Joy +[sandwich swap [cons] dip swoncat] inscribe

+

Joy +clear [B] [A] [C]

+
[B] [A] [C]
+
+

Joy +sandwich

+
[A [B] C]
+
+

So to get from

[A] [B] [C]
-
 

to:

-
[ditch-empty-list A] [pop B] [uncons-two [C] dipd]
-
 

we use:

-
[[[ditch-empty-list] swoncat] dip [pop] swoncat] dip [uncons-two] [dipd] sandwich
-
 

It's gnarly, but simple:

- -
-
-
-
-
-
In [97]:
-
-
-
clear
+

```Joy +clear [_foo0.0 [[ditch-empty-list] swoncat] dip] inscribe [_foo0.1 [pop] swoncat] inscribe [_foo0.3 [_foo0.0 _foo0.1] dip] inscribe [_foo0.4 [uncons-two] [dipd] sandwich] inscribe -[_foo0 _foo0.3 _foo0.4] inscribe - -[_foo1 [ +[_foo0 _foo0.3 _foo0.4] inscribe

+

[_foo1 [ [ifte] ccons - [P'] swons + [P'] swons [P] swap ] dip ] inscribe -

- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [98]:
-
-
-
[A] [B] [C] _foo0
-
- -
-
-
- -
-
- - -
- -
- - -
-
[ditch-empty-list A] [pop B] [uncons-two [C] dipd]
-
-
- -
-
- -
-
-
-
In [99]:
-
-
-
_foo1
-
- -
-
-
- -
-
- - -
- -
- - -
-
[P] [[P'] [ditch-empty-list A] [pop B] ifte] [uncons-two [C] dipd]
-
-
- -
-
- -
-
-
-
In [100]:
-
-
-
clear
+```

+

Joy +[A] [B] [C] _foo0

+
[ditch-empty-list A] [pop B] [uncons-two [C] dipd]
+
+

Joy +_foo1

+
[P] [[P'] [ditch-empty-list A] [pop B] ifte] [uncons-two [C] dipd]
+
+

Joy +clear [add-carry-to-digits] [swap carry] [add-with-carry] -_foo0 _foo1 -

- -
-
-
- -
-
- - -
- -
- - -
-
[P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd]
-
-
- -
-
- -
-
-
-
+_foo0 _foo1

+
[P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd]
+

Compare the above with what we wanted:

-
[P]
 [
    [P']
@@ -17145,1033 +747,167 @@ _foo0 _foo1
    ifte
 ]
 [uncons-two [COMBINE-VALUES] dipd]
-
 

Allwe need to do is add:

- -
[i cons] genrec
- -
-
-
-
-
-
In [101]:
-
-
-
clear
-
-[3 2 1] [6 5 4] initial-carry
-
-[add-carry-to-digits]
+
[i cons] genrec
+
+

```Joy +clear

+

[3 2 1] [6 5 4] initial-carry

+

[add-carry-to-digits] [swap carry] [add-with-carry] _foo0 _foo1 -

- -
-
-
- -
-
- - -
- -
- - -
-
false [3 2 1] [6 5 4] [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd]
-
-
- -
-
- -
-
-
-
In [102]:
-
-
-
[i cons] genrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
[9 7 5]
-
-
- -
-
- -
-
-
-
In [103]:
-
-
-
clear
+```

+
false [3 2 1] [6 5 4] [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd]
+
+

Joy +[i cons] genrec

+
[9 7 5]
+
+

Joy +clear [build-two-list-combiner _foo0 _foo1 [i cons]] inscribe -[combine-two-lists [add-carry-to-digits] [swap carry] [add-with-carry] build-two-list-combiner] inscribe -

- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [104]:
-
-
-
clear
-
-[3 2 1] [6 5 4] initial-carry
+[combine-two-lists [add-carry-to-digits] [swap carry] [add-with-carry] build-two-list-combiner] inscribe

+

```Joy +clear

+

[3 2 1] [6 5 4] initial-carry combine-two-lists -

- -
-
-
- -
-
- - -
- -
- - -
-
false [3 2 1] [6 5 4] [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] [i cons]
-
-
- -
-
- -
-
-
-
In [105]:
-
-
-
genrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
[9 7 5]
-
-
- -
-
- -
-
-
-
In [106]:
-
-
-
[base 10] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-
[9 7 5]
-
-
- -
-
- -
-
-
-
In [107]:
-
-
-
clear
-
-123456 to-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 6 5 4 3 2 1]
-
-
- -
-
- -
-
-
-
In [108]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
+```

+
false [3 2 1] [6 5 4] [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] [i cons]
+
+

Joy +genrec

+
[9 7 5]
+
+

Joy +[base 10] inscribe

+
[9 7 5]
+
+

```Joy +clear

+

123456 to-bignum

+

```

+
[true 6 5 4 3 2 1]
+
+

Joy +clear

So that's nice.

In order to avoid the overhead of rebuilding the whole thing each time we could pre-compute the function and store it in the dictionary.

- -
-
-
-
-
-
In [109]:
-
-
-
[add-carry-to-digits]
+

Joy +[add-carry-to-digits] [swap carry] [add-with-carry] -build-two-list-combiner -

- -
-
-
- -
-
- - -
- -
- - -
-
[P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] [i cons]
-
-
- -
-
- -
-
-
-
+build-two-list-combiner

+
[P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] [i cons]
+

Now grab the definition, add the genrec and symbol (name) and inscribe it:

- -
-
-
-
-
-
In [110]:
-
-
-
[genrec] ccons ccons [add-digits'] swoncat
-
- -
-
-
- -
-
- - -
- -
- - -
-
[add-digits' [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] [i cons] genrec]
-
-
- -
-
- -
-
-
-
In [111]:
-
-
-
 inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
+

Joy +[genrec] ccons ccons [add-digits'] swoncat

+
[add-digits' [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] [i cons] genrec]
+
+

Joy + inscribe

Try it out...

- -
-
-
-
-
-
In [112]:
-
-
-
false [3 2 1] [4 3 2] add-digits'
-
- -
-
-
- -
-
- - -
- -
- - -
-
[7 5 3]
-
-
- -
-
- -
-
-
-
In [113]:
-
-
-
false swap base -- unit
-
- -
-
-
- -
-
- - -
- -
- - -
-
false [7 5 3] [9]
-
-
- -
-
- -
-
-
-
In [114]:
-
-
-
add-digits'
-
- -
-
-
- -
-
- - -
- -
- - -
-
[6 6 3]
-
-
- -
-
- -
-
-
-
In [115]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Demonstrate add-bigints

-
-
-
-
-
-
In [116]:
-
-
-
1234 999 [to-bigint] ii 
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 4 3 2 1] [true 9 9 9]
-
-
- -
-
- -
-
-
-
In [117]:
-
-
-
add-bigints
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 3 3 2 2]
-
-
- -
-
- -
-
-
-
In [118]:
-
-
-
from-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
2233
-
-
- -
-
- -
-
-
-
In [119]:
-
-
-
1234 999 +
-
- -
-
-
- -
-
- - -
- -
- - -
-
2233 2233
-
-
- -
-
- -
-
-
-
In [120]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Subtracting

Okay, we're almost ready to implement subtraction, but there's a wrinkle! When we subtract a smaller (absolute) value from a larger (absolute) value there's no problem:

- +

Joy +false [3 2 1] [4 3 2] add-digits'

+
[7 5 3]
+
+

Joy +false swap base -- unit

+
false [7 5 3] [9]
+
+

Joy +add-digits'

+
[6 6 3]
+
+

Joy +clear

+

Demonstrate add-bignums

+

Joy +1234 999 [to-bignum] ii

+
[true 4 3 2 1] [true 9 9 9]
+
+

Joy +add-bignums

+
[true 3 3 2 2]
+
+

Joy +from-bignum

+
2233
+
+

Joy +1234 999 +

+
2233 2233
+
+

Joy +clear

+

Subtracting

+

Okay, we're almost ready to implement subtraction, but there's a wrinkle! When we subtract a smaller (absolute) value from a larger (absolute) value there's no problem:

10 - 5 = 5
-
 

But I don't know the algorithm to subtract a larger number from a smaller one:

-
5 - 10 = ???
-
 

The answer is -5, of course, but what's the algorithm? How to make the computer figure that out? We make use of the simple algebraic identity:

-
a - b = -(b - a)
-
 

So if we want to subtract a larger number a from a smaller one b we can instead subtract the smaller from the larger and invert the sign:

-
5 - 10 = -(10 - 5)
-
 

To do this we need a function gt-digits that will tell us which of two digit lists represents the larger integer.

- -
-
-
-
-
-
-

gt-digits

-
-
-
-
-
-
+

gt-digits

I just realized I don't have a list length function yet!

- -
-
-
-
-
-
In [121]:
-
-
-
[length [pop ++] step_zero] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [122]:
-
-
-
clear
-[] length
-
- -
-
-
- -
-
- - -
- -
- - -
-
0
-
-
- -
-
- -
-
-
-
In [123]:
-
-
-
clear
-[this is a list] length
-
- -
-
-
- -
-
- - -
- -
- - -
-
4
-
-
- -
-
- -
-
-
-
In [124]:
-
-
-
clear
-[1 2 3] [4 5] over over [length] app2
-
- -
-
-
- -
-
- - -
- -
- - -
-
[1 2 3] [4 5] 3 2
-
-
- -
-
- -
-
-
-
In [125]:
-
-
-
[swap][6][7]cmp
-
- -
-
-
- -
-
- - -
- -
- - -
-
[4 5] [1 2 3]
-
-
- -
-
- -
-
-
-
+

Joy +[length [pop ++] step_zero] inscribe

+

Joy +clear +[] length

+
0
+
+

Joy +clear +[this is a list] length

+
4
+
+

Joy +clear +[1 2 3] [4 5] over over [length] app2

+
[1 2 3] [4 5] 3 2
+
+

Joy +[swap][6][7]cmp

+
[4 5] [1 2 3]
+

what about a function that iterates through two lists until one or the other ends, or they end at the same time (same length) and we walk back through comparing the digits?

- -
-
-
-
-
-
In [126]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [127]:
-
-
-
[1 2 3] [4 5 6] [bool] ii &
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [128]:
-
-
-
clear
+

Joy +clear

+

Joy +[1 2 3] [4 5 6] [bool] ii &

+
true
+
+

Joy +clear [1 2 3] [4 5 6] [[bool] ii | not] [pop] [uncons-two] [i [unit cons] dip cons] -genrec -

- -
-
-
- -
-
- - -
- -
- - -
-
[[1 4] [2 5] [3 6]]
-
-
- -
-
- -
-
-
-
In [129]:
-
-
-
clear
+genrec

+
[[1 4] [2 5] [3 6]]
+
+

Joy +clear [1 2 3] [4 5 6] [[bool] ii | not] [pop] [uncons-two] [i [unit cons] dip cons] -genrec -

- -
-
-
- -
-
- - -
- -
- - -
-
[[1 4] [2 5] [3 6]]
-
-
- -
-
- -
-
-
-
In [130]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
+genrec

+
[[1 4] [2 5] [3 6]]
+
+

Joy +clear

So I guess that's zip?

But we want something a little different.

It's a weird function: compare lengths, if they are the same length then compare contents pairwise from the end.

@@ -18181,259 +917,56 @@ genrec

if both lists are empty we start comparing uncons'd pairs until we find an un-equal pair or run out of pairs.

if we run out of pairs before we find an unequal pair then the function returns true (the numbers are identical, we should try to shortcut the actual subtraction here, but let's just get it working first, eh?)

if we find an unequal pair we return a>b and discard the rest of the pairs. Or maybe this all happens in some sort of infra first situation?

- -
-
-
-
-
-

So the predicate will be [bool] ii & not, if one list is longer than the other we are done. We postulate a third list to contain the pairs:

-
[] [3 2 1] [4 5 6] [P] [BASE] [R0] [R1] genrec
-
 

The recursive branch seems simpler to figure out:

-
[] [3 2 1] [4 5 6] R0 [F] R1
 
 uncons-two [unit cons swons] dipd [F] i
 
-[] [3 2 1] [4 5 6] [P] [BASE] [uncons-two [unit cons swons] dipd] tailrec
- -
-
-
-
-
-
In [131]:
-
-
-
 [xR1 uncons-two [unit cons swons] dipd] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [132]:
-
-
-
clear
-
-[] [3 2 1] [4 5 6]
-
- -
-
-
- -
-
- - -
- -
- - -
-
[] [3 2 1] [4 5 6]
-
-
- -
-
- -
-
-
-
In [133]:
-
-
-
xR1 xR1 xR1
-
- -
-
-
- -
-
- - -
- -
- - -
-
[[1 6] [2 5] [3 4]] [] []
-
-
- -
-
- -
-
-
-
In [134]:
-
-
-
clear
-[xP [bool] ii & not] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [135]:
-
-
-
clear
-
-[] [3 2 1] [5 4] [xP] [] [xR1] tailrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
[[2 4] [3 5]] [1] []
-
-
- -
-
- -
-
-
-
In [136]:
-
-
-
clear
-
-[] [3 2] [4 5 1] [xP] [] [xR1] tailrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
[[2 5] [3 4]] [] [1]
-
-
- -
-
- -
-
-
-
In [137]:
-
-
-
clear
-
-[] [3 2 1] [5 4 3] [xP] [] [xR1] tailrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
[[1 3] [2 4] [3 5]] [] []
-
-
- -
-
- -
-
-
-
+[] [3 2 1] [4 5 6] [P] [BASE] [uncons-two [unit cons swons] dipd] tailrec + +

Joy + [xR1 uncons-two [unit cons swons] dipd] inscribe

+

```Joy +clear

+

[] [3 2 1] [4 5 6] +```

+
[] [3 2 1] [4 5 6]
+
+

Joy +xR1 xR1 xR1

+
[[1 6] [2 5] [3 4]] [] []
+
+

Joy +clear +[xP [bool] ii & not] inscribe

+

```Joy +clear

+

[] [3 2 1] [5 4] [xP] [] [xR1] tailrec +```

+
[[2 4] [3 5]] [1] []
+
+

```Joy +clear

+

[] [3 2] [4 5 1] [xP] [] [xR1] tailrec +```

+
[[2 5] [3 4]] [] [1]
+
+

```Joy +clear

+

[] [3 2 1] [5 4 3] [xP] [] [xR1] tailrec +```

+
[[1 3] [2 4] [3 5]] [] []
+

Now comes the tricky part, that base case:

we have three lists. The first is a possibly-empty list of pairs to compare.

The second two are the tails of the original lists.

If the top list is non-empty then the second list must be empty so the whole function should return true

If the top list is empty and the second list isn't then the whole function should return false

If both lists are empty we start comparing uncons'd pairs until we find an un-equal pair or run out of pairs.

-
[bool]  # if the first list is non-empty
 [popop pop true]
 [
@@ -18446,20 +979,12 @@ uncons-two [unit cons swons] dipd [F] i
     ]
     ifte
 ]
-ifte
- -
-
-
-
-
-
In [138]:
-
-
-
clear
-[][][1]
-
-[bool]
+ifte
+
+

```Joy +clear +[][][1]

+

[bool] [popop pop true] [ [pop bool] @@ -18468,39 +993,13 @@ ifte ifte ] ifte -

- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [139]:
-
-
-
clear
-[][1][]
-
-[bool]
+```

+
true
+
+

```Joy +clear +[][1][]

+

[bool] [popop pop true] [ [pop bool] @@ -18509,39 +1008,13 @@ ifte ifte ] ifte -

- -
-
-
- -
-
- - -
- -
- - -
-
false
-
-
- -
-
- -
-
-
-
In [140]:
-
-
-
clear
-[1][][]
-
-[bool]
+```

+
false
+
+

```Joy +clear +[1][][]

+

[bool] [popop pop true] [ [pop bool] @@ -18550,139 +1023,42 @@ ifte ifte ] ifte -

- -
-
-
- -
-
- - -
- -
- - -
-
[23 1]
-
-
- -
-
- -
-
-
-
-

compare-pairs

This should be a pretty simple recursive function

- +```

+
[23 1]
+
+

compare-pairs

+

This should be a pretty simple recursive function

[P] [THEN] [R0] [R1] genrec
-
 

If the list is empty we return false

-
P == bool not
 THEN == pop false
-
 

On the recursive branch we have an ifte expression:

-
            pairs R0 [compare-pairs] R1
 ---------------------------------------------------
    pairs [P.rec] [THEN.rec] [compare-pairs] ifte
-
 

We must compare the pair from the top of the list:

+
P.rec == first [>] infrst
+
+

```Joy +clear

+

[[1 3] [2 4] [3 5]] first [>] infrst +```

+
true
+
+

```Joy +clear

+

[[1 3] [2 4] [3 5]] [[>] infrst] map +```

+
[true true true]
 
-
P.rec == first [>] infrst
- -
-
-
-
-
-
In [141]:
-
-
-
clear
-
-[[1 3] [2 4] [3 5]] first [>] infrst
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [142]:
-
-
-
clear
-
-[[1 3] [2 4] [3 5]] [[>] infrst] map
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true true true]
-
-
- -
-
- -
-
-
-
- -
THEN.rec == pop true
- -
-
-
-
-
-
In [143]:
-
-
-
clear
-
-[compare-pairs
+THEN.rec == pop true
+
+

```Joy +clear

+

[compare-pairs [bool not] [pop false] [ @@ -18692,106 +1068,19 @@ THEN == pop false [ifte] genrec ] inscribe -

- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [144]:
-
-
-
clear [[1 3] [2 4] [3 5]] compare-pairs
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [145]:
-
-
-
clear [[1 3] [3 3] [3 5]] compare-pairs
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
+```

+

Joy +clear [[1 3] [2 4] [3 5]] compare-pairs

+
true
+
+

Joy +clear [[1 3] [3 3] [3 5]] compare-pairs

+
true
+

Whoops! I forgot to remove the already-checked pair from the list of pairs! (Later on I discover that the logic is inverted here: >= not < d'oh!)

- -
-
-
-
-
-
In [146]:
-
-
-
clear
-
-[compare-pairs
+

```Joy +clear

+

[compare-pairs [bool not] [pop false] [ @@ -18801,270 +1090,40 @@ THEN == pop false [[rest] swoncat ifte] genrec ] inscribe -

- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
+```

This is clunky and inefficient but it works.

- -
-
-
-
-
-
In [147]:
-
-
-
clear [[1 0] [2 2] [3 3]] compare-pairs
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [148]:
-
-
-
clear [[1 1] [2 2] [3 3]] compare-pairs
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [149]:
-
-
-
clear [[1 2] [2 2] [3 3]] compare-pairs
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [150]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [151]:
-
-
-
clear [[1 1] [2 1] [3 3]] compare-pairs
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [152]:
-
-
-
clear [[1 1] [2 2] [3 3]] compare-pairs
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [153]:
-
-
-
clear [[1 1] [2 3] [3 3]] compare-pairs
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [ ]:
-
-
-
 
-
- -
-
-
- -
-
-
-
In [154]:
-
-
-
clear
-[[1 1] [2 1] [3 3]] [] []
-
-[bool]
+

Joy +clear [[1 0] [2 2] [3 3]] compare-pairs

+
true
+
+

Joy +clear [[1 1] [2 2] [3 3]] compare-pairs

+
true
+
+

Joy +clear [[1 2] [2 2] [3 3]] compare-pairs

+
true
+
+

Joy +clear

+

Joy +clear [[1 1] [2 1] [3 3]] compare-pairs

+
true
+
+

Joy +clear [[1 1] [2 2] [3 3]] compare-pairs

+
true
+
+

Joy +clear [[1 1] [2 3] [3 3]] compare-pairs

+
true
+
+

```Joy

+

```

+

```Joy +clear +[[1 1] [2 1] [3 3]] [] []

+

[bool] [popop pop true] [ [pop bool] @@ -19073,36 +1132,11 @@ THEN == pop false ifte ] ifte -

- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [155]:
-
-
-
[BASE
+```

+
true
+
+

Joy +[BASE [bool] [popop pop true] [ @@ -19112,632 +1146,107 @@ ifte ifte ] ifte -] inscribe -

- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [156]:
-
-
-
clear
-
-[] [3 2 1] [4 5 6]
-
- -
-
-
- -
-
- - -
- -
- - -
-
[] [3 2 1] [4 5 6]
-
-
- -
-
- -
-
-
-
In [157]:
-
-
-
[xP] [BASE] [xR1] tailrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [158]:
-
-
-
clear
-
-[] [3 2 1] [4 5 6] swap
-
- -
-
-
- -
-
- - -
- -
- - -
-
[] [4 5 6] [3 2 1]
-
-
- -
-
- -
-
-
-
In [159]:
-
-
-
[xP] [BASE] [xR1] tailrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
false
-
-
- -
-
- -
-
-
-
In [160]:
-
-
-
clear
-
-[] [3 2 1] dup
-
- -
-
-
- -
-
- - -
- -
- - -
-
[] [3 2 1] [3 2 1]
-
-
- -
-
- -
-
-
-
In [161]:
-
-
-
[xP] [BASE] [xR1] tailrec
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [162]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [163]:
-
-
-
[gt-bigint <<{} [xP] [BASE] [xR1] tailrec] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [164]:
-
-
-
clear [3 2 1] [4 5 6] gt-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [165]:
-
-
-
clear [3 2 1] [4 5 6] swap gt-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
false
-
-
- -
-
- -
-
-
-
In [166]:
-
-
-
clear [3 2 1] dup gt-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
true
-
-
- -
-
- -
-
-
-
In [ ]:
-
-
-
 
-
- -
-
-
- -
-
-
-
In [167]:
-
-
-
clear [3 2 1] [4 5 6] [gt-bigint] [swap] [] ifte
-
- -
-
-
- -
-
- - -
- -
- - -
-
[4 5 6] [3 2 1]
-
-
- -
-
- -
-
-
-
In [168]:
-
-
-
clear [4 5 6] [3 2 1] [gt-bigint] [swap] [] ifte
-
- -
-
-
- -
-
- - -
- -
- - -
-
[4 5 6] [3 2 1]
-
-
- -
-
- -
-
-
-
+] inscribe

+
true
+
+

```Joy +clear

+

[] [3 2 1] [4 5 6] +```

+
[] [3 2 1] [4 5 6]
+
+

Joy +[xP] [BASE] [xR1] tailrec

+
true
+
+

```Joy +clear

+

[] [3 2 1] [4 5 6] swap +```

+
[] [4 5 6] [3 2 1]
+
+

Joy +[xP] [BASE] [xR1] tailrec

+
false
+
+

```Joy +clear

+

[] [3 2 1] dup +```

+
[] [3 2 1] [3 2 1]
+
+

Joy +[xP] [BASE] [xR1] tailrec

+
true
+
+

Joy +clear

+

Joy +[gt-bignum <<{} [xP] [BASE] [xR1] tailrec] inscribe

+

Joy +clear [3 2 1] [4 5 6] gt-bignum

+
true
+
+

Joy +clear [3 2 1] [4 5 6] swap gt-bignum

+
false
+
+

Joy +clear [3 2 1] dup gt-bignum

+
true
+
+

```Joy

+

```

+

Joy +clear [3 2 1] [4 5 6] [gt-bignum] [swap] [] ifte

+
[4 5 6] [3 2 1]
+
+

Joy +clear [4 5 6] [3 2 1] [gt-bignum] [swap] [] ifte

+
[4 5 6] [3 2 1]
+

And so it goes.

Now we can subtract, we just have to remember to invert the sign bit if we swap the digit lists.

Maybe something like:

- -
check-gt == [gt-bigint] [swap true rollup] [false rollup] ifte
-
+
check-gt == [gt-bignum] [swap true rollup] [false rollup] ifte
 

To keep the decision around as a Boolean flag? We can xor it with the sign bit?

+

Joy +clear +[check-gt [gt-bignum] [swap [not] dipd] [] ifte] inscribe

+

Joy +false [4 5 6] [3 2 1]

+
false [4 5 6] [3 2 1]
+
+

Joy +check-gt

+
false [4 5 6] [3 2 1]
+
+

Joy +clear

+

Subtraction, at last...

+

So now that we can compare digit lists to see if one is larger than the other we can subtract (inverting the sign if necessary) much like we did addition:

+
sub-bignums == [same-sign] [sub-like-bignums] [1 0 /] ifte
 
-
-
-
-
-
-
In [169]:
-
-
-
clear
-[check-gt [gt-bigint] [swap [not] dipd] [] ifte] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [170]:
-
-
-
false [4 5 6] [3 2 1]
-
- -
-
-
- -
-
- - -
- -
- - -
-
false [4 5 6] [3 2 1]
-
-
- -
-
- -
-
-
-
In [171]:
-
-
-
check-gt
-
- -
-
-
- -
-
- - -
- -
- - -
-
false [4 5 6] [3 2 1]
-
-
- -
-
- -
-
-
-
In [172]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Subtraction, at last...

So now that we can compare digit lists to see if one is larger than the other we can subtract (inverting the sign if necessary) much like we did addition:

- -
sub-bigints == [same-sign] [sub-like-bigints] [1 0 /] ifte
-
-sub-like-bigints == [uncons] dip rest   sub-digits cons
+sub-like-bignums == [uncons] dip rest   sub-digits cons
                                       ^
                                       |
-
 

At this point we would have the sign bit then the two digit lists.

- -
sign [c b a] [z y x]
- -
-
-
-
-
-
+
sign [c b a] [z y x]
+

We want to use check-gt here:

-
sign [c b a] [z y x] check-gt
-sign swapped? [c b a] [z y x] check-gt
- -
-
-
-
-
-
+sign swapped? [c b a] [z y x] check-gt +

It seems we should just flip the sign bit if we swap, eh?

- -
check-gt == [gt-bigint] [swap [not] dipd] [] ifte
- -
-
-
-
-
-
+
check-gt == [gt-bignum] [swap [not] dipd] [] ifte
+

Now we subtract the digits:

- -
sign [c b a] [z y x] sub-digits cons
- -
-
-
-
-
-
+
sign [c b a] [z y x] sub-digits cons
+

So:

- -
sub-like-bigints == [uncons] dip rest check-gt sub-digits cons
+
sub-like-bignums == [uncons] dip rest check-gt sub-digits cons
 
 sub-digits == initial-carry sub-digits'
 
@@ -19747,25 +1256,10 @@ sub-digits' ==
     [sub-with-carry]
     build-two-list-combiner
     genrec
-
 

We just need to define the pieces.

- -
-
-
-
-
-
-

sub-with-carry

We know we will never be subtracting a larger (absolute) number from a smaller (absolute) number (they might be equal) so the carry flag will never be true at the end of a digit list subtraction.

- -
-
-
-
-
-
- +

sub-with-carry

+

We know we will never be subtracting a larger (absolute) number from a smaller (absolute) number (they might be equal) so the carry flag will never be true at the end of a digit list subtraction.

   carry a b sub-with-carry
 ------------------------------
      (a-b-carry)  new-carry
@@ -19773,1007 +1267,176 @@ sub-digits' ==
 _sub-with-carry0 ≡ [bool-to-int] dipd - -
 _sub-with-carry1 ≡ [base + base mod] [0 <] clop
 
-sub-with-carry ≡ _sub-with-carry0 _sub-with-carry1
- -
-
-
-
-
-
In [173]:
-
-
-
[_sub-with-carry0 rolldown bool-to-int [-] ii] inscribe
+sub-with-carry ≡ _sub-with-carry0 _sub-with-carry1
+
+

Joy +[_sub-with-carry0 rolldown bool-to-int [-] ii] inscribe [_sub-with-carry1 [base + base mod] [0 <] cleave] inscribe -[sub-with-carry _sub-with-carry0 _sub-with-carry1] inscribe -

- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [174]:
-
-
-
clear false 3 base --
-
- -
-
-
- -
-
- - -
- -
- - -
-
false 3 9
-
-
- -
-
- -
-
-
-
In [175]:
-
-
-
sub-with-carry
-
- -
-
-
- -
-
- - -
- -
- - -
-
4 true
-
-
- -
-
- -
-
-
-
In [176]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

sub-carry-from-digits

Should be easy to make modeled on add-carry-to-digits, another very simple recursive function. The predicate, base case, and R1 are the same:

- +[sub-with-carry _sub-with-carry0 _sub-with-carry1] inscribe

+

Joy +clear false 3 base --

+
false 3 9
+
+

Joy +sub-with-carry

+
4 true
+
+

Joy +clear

+

sub-carry-from-digits

+

Should be easy to make modeled on add-carry-to-digits, another very simple recursive function. The predicate, base case, and R1 are the same:

carry [n ...] sub-carry-from-digits
-carry [n ...] [pop not] [popd] [_scfd_R0] [i cons] genrec
- -
-
-
-
-
-
+carry [n ...] [pop not] [popd] [_scfd_R0] [i cons] genrec +

That leaves the recursive branch:

-
true [n ...] _scfd_R0 [sub-carry-from-digits] i cons
-
 

-or-

-
true [] _scfd_R0 [sub-carry-from-digits] i cons
-
 

Except that this should should never happen when subtracting, because we already made sure that we're only ever subtracting a number less than or equal to the, uh, number we are subtracting from (TODO rewrite this trainwreck of a sentence).

-
         true [a ...] _scfd_R0 [sub-carry-from-digits] i cons
 ----------------------------------------------------------------
  true 0 a add-with-carry [...] [sub-carry-from-digits] i cons
 ------------------------------------------------------------------
-             (a+1) carry [...] [sub-carry-from-digits] i cons
+ (a+1) carry [...] [sub-carry-from-digits] i cons -
-
-
-
-
-
-
true [a ...] _scfd_R0
+true [a ...] _scfd_R0
 true [a ...] 0 swap uncons [sub-with-carry] dip
 true 0 [a ...] uncons [sub-with-carry] dip
 true 0 a [...] [sub-with-carry] dip
 true 0 a sub-with-carry [...]
 
-_scfd_R0 == 0 swap uncons [sub-with-carry] dip
- -
-
-
-
-
-
+_scfd_R0 == 0 swap uncons [sub-with-carry] dip +

But there's a problem! This winds up subtracting a from 0 rather than the other way around:

- -
_scfd_R0 == uncons 0 swap [sub-with-carry] dip
- -
-
-
-
-
-
In [177]:
-
-
-
[sub-carry-from-digits
+
_scfd_R0 == uncons 0 swap [sub-with-carry] dip
+
+

Joy +[sub-carry-from-digits [pop not] [popd] [_scfd_R0] [i cons] genrec ] inscribe -[_scfd_R0 uncons 0 swap [sub-with-carry] dip] inscribe -

- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
+[_scfd_R0 uncons 0 swap [sub-with-carry] dip] inscribe

Try it out:

- -
-
-
-
-
-
In [178]:
-
-
-
clear
-
-false [3 2 1] sub-carry-from-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[3 2 1]
-
-
- -
-
- -
-
-
-
In [179]:
-
-
-
clear
-
-true [0 1] sub-carry-from-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[9 0]
-
-
- -
-
- -
-
-
-
In [180]:
-
-
-
clear
-
-true [3 2 1] sub-carry-from-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[2 2 1]
-
-
- -
-
- -
-
-
-
In [181]:
-
-
-
clear
-
-true [0 0 1] sub-carry-from-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[9 9 0]
-
-
- -
-
- -
-
-
-
In [182]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
+

```Joy +clear

+

false [3 2 1] sub-carry-from-digits +```

+
[3 2 1]
+
+

```Joy +clear

+

true [0 1] sub-carry-from-digits +```

+
[9 0]
+
+

```Joy +clear

+

true [3 2 1] sub-carry-from-digits +```

+
[2 2 1]
+
+

```Joy +clear

+

true [0 0 1] sub-carry-from-digits +```

+
[9 9 0]
+
+

Joy +clear

But what about those leading zeroes?

We could use a version of cons that refuses to put 0 onto an empty list?

- -
cons-but-not-leading-zeroes == [[bool] ii | not] [popd] [cons] ifte
- -
-
-
-
-
-
In [183]:
-
-
-
[cons-but-not-leading-zeroes [[bool] ii | not] [popd] [cons] ifte] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [184]:
-
-
-
[sub-carry-from-digits
+
cons-but-not-leading-zeroes == [[bool] ii | not] [popd] [cons] ifte
+
+

Joy +[cons-but-not-leading-zeroes [[bool] ii | not] [popd] [cons] ifte] inscribe

+

Joy +[sub-carry-from-digits [pop not] [popd] [_scfd_R0] [i cons-but-not-leading-zeroes] genrec -] inscribe -

- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [185]:
-
-
-
[_scfd_R0 uncons 0 swap [sub-with-carry] dip] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [186]:
-
-
-
clear
-
-true [0 0 1] sub-carry-from-digits
-
- -
-
-
- -
-
- - -
- -
- - -
-
[9 9]
-
-
- -
-
- -
-
-
-
In [187]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

sub-carry

-
sub-carry == pop
- -
-
-
-
-
-
In [188]:
-
-
-
[sub-like-bigints [uncons] dip rest check-gt sub-digits cons] inscribe
-[sub-digits initial-carry sub-digits'] inscribe
-[sub-digits'
+] inscribe

+

Joy +[_scfd_R0 uncons 0 swap [sub-with-carry] dip] inscribe

+

```Joy +clear

+

true [0 0 1] sub-carry-from-digits +```

+
[9 9]
+
+

Joy +clear

+

sub-carry

+
sub-carry == pop
+
+

Joy +[sub-like-bignums [uncons] dip rest check-gt sub-digits cons] inscribe +[sub-digits initial-carry sub-digits'] inscribe +[sub-digits' [sub-carry-from-digits] [swap pop] [sub-with-carry] build-two-list-combiner genrec -] inscribe -

- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [189]:
-
-
-
clear
-true [3 2 1] [6 5 4]
-
- -
-
-
- -
-
- - -
- -
- - -
-
true [3 2 1] [6 5 4]
-
-
- -
-
- -
-
-
-
In [190]:
-
-
-
check-gt initial-carry
-
- -
-
-
- -
-
- - -
- -
- - -
-
false false [6 5 4] [3 2 1]
-
-
- -
-
- -
-
-
-
In [191]:
-
-
-
sub-digits'
-
- -
-
-
- -
-
- - -
- -
- - -
-
false [3 3 3]
-
-
- -
-
- -
-
-
-
In [192]:
-
-
-
clear
-12345 to-bigint 109 to-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 5 4 3 2 1] [true 9 0 1]
-
-
- -
-
- -
-
-
-
In [193]:
-
-
-
sub-like-bigints
-
- -
-
-
- -
-
- - -
- -
- - -
-
[true 6 3 2 2 1]
-
-
- -
-
- -
-
-
-
In [194]:
-
-
-
from-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
12236
-
-
- -
-
- -
-
-
-
In [195]:
-
-
-
clear
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

neg-bigint

-
-
-
-
-
-
In [196]:
-
-
-
[neg-bigint [not] infra] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
In [197]:
-
-
-
123 
-
- -
-
-
- -
-
- - -
- -
- - -
-
123
-
-
- -
-
- -
-
-
-
In [198]:
-
-
-
to-bigint neg-bigint from-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
-123
-
-
- -
-
- -
-
-
-
In [199]:
-
-
-
to-bigint neg-bigint from-bigint
-
- -
-
-
- -
-
- - -
- -
- - -
-
123
-
-
- -
-
- -
-
-
-
In [200]:
-
-
-
clear
-[sub-bigints [same-sign] [sub-like-bigints] [neg-bigint add-like-bigints] ifte] inscribe
-[add-bigints [same-sign] [add-like-bigints] [neg-bigint sub-like-bigints] ifte] inscribe
-
- -
-
-
- -
-
- - -
- -
- - -
-

-
-
- -
-
- -
-
-
-
-

Multiplication

-
-
-
-
-
-
In [ ]:
-
-
-
 
-
- -
-
-
- -
-
-
-
-

Appendix: Source Code

+] inscribe

+

Joy +clear +true [3 2 1] [6 5 4]

+
true [3 2 1] [6 5 4]
+
+

Joy +check-gt initial-carry

+
false false [6 5 4] [3 2 1]
+
+

Joy +sub-digits'

+
false [3 3 3]
+
+

Joy +clear +12345 to-bignum 109 to-bignum

+
[true 5 4 3 2 1] [true 9 0 1]
+
+

Joy +sub-like-bignums

+
[true 6 3 2 2 1]
+
+

Joy +from-bignum

+
12236
+
+

Joy +clear

+

neg-bignum

+

Joy +[neg-bignum [not] infra] inscribe

+

Joy +123

+
123
+
+

Joy +to-bignum neg-bignum from-bignum

+
-123
+
+

Joy +to-bignum neg-bignum from-bignum

+
123
+
+

Joy +clear +[sub-bignums [same-sign] [sub-like-bignums] [neg-bignum add-like-bignums] ifte] inscribe +[add-bignums [same-sign] [add-like-bignums] [neg-bignum sub-like-bignums] ifte] inscribe

+

Multiplication

+

```Joy

+

```

+

Appendix: Source Code

clear
 [base 2147483648]
 [ditch-empty-list [bool] [popd] [pop] ifte]
@@ -20782,26 +1445,26 @@ true [3 2 1] [6 5 4]
 [sandwich swap [cons] dip swoncat]
 
 [digitalize [0 <=] [pop []] [base divmod swap] [i cons] genrec]
-[to-bigint [!-] [abs digitalize] cleave cons]
+[to-bignum [!-] [abs digitalize] cleave cons]
 
 [prep rest 1 0 rolldown]
-[from-bigint' [next-digit] step popd]
+[from-bignum′ [next-digit] step popd]
 [next-digit [increase-power] [accumulate-digit] clop popdd]
 [increase-power popop base *]
 [accumulate-digit rolldown * +]
 
-[sign-int [first] [prep from-bigint'] cleave]
+[sign-int [first] [prep from-bignum′] cleave]
 [neg-if-necessary swap [neg] [] branch]
-[from-bigint sign-int neg-if-necessary]
+[from-bignum sign-int neg-if-necessary]
 
 [add-with-carry _add-with-carry0 _add-with-carry1]
 [_add-with-carry0 [bool-to-int] dipd + +]
 [_add-with-carry1 base [mod] [>=] clop]
 
-[add-carry-to-digits [pop not] [popd] [_actd_R0] [i cons] genrec]
-[_actd_R0 [bool] [_actd_R0.then] [_actd_R0.else] ifte]
-[_actd_R0.else popd 1 false rolldown]
-[_actd_R0.then 0 swap uncons [add-with-carry] dip]
+[add-carry-to-digits [pop not] [popd] [actd.R0] [i cons] genrec]
+[actd.R0 [bool] [actd.R0.then] [actd.R0.else] ifte]
+[actd.R0.else popd 1 false rolldown]
+[actd.R0.then 0 swap uncons [add-with-carry] dip]
 
 [add-digits initial-carry add-digits']
 [initial-carry false rollup]
@@ -20816,8 +1479,8 @@ true [3 2 1] [6 5 4]
 [ELSE pop swap [] [1 swons] branch]
 
 [same-sign [first] ii xor not]
-[add-like-bigints [uncons] dip rest add-digits cons]
-[add-bigints [same-sign] [add-like-bigints] [neg-bigint sub-like-bigints] ifte]
+[add-like-bignums [uncons] dip rest add-digits cons]
+[add-bignums [same-sign] [add-like-bignums] [neg-bignum sub-like-bignums] ifte]
 
 [build-two-list-combiner _btlc0 _btlc1 [i cons]]
 [_btlc0.0 [[ditch-empty-list] swoncat] dip]
@@ -20833,8 +1496,8 @@ true [3 2 1] [6 5 4]
 [xR1 uncons-two [unit cons swons] dipd]
 [xP [bool] ii & not]
 [BASE [bool] [popop pop true] [[pop bool] [popop pop false] [popop compare-pairs] ifte] ifte]
-[gt-bigint <<{} [xP] [BASE] [xR1] tailrec]
-[check-gt [gt-bigint] [swap [not] dipd] [] ifte]
+[gt-bignum <<{} [xP] [BASE] [xR1] tailrec]
+[check-gt [gt-bignum] [swap [not] dipd] [] ifte]
 
 [sub-carry pop]
 
@@ -20846,7 +1509,7 @@ true [3 2 1] [6 5 4]
 [_sub-with-carry0 rolldown bool-to-int [-] ii]
 [_sub-with-carry1 [base + base mod] [0 <] cleave]
 
-[sub-like-bigints [uncons] dip rest check-gt sub-digits cons]
+[sub-like-bignums [uncons] dip rest check-gt sub-digits cons]
 [sub-digits initial-carry sub-digits']
 
 enstacken [inscribe] step
@@ -20865,45 +1528,26 @@ inscribe
 build-two-list-combiner
 [genrec] ccons ccons
 [sub-digits'] swoncat
-inscribe
- -
-
-
-
-
-
-

notes

So far I have three formats for Joy source:

+inscribe + +

notes

+

So far I have three formats for Joy source:

  • def.txt is a list of definitions (UTF-8), one per line, with no special marks.
  • foo ≡ bar baz... lines in the joy.py embedded definition text, because why not? (Sometimes I use == instead of mostly because some tools can't handle the Unicode glyph. Like converting this notebook to PDF via LaTeX just omitted them.)
  • [name body] inscribe Joy source code that literally defines new words in the dictionary at runtime. A text of those commands can be fed to the interpreter to customize it without any special processing (like the other two formats require.)

So far I prefer the def.txt style but that makes it tricky to embed them automatically into the joy.py file.

-

Refactoring

We have i cons but that's pretty tight already, eh?

+

Refactoring

+

We have i cons but that's pretty tight already, eh?

However, [i cons] genrec is an interesting combinator. It's almost tailrec with that i combinator for the recursion, but then cons means it's a list-builder (an anamorphism if you go for that sort of thing.)

-
simple-list-builder == [i cons] genrec
-
 

And maybe:

-
boolii == [bool] ii
 
    both? == boolii &
- one-of? == boolii |
- -
-
-
-
-
+ one-of? == boolii | + - - - - - - - diff --git a/docs/html/notebooks/Generator_Programs.html b/docs/html/notebooks/Generator_Programs.html index e343638..0fa65f7 100644 --- a/docs/html/notebooks/Generator_Programs.html +++ b/docs/html/notebooks/Generator_Programs.html @@ -244,103 +244,160 @@ b [b+a b F]

Putting it all together:

F == + [popdd over] cons infra uncons
-fib_gen == [1 1 F]
 
-

Let's call F fib_gen:

-
[fib_gen + [popdd over] cons infra uncons] inscribe
+

fib-gen

+

Let's call F fib-gen:

+
[fib-gen + [popdd over] cons infra uncons] inscribe
 

We can just write the initial quote and then "force" it with x:

-
joy? [1 1 fib_gen] 10 [x] times
-1 2 3 5 8 13 21 34 55 89 [144 89 fib_gen]
+
joy? [1 1 fib-gen] 10 [x] times
+1 2 3 5 8 13 21 34 55 89 [144 89 fib-gen]
 

It skips the first term (1) but if that bothers you you can just prepend it to the program:

-
1 [1 1 fib_gen] 10 [x] times
+
1 [1 1 fib-gen] 10 [x] times
 

Project Euler Problem Two

By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms.

-

Now that we have a generator for the Fibonacci sequence, we need a function that adds a term in the sequence to a sum if it is even, and pops it otherwise.

-

python -define('PE2.1 == dup 2 % [+] [pop] branch')

+

Now that we have a generator for the Fibonacci sequence, we need a function that adds +a term in the sequence to a sum if it is even, and pops it otherwise.

+

even

+
[even 2 % bool] inscribe
+
+

PE2.1

+
[PE2.1 dup even [+] [pop] branch] inscribe
+

And a predicate function that detects when the terms in the series "exceed four million".

-

python -define('>4M == 4000000 >')

-

Now it's straightforward to define PE2 as a recursive function that generates terms in the Fibonacci sequence until they exceed four million and sums the even ones.

-

python -define('PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec')

-

python -J('PE2')

-
4613732
+

>4M

+
[>4M 4000000 >] inscribe
 
-

Here's the collected program definitions:

-
fib == + swons [popdd over] infra uncons
-fib_gen == [1 1 fib]
-
-even == dup 2 %
->4M == 4000000 >
-
-PE2.1 == even [+] [pop] branch
-PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec
+

Now it's straightforward to define PE2 as a recursive function that generates terms +in the Fibonacci sequence until they exceed four million and sums the even ones.

+
joy? 0 [1 1 fib-gen] x [pop >4M] [popop] [[PE2.1] dip x] tailrec
+4613732
 
-

Even-valued Fibonacci Terms

+

PE2

+
[PE2 0 [1 1 fib-gen] x [pop >4M] [popop] [[PE2.1] dip x] tailrec] inscribe
+
+

Here's the collected program definitions (with a little editorializing):

+
fib-gen + [popdd over] cons infra uncons
+even 2 % bool
+>4M 4000000 >
+PE2.1 dup even [+] [pop] branch
+PE2.2 [PE2.1] dip x
+PE2.init 0 [1 1 fib-gen] x
+PE2.rec [pop >4M] [popop] [PE2.2] tailrec
+PE2 PE2.init PE2.rec
+
+

Hmm...

+
fib-gen + swons [popdd over] infra uncons
+
+

Even-valued Fibonacci Terms

Using o for odd and e for even:

o + o = e
 e + e = e
 o + e = o
 

So the Fibonacci sequence considered in terms of just parity would be:

-
o o e o o e o o e o o e o o e o o e
-1 1 2 3 5 8 . . .
+
o o e o o e  o  o  e  o  o   e . . .
+1 1 2 3 5 8 13 21 34 55 89 144 . . .
 

Every third term is even.

-

python -J('[1 0 fib] x x x') # To start the sequence with 1 1 2 3 instead of 1 2 3.

-
1 1 2 [3 2 fib]
+

So what if we drive the generator three times and discard the odd terms? +We would have to initialize our fib generator with 1 0:

+
[1 0 fib-gen]
 
-

Drive the generator three times and popop the two odd terms.

-

python -J('[1 0 fib] x x x [popop] dipd')

-
2 [3 2 fib]
+

third-term

+
[third-term x x x [popop] dipd] inscribe
 
-

python -define('PE2.2 == x x x [popop] dipd')

-

python -J('[1 0 fib] 10 [PE2.2] times')

-
2 8 34 144 610 2584 10946 46368 196418 832040 [1346269 832040 fib]
+

So:

+
joy? [1 0 fib-gen]
+[1 0 fib-gen]
+
+joy? third-term
+2 [3 2 fib-gen]
+
+joy? third-term
+2 8 [13 8 fib-gen]
+
+joy? third-term
+2 8 34 [55 34 fib-gen]
+
+joy? third-term
+2 8 34 144 [233 144 fib-gen]
 
-

Replace x with our new driver function PE2.2 and start our fib generator at 1 0.

-

python -J('0 [1 0 fib] PE2.2 [pop >4M] [popop] [[PE2.1] dip PE2.2] primrec')

-
4613732
+

So now we need a sum:

+
joy? 0
+0
 
-

How to compile these?

-

You would probably start with a special version of G, and perhaps modifications to the default x?

-

An Interesting Variation

-

python -define('codireco == cons dip rest cons')

-

python -V('[0 [dup ++] codireco] x')

-
                                 . [0 [dup ++] codireco] x
-           [0 [dup ++] codireco] . x
-           [0 [dup ++] codireco] . 0 [dup ++] codireco
-         [0 [dup ++] codireco] 0 . [dup ++] codireco
-[0 [dup ++] codireco] 0 [dup ++] . codireco
-[0 [dup ++] codireco] 0 [dup ++] . cons dip rest cons
-[0 [dup ++] codireco] [0 dup ++] . dip rest cons
-                                 . 0 dup ++ [0 [dup ++] codireco] rest cons
-                               0 . dup ++ [0 [dup ++] codireco] rest cons
-                             0 0 . ++ [0 [dup ++] codireco] rest cons
-                             0 1 . [0 [dup ++] codireco] rest cons
-       0 1 [0 [dup ++] codireco] . rest cons
-         0 1 [[dup ++] codireco] . cons
-         0 [1 [dup ++] codireco] .
+

And our Fibonacci generator:

+
joy? [1 0 fib-gen]
+0 [1 0 fib-gen]
 
-

python -define('G == [codireco] cons cons')

-

python -J('230 [dup ++] G 5 [x] times pop')

-
230 231 232 233 234
+

We want to generate the initial term:

+
joy? third-term
+0 2 [3 2 fib-gen]
 
+

Now we check if the term is less than four million, +if so we add it and recur, +otherwise we discard the term and the generator leaving the sum on the stack:

+
joy? [pop >4M] [popop] [[PE2.1] dip third-term] tailrec
+4613732
+
+

Math

+
a      b
+b      a+b
+a+b    a+b+b
+a+b+b  a+a+b+b+b
+
+

So if (a,b) and a is even then the next even term pair is (a+2b, 2a+3b)

+

Reconsider:

+
[b a F] x
+[b a F] b a F
+
+

From here we want to arrive at:

+
(a+2b) [(2a+3b) (a+2b) F]
+
+b a F
+b a [F0] [F1] fork
+
+   b a over [+] ii
+---------------------
+        a+2b
+
+

And:

+
   b a over [dup + +] ii
+---------------------------
+          2a+3b
+
+
+[over [dup + +] ii] [over [+] ii] clop
+roll< rrest [tuck] dip ccons
+
+
+[b a F] b a F
+
+[b a F] (2a+3b) (a+2b) roll<
+(2a+3b) (a+2b) [b a F] rrest
+(2a+3b) (a+2b) [F] [tuck] dip ccons
+
+
+joy? [1 0 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons]
+[1 0 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons]
+
+joy? x
+2 [3 2 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons]
+
+joy? x
+2 8 [13 8 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons]
+
+joy? x
+2 8 34 [55 34 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons]
+
+joy? x
+2 8 34 144 [233 144 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons]
+
+

And so it goes...

diff --git a/docs/misc/misc.txt b/docs/misc/misc.txt index 142b4c1..49bb6d1 100644 --- a/docs/misc/misc.txt +++ b/docs/misc/misc.txt @@ -93,3 +93,43 @@ them in host language for greater efficiency if you like.) | NOT | `not` | | | + + + +## An Interesting Variation + + + codireco == cons dip rest cons') + + + [0 [dup ++] codireco] x + + + . [0 [dup ++] codireco] x + [0 [dup ++] codireco] . x + [0 [dup ++] codireco] . 0 [dup ++] codireco + [0 [dup ++] codireco] 0 . [dup ++] codireco + [0 [dup ++] codireco] 0 [dup ++] . codireco + [0 [dup ++] codireco] 0 [dup ++] . cons dip rest cons + [0 [dup ++] codireco] [0 dup ++] . dip rest cons + . 0 dup ++ [0 [dup ++] codireco] rest cons + 0 . dup ++ [0 [dup ++] codireco] rest cons + 0 0 . ++ [0 [dup ++] codireco] rest cons + 0 1 . [0 [dup ++] codireco] rest cons + 0 1 [0 [dup ++] codireco] . rest cons + 0 1 [[dup ++] codireco] . cons + 0 [1 [dup ++] codireco] . + + + +```python +define('G == [codireco] cons cons') +``` + + +```python +J('230 [dup ++] G 5 [x] times pop') +``` + + 230 231 232 233 234 + diff --git a/docs/source/notebooks/BigInts.md b/docs/source/notebooks/BigInts.md new file mode 100644 index 0000000..26dbc26 --- /dev/null +++ b/docs/source/notebooks/BigInts.md @@ -0,0 +1,2198 @@ +# BigNums in Joy + +Most of the implementations of Thun support +[BigNums](https://en.wikipedia.org/wiki/BigNum), either built-in or as +libraries, but some host languages and systems do not. In those cases it +would be well to have a pure-Joy implementation. + +We can model bignums as a pair of a Boolean value for the sign and a list +of integers for the digits. The bool will be the first item on a list +followed by zero or more integer digits, with the Least Significant digit +at the top (closest to the head of the list.) E.g.: + + [true 1] + +Our *base* for the digits will be dictated by the size of the integers +supported by the host system. Let's imagine we're using 32-bit signed +ints, so our base will be not 10, but 2³¹. (We're ignoring the sign +bit.) + + joy? 2 31 pow + 2147483648 + +So our digits are not 0..9, but 0..2147483647 + +### `base` + +We can `inscribe` a constant function `base` to keep this value handy. + + 2147483648 + joy? unit [base] swoncat + [base 2147483648] + joy? inscribe + +This is sort of like a constant, and it's a little "wrong" to use the +dictionary to store values like this, however, this is how Forth does it +and if your design is good it works fine. Just be careful, and wash +your hand afterward. + +This also permits a kind of parameterization. E.g. let's say we wanted +to use base 10 for our digits, maybe during debugging. All that requires +is to rebind the symbol `base` to 10. + + +## Converting Between Host BigNums and Joy BigNums + +We will work with one of the Joy interpreters that has bignums already so +we can convert "native" ints to our Joy bignums and vice versa. This +will be helpful to check our work. Later we can deal with converting to +and from strings (which this Joy doesn't have anyway, so it's probably +fine to defer.) + +To get the sign bool we can just use `!-` ("not negative") and to get the +list of digits we repeatedly `divmod` the number by our `base`: + +### `moddiv` + +We will want the results in the opposite order, so let's define a little +helper function to do that: + + [moddiv divmod swap] inscribe + +### `get-digit` + + [get-digit base moddiv] inscribe + +We keep it up until we get to zero. This suggests a `while` loop: + + [0 >] [get-digit] while + +Let's try it: + + joy? 1234567890123456789012345678901234567890 + 1234567890123456789012345678901234567890 + + joy? [0 >] [get-digit] while + 1312754386 1501085485 57659106 105448366 58 0 + +We need to `pop` at the end to ditch that zero. + + [0 >] [get-digit] while pop + +But we want these numbers in a list. The naive way using `infra` +generates them in the reverse order of what we would like. + + joy? [1234567890123456789012345678901234567890] + [1234567890123456789012345678901234567890] + + joy? [[0 >] [get-digit] while pop] + [1234567890123456789012345678901234567890] [[0 >] [get-digit] while pop] + + joy? infra + [58 105448366 57659106 1501085485 1312754386] + +We could just reverse the list, but it's more efficient to build the result list in the order we want. +We construct a simple recursive function. (TODO: link to the recursion combinators notebook.) + +The predicate will check that our number is yet positive: + + [0 <=] + +When we find the zero we will discard it and start a list: + + [pop []] + +But until we do find the zero, get digits: + + [get-digit] + +Once we have found all the digits and ditched the zero and put our initial empty list on the stack we +`cons` up the digits we have found: + + [i cons] genrec + +Let's try it: + + joy? 1234567890123456789012345678901234567890 + 1234567890123456789012345678901234567890 + + joy? [0 <=] [pop []] [get-digit] [i cons] genrec + [1312754386 1501085485 57659106 105448366 58] + +Okay. + +### Representing Zero + +This will return the empty list for zero: + + joy? 0 [0 <=] [pop []] [get-digit] [i cons] genrec + [] + +I think this is better than returning `[0]` because that amounts to a single leading zero. + + [true] is "0" + [true 0] is "00" + +Eh? + +### `digitalize` + +Let's `inscribe` this function under the name `digitalize`: + + [digitalize [0 <=] [pop []] [get-digit] [i cons] genrec] inscribe + +Putting it all together we have `!-` for the sign and `abs digitalize` for the digits, followed by `cons`: + + [!-] [abs digitalize] cleave cons + +### `to-bignum` + + [to-bignum [!-] [abs digitalize] cleave cons] inscribe + +### Converting from Joy BigNums to Host BigNums + +To convert a bignum into a host integer we need to keep a "power" value on the stack, +setting it up and discarding it at the end, as well as an accumulator value starting at zero. +We will deal with the sign bit later. + + rest 1 0 rolldown + +So the problem is to derive: + + 1 0 [digits...] [F] step + ------------------------------ + result + +Where `F` is: + + power acc digit F + --------------------------------------- + (power*base) (acc + (power*digit) + +Now this is an interesting function. +The first thing I noticed is that it has two results that can be computed independently, suggesting a form like: + + [G] [H] clop popdd + +(Then I noticed that `power *` is a sub-function of both `G` and `H`, but let's not overthink it, eh?) + +So for the first result (the next power) we want: + + G == popop base * + +And for the result: + + H == rolldown * + + +### `add-digit` + +Let's call this `add-digit`: + + [add-digit [popop base *] [rolldown * +] clop popdd] inscribe + +Try it out: + + [true 1312754386 1501085485 57659106 105448366 58] + joy? rest 1 0 rolldown + + 1 0 [1312754386 1501085485 57659106 105448366 58] + + joy? [add-digit] step + 45671926166590716193865151022383844364247891968 1234567890123456789012345678901234567890 + + joy? popd + 1234567890123456789012345678901234567890 + +### `from-bignum′` + + [from-bignum′ rest 1 0 rolldown [add-digit] step popd] inscribe + +Try it out: + + joy? 1234567890123456789012345678901234567890 to-bignum + [true 1312754386 1501085485 57659106 105448366 58] + + joy? from-bignum′ + 1234567890123456789012345678901234567890 + +Not bad. + +### What about that sign bit? + +Time to deal with that. + +Consider a Joy bignum: + + [true 1312754386 1501085485 57659106 105448366 58] + +To get the sign bit would just be `first`. + + [true 1312754386 1501085485 57659106 105448366 58] + + joy? [from-bignum′] [first] cleave + 1234567890123456789012345678901234567890 true + +Then use the sign flag to negate the int if the bignum was negative: + + [neg] [] branch + +### `from-bignum` + +This gives: + + [from-bignum [from-bignum′] [first] cleave [neg] [] branch] inscribe + + +## Our Source Code So Far + +(Note that this is a list of definitions, and then we can `[inscribe] step` them into the dictionary all at once. +This is for convenience when entering definitions into an interpreter as one is following along, eh?) + + [base 2147483648] inscribe + [moddiv divmod swap] inscribe + [get-digit base moddiv] inscribe + [digitalize [0 <=] [pop []] [get-digit] [i cons] genrec] inscribe + [to-bignum [!-] [abs digitalize] cleave cons] inscribe + + [add-digit [popop base *] [rolldown * +] clop popdd] inscribe + [from-bignum′.prep rest 1 0 rolldown] inscribe + [from-bignum′ from-bignum′.prep [add-digit] step popd] inscribe + [from-bignum [from-bignum′] [first] cleave [neg] [] branch] inscribe + + +## Addition of Like Signs + +### `add-digits` + +Let's figure out how to add two lists of digits. We will assume that the signs are the same (both lists of digits represent +numbers of the same sign, both positive or both negative.) +We're going to want a recursive function, of course, but it's not quite a standard *hylomorphism* for (at least) two reasons: + +- We're tearing down two lists simultaneously. +- They might not be the same length. + +There are two base cases: two empty lists or one empty list, the recursive branch is taken only if both lists are non-empty. + +We will also need an inital `false` value for a carry flag. This implies the following structure: + + false rollup [add-digits.P] [add-digits.THEN] [add-digits.R0] [add-digits.R1] genrec + +### The predicate + +The situation will be like this, a Boolean flag followed by two lists of digits: + + bool [a ...] [b ...] add-digits.P + +The predicate must evaluate to `false` *iff* both lists are non-`null`: + + add-digits.P == [null] ii \/ + +### The base cases + +On the non-recursive branch of the `genrec` we have to decide between three cases, +but because addition is commutative we can lump together the first two: + + bool [] [b ...] add-digits.THEN + bool [a ...] [] add-digits.THEN + + bool [] [] add-digits.THEN + +So we have an `ifte` expression: + + add-digits.THEN == [add-digits.THEN.P] [add-digits.THEN.THEN] [add-digits.THEN.ELSE] ifte + +Let's define the predicate: + + add-digits.THEN.P == [null] ii /\ + +So `add-digits.THEN.THEN` deals with the case of both lists being empty, +and the `add-digits.THEN.ELSE` branch deals with one list of digits being longer than the other. + +### One list empty + +In the cases where one of the two lists (but not both) is empty: + + carry [a ...] [] add-digits.THEN.ELSE + carry [] [b ...] add-digits.THEN.ELSE + +We first get rid of the empty list: + + [null] [pop] [popd] ifte + +### `ditch-empty-list` + + [ditch-empty-list [null] [pop] [popd] ifte] inscribe + + add-digits.THEN.ELSE == ditch-empty-list add-digits.THEN.ELSE′ + +Now we have: + + carry [n ...] add-digits.THEN.ELSE′ + +This is just `add-carry-to-digits` which we will derive in a moment, but first a side-quest... + +### `add-with-carry` + +To get ahead of ourselves a bit, +we will want some function `add-with-carry` that accepts a bool and two ints and leaves behind a new int and a new Boolean carry flag. +With some abuse of notation we can treat bools as ints (type punning as in Python) and write: + + carry a b add-with-carry + --------------------------------- + (a+b+carry) carry′ + +(I find it interesting that this function accepts the carry from below the int args but returns it above the result. Hmm...) + +### `bool-to-int` + + [bool-to-int [0] [1] branch] inscribe + +We can use this function to convert the carry flag to an integer and then add it to the sum of the two digits: + + [bool-to-int] dipd + + + +So the first part of `add-with-carry` is `[bool-to-int] dipd + +` to get the total, then we need to do +`base mod` to get the new digit and `base >=` to get the new carry flag. Factoring give us: + + base [mod] [>=] clop + +Put it all together and we have: + + [add-with-carry.0 [bool-to-int] dipd + +] inscribe + [add-with-carry.1 base [mod] [>=] clop] inscribe + [add-with-carry add-with-carry.0 add-with-carry.1] inscribe + +### Now back to `add-carry-to-digits` + +This should be a very simple recursive function. It accepts a Boolean `carry` flag +and a non-empty list of digits (the list is only going to be non-empty on the +first iteration, after that we have to check it ourselves because we may have emptied +it of digits and still have a `true` `carry` flag) and it returns a list of digits, consuming the carry flag. + + add-carry-to-digits == [actd.P] [actd.THEN] [actd.R0] [actd.R1] genrec + +The predicate is the carry flag itself inverted: + + actd.P == pop not + +The base case simply discards the carry flag: + + actd.THEN == popd + +So: + + add-carry-to-digits == [pop not] [popd] [actd.R0] [actd.R1] genrec + +That leaves the recursive branch: + + true [n ...] actd.R0 [add-carry-to-digits] actd.R1 + +-or- + + true [] actd.R0 [add-carry-to-digits] actd.R1 + +We know that the Boolean value is `true`. +We also know that the list will be non-empty, but only on the first iteration of the `genrec`. +It may be that the list is empty on a later iteration. + +The `actd.R0` function should check the list. + + actd.R0 == [null] [actd.R0.THEN] [actd.R0.ELSE] ifte + +### If it's empty... + + true [] actd.R0.THEN [add-carry-to-digits] actd.R1 + -------------------------------------------------------- + 1 false [] [add-carry-to-digits] i cons + +What we're seeing here is that `actd.R0.THEN` leaves the empty list of digits on the stack, +converts the carry flag to `false` and leave 1 on the stack to be picked up by `actd.R1` +and `cons`'d onto the list of digits (e.g.: 999 -> 1000, it's the new 1.) + +This implies: + + actd.R1 == i cons + +And: + + actd.R0.THEN == popd 1 false rolldown + +We have the results in this order `1 false []` rather than some other arrangement to be compatible (same types and order) +with the result of the other branch, which we now derive. + +### If the list of digits isn't empty... + +With `actd.R1 == i cons` as above we have: + + true [a ...] actd.R0.ELSE [add-carry-to-digits] i cons + +We want to get out that `a` value and use `add-with-carry` here: + + true 0 a add-with-carry [...] [add-carry-to-digits] i cons + ---------------------------------------------------------------- + (a+1) carry [...] [add-carry-to-digits] i cons + +This leaves behind the new digit (a+1) for `actd.R1` and the new carry flag for the next iteration. + +So here is the specification of `actd.R0.ELSE`: + + true [a ...] actd.R0.ELSE + ----------------------------------- + true 0 a add-with-carry [...] + +It accepts a Boolean value and a non-empty list on the stack and is responsible +for `uncons`'ing `a` and `add-with-carry` and the initial 0: + + true [a ...] . 0 swap + true 0 [a ...] . uncons + true 0 a [...] . [add-with-carry] dip + true 0 a add-with-carry [...] . + +### `actd.R0.ELSE` + + [actd.R0.ELSE 0 swap uncons [add-with-carry] dip] inscribe + +Putting it all together: + + [bool-to-int [0] [1] branch] inscribe + [ditch-empty-list [null] [pop] [popd] ifte] inscribe + + [add-with-carry.0 [bool-to-int] dipd + +] inscribe + [add-with-carry.1 base [mod] [>=] clop] inscribe + [add-with-carry add-with-carry.0 add-with-carry.1] inscribe + + [actd.R0.THEN popd 1 false rolldown] inscribe + [actd.R0.ELSE 0 swap uncons [add-with-carry] dip] inscribe + [actd.R0 [null] [actd.R0.THEN] [actd.R0.ELSE] ifte] inscribe + + [add-carry-to-digits [pop not] [popd] [actd.R0] [i cons] genrec] inscribe + + +We can set `base` to 10 to see it in action with familiar decimal digits: + + joy? [base 10] inscribe + +Let's add a carry to 999: + + joy? true [9 9 9] + true [9 9 9] + + joy? add-carry-to-digits + [0 0 0 1] + +Not bad! Recall that our digits are stored in with the Most Significant Digit at the bottom of the list. + +Let's add another carry: + + joy? true swap + true [0 0 0 1] + + joy? add-carry-to-digits + [1 0 0 1] + +What if we make the just the first digit into 9? + + joy? 9 swons + [9 1 0 0 1] + + joy? true swap + true [9 1 0 0 1] + + joy? add-carry-to-digits + [0 2 0 0 1] + +Excellent! + +And adding `false` does nothing, yes? + + joy? false swap + false [0 2 0 0 1] + + joy? add-carry-to-digits + [0 2 0 0 1] + +Wonderful! + +So that handles the cases where one of the two lists (but not both) is empty. + + add-digits.THEN.ELSE == ditch-empty-list add-carry-to-digits + +### Both lists empty + +If both lists are empty we discard one list and check the carry to determine our result as described above: + + bool [] [] add-digits.THEN.THEN + +Simple enough: + + bool [] [] . pop + bool [] . swap + [] bool . [] [1 swons] branch + +True branch: + + [] true . [] [1 swons] branch + [] . + +False branch: + + [] false . [] [1 swons] branch + [] . 1 swons + [1] . + +So: + + add-digits.THEN.THEN == pop swap [] [1 swons] branch + +Here are the definitions, ready to `inscribe`: + + [add-digits.THEN.THEN pop swap [] [1 swons] branch] inscribe + [add-digits.THEN.ELSE ditch-empty-list add-carry-to-digits] inscribe + [add-digits.THEN [[null] ii /\] [add-digits.THEN.THEN] [add-digits.THEN.ELSE] ifte] inscribe + +## And recur... + +Now we go back and derive the recursive branch that is taken only if both lists are non-empty. + + bool [a ...] [b ...] add-digits.R0 [add-digits′] add-digits.R1 + +We just need to knock out those recursive branch functions `add-digits.R0` and `add-digits.R1` and we're done. + +First we will want to `uncons` the digits. Let's write a function that just does that: + + [uncons] ii swapd + +Try it: + + joy? [1 2 3] [4 5 6] + [1 2 3] [4 5 6] + + joy? [uncons] ii swapd + 1 4 [2 3] [5 6] + +### `uncons-two` + +We could call this `uncons-two`: + + [uncons-two [uncons] ii swapd] inscribe + +This brings us to: + + bool a b [...] [...] add-digits.R0′ [add-digits′] add-digits.R1 + +It's at this point that we'll want to employ the `add-with-carry` function: + + bool a b [...] [...] [add-with-carry] dipd add-digits.R0″ [add-digits'] add-digits.R1 + + bool a b add-with-carry [...] [...] add-digits.R0″ [add-digits'] add-digits.R1 + + (a+b) bool [...] [...] add-digits.R0″ [add-digits'] add-digits.R1 + +If we postulate a `cons` in our `add-digits.R1` function... + + (a+b) bool [...] [...] add-digits.R0″ [add-digits'] i cons + +Then it seems like we're done? `add-digits.R0″` is nothing? + + add-digits.R0 == uncons-two [add-with-carry] dipd + + add-digits.R1 == i cons + +### `add-digits` + + add-digits == false rollup [add-digits.P] [add-digits.THEN] [add-digits.R0] [i cons] genrec + +The source code so far is now: + + [bool-to-int [0] [1] branch] inscribe + [ditch-empty-list [null] [pop] [popd] ifte] inscribe + [uncons-two [uncons] ii swapd] inscribe + + [add-with-carry.0 [bool-to-int] dipd + +] inscribe + [add-with-carry.1 base [mod] [>=] clop] inscribe + [add-with-carry add-with-carry.0 add-with-carry.1] inscribe + + [actd.R0.THEN popd 1 false rolldown] inscribe + [actd.R0.ELSE 0 swap uncons [add-with-carry] dip] inscribe + [actd.R0 [null] [actd.R0.THEN] [actd.R0.ELSE] ifte] inscribe + + [add-carry-to-digits [pop not] [popd] [actd.R0] [i cons] genrec] inscribe + + [add-digits.R0 uncons-two [add-with-carry] dipd] inscribe + + [add-digits.THEN.THEN pop swap [] [1 swons] branch] inscribe + [add-digits.THEN.ELSE ditch-empty-list add-carry-to-digits] inscribe + [add-digits.THEN [[null] ii /\] [add-digits.THEN.THEN] [add-digits.THEN.ELSE] ifte] inscribe + + [add-digits′ [[null] ii \/] [add-digits.THEN] [add-digits.R0] [i cons] genrec] inscribe + [add-digits false rollup add-digits′] inscribe + +Let's set `base` to 10 and try it out: + + joy? [base 10] inscribe + + joy? 12345 to-bignum + [true 5 4 3 2 1] + + joy? rest + [5 4 3 2 1] + + joy? 999 to-bignum + [5 4 3 2 1] [true 9 9 9] + + joy? rest + [5 4 3 2 1] [9 9 9] + + joy? add-digits + [4 4 3 3 1] + + joy? true swons + [true 4 4 3 3 1] + + joy? from-bignum + 13344 + + joy? 12345 999 + + 13344 13344 + +Neat! + +### `add-bignums` + +There is one more thing we have to do to use this: we have to deal with the signs. + + add-bignums [add-bignums.P] [add-bignums.THEN] [add-bignums.ELSE] ifte + +To check are they the same sign? + +With: + + [xor [] [not] branch] inscribe + [nxor xor not] inscribe + +We have: + + add-bignums.P == [first] ii nxor + +If they are the same sign (both positive or both negative) we can +use `uncons` to keep one of the sign Boolean flags around and reuse +it at the end, and `rest` to discard the other, then `add-digits` +to add the digits, then `cons` that flag we saved onto the result +digits list: + + add-bignums.THEN == [uncons] dip rest add-digits cons + +If they are not both positive or both negative then we negate one of +them and subtract instead (adding unlikes is actually subtraction): + + add-bignums.ELSE == neg-bignum sub-bignums + +So here we go: + + [same-sign [first] ii xor not] inscribe + [add-like-bignums [uncons] dip rest add-digits cons] inscribe + + [add-bignums [same-sign] [add-like-bignums] [neg-bignum sub-bignums] ifte] inscribe + +But we haven't implemented `neg-bignum` or `sub-bignums` yet... + + [actd.R0.ELSE 0 swap uncons [add-with-carry] dip] inscribe + [actd.R0 [null] [actd.R0.THEN] [actd.R0.ELSE] ifte] inscribe + [actd.R0.THEN popd 1 false rolldown] inscribe + [add-bignums [same-sign] [add-like-bignums] [neg-bignum sub-bignums] ifte] inscribe + [add-carry-to-digits [pop not] [popd] [actd.R0] [i cons] genrec] inscribe + [add-digit [popop base *] [rolldown * +] clop popdd] inscribe + [add-digits false rollup add-digits′] inscribe + [add-digits′ [[null] ii \/] [add-digits.THEN] [add-digits.R0] [i cons] genrec] inscribe + [add-digits.R0 uncons-two [add-with-carry] dipd] inscribe + [add-digits.THEN.ELSE ditch-empty-list add-carry-to-digits] inscribe + [add-digits.THEN [[null] ii /\] [add-digits.THEN.THEN] [add-digits.THEN.ELSE] ifte] inscribe + [add-digits.THEN.THEN pop swap [] [1 swons] branch] inscribe + [add-like-bignums [uncons] dip rest add-digits cons] inscribe + [add-with-carry.0 [bool-to-int] dipd + +] inscribe + [add-with-carry.1 base [mod] [>=] clop] inscribe + [add-with-carry add-with-carry.0 add-with-carry.1] inscribe + [base 10] inscribe + [bool-to-int [0] [1] branch] inscribe + [digitalize [0 <=] [pop []] [get-digit] [i cons] genrec] inscribe + [ditch-empty-list [null] [pop] [popd] ifte] inscribe + [from-bignum [from-bignum′] [first] cleave [neg] [] branch] inscribe + [from-bignum′ from-bignum′.prep [add-digit] step popd] inscribe + [from-bignum′.prep rest 1 0 rolldown] inscribe + [get-digit base moddiv] inscribe + [moddiv divmod swap] inscribe + [nxor xor not] inscribe + [same-sign [first] ii xor not] inscribe + [to-bignum [!-] [abs digitalize] cleave cons] inscribe + [uncons-two [uncons] ii swapd] inscribe + [xor [] [not] branch] inscribe + + +## Subtraction of Like Signs `sub-digits` + +Subtraction is similar to addition in that it's a simple recursive algorithm that works digit-by-digit. It has the same four cases as well, we can reuse `P` and `P'`. + + initial-carry == false rollup + sub-digits' == [P] [sub.THEN] [sub.R0] [sub.R1] genrec + sub-digits == initial-carry add-digits' + sub.THEN == [P'] [sub.THEN'] [sub.ELSE] ifte + +### Refactoring For The Win + + +We noted above that the algorithm for subtraction is similar to that for addition. Maybe we can reuse *more* than just `P` and `P'`? In fact, I think we could refactor (prematurely, two cases is one too few) something like this? + + [sub.THEN'] [sub.ELSE] [sub.R0] [sub.R1] foo + --------------------------------------------------------------------- + [P] [[P'] [sub.THEN'] [sub.ELSE] ifte] [sub.R0] [sub.R1] genrec + +or just + + [THEN] [ELSE] [R0] [R1] foo + ---------------------------------------------------- + [P] [[P'] [THEN] [ELSE] ifte] [R0] [R1] genrec + +eh? + +`foo` is something like: + + F == [ifte] ccons [P'] swons + G == [F] dipdd + + [THEN] [ELSE] [R0] [R1] [F] dipdd foo' + [THEN] [ELSE] F [R0] [R1] foo' + [THEN] [ELSE] [ifte] ccons [P'] swons [R0] [R1] foo' + [[THEN] [ELSE] ifte] [P'] swons [R0] [R1] foo' + [[P'] [THEN] [ELSE] ifte] [R0] [R1] foo' + +That leaves `[P]`... + + F == [ifte] ccons [P'] swons [P] swap + G == [F] dipdd + + [THEN] [ELSE] [ifte] ccons [P'] swons [P] swap [R0] [R1] foo' + [[THEN] [ELSE] ifte] [P'] swons [P] swap [R0] [R1] foo' + [[P'] [THEN] [ELSE] ifte] [P] swap [R0] [R1] foo' + [P] [[P'] [THEN] [ELSE] ifte] [R0] [R1] genrec + +Ergo: + + F == [ifte] ccons [P'] swons [P] swap + foo == [F] dipdd genrec + combine-two-lists == [i cons] foo + +-and- + + add-digits' == [one-empty-list] + [both-empty] + [both-full] + combine-two-lists + + one-empty-list == ditch-empty-list add-carry-to-digits + both-empty == pop swap carry + both-full == uncons-two [add-with-carry] dipd + +This illustrates how refactoring creates denser yet more readable code. + +But this doesn't go quite far enough, I think. + + R0 == uncons-two [add-with-carry] dipd + +I think `R0` will pretty much always do: + + uncons-two [combine-two-values] dipd + +And so it should be refactored further to something like: + + [F] R0 + ------------------------- + uncons-two [F] dipd + +And then `add-digits'` becomes just: + + + add-digits' == [one-empty-list] + [both-empty] + [add-with-carry] + combine-two-lists + +If we factor `ditch-empty-list` out of `one-empty-list`, and `pop` from `both-empty`: + + add-digits' == [add-carry-to-digits] + [swap carry] + [add-with-carry] + combine-two-lists + + +Let's figure out the new form. + + + [ONE-EMPTY] [BOTH-EMPTY] [COMBINE-VALUES] foo + --------------------------------------------------- + [P] + [ + [P'] + [ditch-empty-list ONE-EMPTY] + [pop BOTH-EMPTY] + ifte + ] + [uncons-two [COMBINE-VALUES] dipd] + [i cons] genrec + +eh? + +Let's not over think it. + + [ONE-EMPTY] [ditch-empty-list] swoncat [BOTH-EMPTY] [pop] swoncat [COMBINE-VALUES] + [ditch-empty-list ONE-EMPTY] [pop BOTH-EMPTY] [COMBINE-VALUES] + +With: + + [C] [A] [B] sandwich + -------------------------- + [A [C] B] + + +```Joy +[sandwich swap [cons] dip swoncat] inscribe +``` + + + + +```Joy +clear [B] [A] [C] +``` + + [B] [A] [C] + + +```Joy +sandwich +``` + + [A [B] C] + +So to get from + + [A] [B] [C] + +to: + + [ditch-empty-list A] [pop B] [uncons-two [C] dipd] + +we use: + + [[[ditch-empty-list] swoncat] dip [pop] swoncat] dip [uncons-two] [dipd] sandwich + +It's gnarly, but simple: + + +```Joy +clear +[_foo0.0 [[ditch-empty-list] swoncat] dip] inscribe +[_foo0.1 [pop] swoncat] inscribe +[_foo0.3 [_foo0.0 _foo0.1] dip] inscribe +[_foo0.4 [uncons-two] [dipd] sandwich] inscribe +[_foo0 _foo0.3 _foo0.4] inscribe + +[_foo1 [ + [ifte] ccons + [P'] swons + [P] swap + ] dip +] inscribe +``` + + + + +```Joy +[A] [B] [C] _foo0 +``` + + [ditch-empty-list A] [pop B] [uncons-two [C] dipd] + + +```Joy +_foo1 +``` + + [P] [[P'] [ditch-empty-list A] [pop B] ifte] [uncons-two [C] dipd] + + +```Joy +clear +[add-carry-to-digits] +[swap carry] +[add-with-carry] +_foo0 _foo1 +``` + + [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] + +Compare the above with what we wanted: + + [P] + [ + [P'] + [ditch-empty-list ONE-EMPTY] + [pop BOTH-EMPTY] + ifte + ] + [uncons-two [COMBINE-VALUES] dipd] + +Allwe need to do is add: + + [i cons] genrec + + +```Joy +clear + +[3 2 1] [6 5 4] initial-carry + +[add-carry-to-digits] +[swap carry] +[add-with-carry] +_foo0 _foo1 +``` + + false [3 2 1] [6 5 4] [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] + + +```Joy +[i cons] genrec +``` + + [9 7 5] + + +```Joy +clear +[build-two-list-combiner _foo0 _foo1 [i cons]] inscribe +[combine-two-lists [add-carry-to-digits] [swap carry] [add-with-carry] build-two-list-combiner] inscribe +``` + + + + +```Joy +clear + +[3 2 1] [6 5 4] initial-carry +combine-two-lists +``` + + false [3 2 1] [6 5 4] [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] [i cons] + + +```Joy +genrec +``` + + [9 7 5] + + +```Joy +[base 10] inscribe +``` + + [9 7 5] + + +```Joy +clear + +123456 to-bignum + + + + +``` + + [true 6 5 4 3 2 1] + + +```Joy +clear +``` + + + +So that's nice. + +In order to avoid the overhead of rebuilding the whole thing each time we could pre-compute the function and store it in the dictionary. + + +```Joy +[add-carry-to-digits] +[swap carry] +[add-with-carry] +build-two-list-combiner +``` + + [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] [i cons] + +Now grab the definition, add the `genrec` and symbol (name) and inscribe it: + + +```Joy +[genrec] ccons ccons [add-digits'] swoncat +``` + + [add-digits' [P] [[P'] [ditch-empty-list add-carry-to-digits] [pop swap carry] ifte] [uncons-two [add-with-carry] dipd] [i cons] genrec] + + +```Joy + inscribe +``` + + + +Try it out... + + +```Joy +false [3 2 1] [4 3 2] add-digits' +``` + + [7 5 3] + + +```Joy +false swap base -- unit +``` + + false [7 5 3] [9] + + +```Joy +add-digits' +``` + + [6 6 3] + + +```Joy +clear +``` + + + +#### Demonstrate `add-bignums` + + +```Joy +1234 999 [to-bignum] ii +``` + + [true 4 3 2 1] [true 9 9 9] + + +```Joy +add-bignums +``` + + [true 3 3 2 2] + + +```Joy +from-bignum +``` + + 2233 + + +```Joy +1234 999 + +``` + + 2233 2233 + + +```Joy +clear +``` + + + +### Subtracting + +Okay, we're almost ready to implement subtraction, but there's a wrinkle! When we subtract a smaller (absolute) value from a larger (absolute) value there's no problem: + + 10 - 5 = 5 + +But I don't know the algorithm to subtract a larger number from a smaller one: + + 5 - 10 = ??? + +The answer is -5, of course, but what's the algorithm? How to make the computer figure that out? We make use of the simple algebraic identity: + + a - b = -(b - a) + +So if we want to subtract a larger number `a` from a smaller one `b` we can instead subtract the smaller from the larger and invert the sign: + + 5 - 10 = -(10 - 5) + +To do this we need a function `gt-digits` that will tell us which of two digit lists represents the larger integer. + +#### `gt-digits` + + + +I just realized I don't have a list length function yet! + + +```Joy +[length [pop ++] step_zero] inscribe +``` + + + + +```Joy +clear +[] length +``` + + 0 + + +```Joy +clear +[this is a list] length +``` + + 4 + + +```Joy +clear +[1 2 3] [4 5] over over [length] app2 +``` + + [1 2 3] [4 5] 3 2 + + +```Joy +[swap][6][7]cmp +``` + + [4 5] [1 2 3] + +what about a function that iterates through two lists until one or the other ends, or they end at the same time (same length) and we walk back through comparing the digits? + + +```Joy +clear +``` + + + + +```Joy +[1 2 3] [4 5 6] [bool] ii & +``` + + true + + +```Joy +clear +[1 2 3] [4 5 6] +[[bool] ii | not] +[pop] +[uncons-two] +[i [unit cons] dip cons] +genrec +``` + + [[1 4] [2 5] [3 6]] + + +```Joy +clear +[1 2 3] [4 5 6] +[[bool] ii | not] +[pop] +[uncons-two] +[i [unit cons] dip cons] +genrec +``` + + [[1 4] [2 5] [3 6]] + + +```Joy +clear +``` + + + +So I guess that's `zip`? + +But we want something a little different. + +It's a weird function: compare lengths, if they are the same length then compare contents pairwise from the end. + +if the first list is empty and the second list isn't then the whole function should return false + +if the first list is non-empty and the second list is empty then the whole function should return true + +if both lists are non-empty we uncons some digits for later comparison? Where to put them? Leave them on the stack? What about short-circuits? + +if both lists are empty we start comparing uncons'd pairs until we find an un-equal pair or run out of pairs. + +if we run out of pairs before we find an unequal pair then the function returns true (the numbers are identical, we should try to shortcut the actual subtraction here, but let's just get it working first, eh?) + +if we find an unequal pair we return a>b and discard the rest of the pairs. Or maybe this all happens in some sort of `infra first` situation? + + + +So the predicate will be `[bool] ii & not`, if one list is longer than the other we are done. +We postulate a third list to contain the pairs: + + [] [3 2 1] [4 5 6] [P] [BASE] [R0] [R1] genrec + +The recursive branch seems simpler to figure out: + + [] [3 2 1] [4 5 6] R0 [F] R1 + + uncons-two [unit cons swons] dipd [F] i + + [] [3 2 1] [4 5 6] [P] [BASE] [uncons-two [unit cons swons] dipd] tailrec + + +```Joy + [xR1 uncons-two [unit cons swons] dipd] inscribe +``` + + + + +```Joy +clear + +[] [3 2 1] [4 5 6] +``` + + [] [3 2 1] [4 5 6] + + +```Joy +xR1 xR1 xR1 +``` + + [[1 6] [2 5] [3 4]] [] [] + + +```Joy +clear +[xP [bool] ii & not] inscribe +``` + + + + +```Joy +clear + +[] [3 2 1] [5 4] [xP] [] [xR1] tailrec +``` + + [[2 4] [3 5]] [1] [] + + +```Joy +clear + +[] [3 2] [4 5 1] [xP] [] [xR1] tailrec +``` + + [[2 5] [3 4]] [] [1] + + +```Joy +clear + +[] [3 2 1] [5 4 3] [xP] [] [xR1] tailrec +``` + + [[1 3] [2 4] [3 5]] [] [] + +Now comes the tricky part, that base case: + +we have three lists. The first is a possibly-empty list of pairs to compare. + +The second two are the tails of the original lists. + +If the top list is non-empty then the second list must be empty so the whole function should return true + +If the top list is empty and the second list isn't then the whole function should return false + +If both lists are empty we start comparing uncons'd pairs until we find an un-equal pair or run out of pairs. + + [bool] # if the first list is non-empty + [popop pop true] + [ + [pop bool] # the second list is non-empty (the first list is empty) + [popop pop false] + [ + # both lists are empty + popop + compare-pairs + ] + ifte + ] + ifte + + + + +```Joy +clear +[][][1] + +[bool] +[popop pop true] +[ + [pop bool] + [popop pop false] + [popop 23 swons] + ifte +] +ifte +``` + + true + + +```Joy +clear +[][1][] + +[bool] +[popop pop true] +[ + [pop bool] + [popop pop false] + [popop 23 swons] + ifte +] +ifte +``` + + false + + +```Joy +clear +[1][][] + +[bool] +[popop pop true] +[ + [pop bool] + [popop pop false] + [popop 23 swons] + ifte +] +ifte +``` + + [23 1] + +#### `compare-pairs` + +This should be a pretty simple recursive function + + [P] [THEN] [R0] [R1] genrec + +If the list is empty we return `false` + + P == bool not + THEN == pop false + +On the recursive branch we have an `ifte` expression: + + pairs R0 [compare-pairs] R1 + --------------------------------------------------- + pairs [P.rec] [THEN.rec] [compare-pairs] ifte + +We must compare the pair from the top of the list: + + P.rec == first [>] infrst + + +```Joy +clear + +[[1 3] [2 4] [3 5]] first [>] infrst +``` + + true + + +```Joy +clear + +[[1 3] [2 4] [3 5]] [[>] infrst] map +``` + + [true true true] + + THEN.rec == pop true + + +```Joy +clear + +[compare-pairs + [bool not] + [pop false] + [ + [first [>] infrst] + [pop true] + ] + [ifte] + genrec +] inscribe +``` + + + + +```Joy +clear [[1 3] [2 4] [3 5]] compare-pairs +``` + + true + + +```Joy +clear [[1 3] [3 3] [3 5]] compare-pairs +``` + + true + +Whoops! I forgot to remove the already-checked pair from the list of pairs! (Later on I discover that the logic is inverted here: `>=` not `<` d'oh!) + + +```Joy +clear + +[compare-pairs + [bool not] + [pop false] + [ + [first [>=] infrst] + [pop true] + ] + [[rest] swoncat ifte] + genrec +] inscribe +``` + + + +This is clunky and inefficient but it works. + + +```Joy +clear [[1 0] [2 2] [3 3]] compare-pairs +``` + + true + + +```Joy +clear [[1 1] [2 2] [3 3]] compare-pairs +``` + + true + + +```Joy +clear [[1 2] [2 2] [3 3]] compare-pairs +``` + + true + + +```Joy +clear +``` + + + + +```Joy +clear [[1 1] [2 1] [3 3]] compare-pairs +``` + + true + + +```Joy +clear [[1 1] [2 2] [3 3]] compare-pairs +``` + + true + + +```Joy +clear [[1 1] [2 3] [3 3]] compare-pairs +``` + + true + + +```Joy + +``` + + +```Joy +clear +[[1 1] [2 1] [3 3]] [] [] + +[bool] +[popop pop true] +[ + [pop bool] + [popop pop false] + [popop compare-pairs] + ifte +] +ifte +``` + + true + + +```Joy +[BASE + [bool] + [popop pop true] + [ + [pop bool] + [popop pop false] + [popop compare-pairs] + ifte + ] + ifte +] inscribe +``` + + true + + +```Joy +clear + +[] [3 2 1] [4 5 6] +``` + + [] [3 2 1] [4 5 6] + + +```Joy +[xP] [BASE] [xR1] tailrec +``` + + true + + +```Joy +clear + +[] [3 2 1] [4 5 6] swap +``` + + [] [4 5 6] [3 2 1] + + +```Joy +[xP] [BASE] [xR1] tailrec +``` + + false + + +```Joy +clear + +[] [3 2 1] dup +``` + + [] [3 2 1] [3 2 1] + + +```Joy +[xP] [BASE] [xR1] tailrec +``` + + true + + +```Joy +clear +``` + + + + +```Joy +[gt-bignum <<{} [xP] [BASE] [xR1] tailrec] inscribe +``` + + + + +```Joy +clear [3 2 1] [4 5 6] gt-bignum +``` + + true + + +```Joy +clear [3 2 1] [4 5 6] swap gt-bignum +``` + + false + + +```Joy +clear [3 2 1] dup gt-bignum +``` + + true + + +```Joy + +``` + + +```Joy +clear [3 2 1] [4 5 6] [gt-bignum] [swap] [] ifte +``` + + [4 5 6] [3 2 1] + + +```Joy +clear [4 5 6] [3 2 1] [gt-bignum] [swap] [] ifte +``` + + [4 5 6] [3 2 1] + +And so it goes. + +Now we can subtract, we just have to remember to invert the sign bit if we swap the digit lists. + +Maybe something like: + + check-gt == [gt-bignum] [swap true rollup] [false rollup] ifte + +To keep the decision around as a Boolean flag? We can `xor` it with the sign bit? + + +```Joy +clear +[check-gt [gt-bignum] [swap [not] dipd] [] ifte] inscribe +``` + + + + +```Joy +false [4 5 6] [3 2 1] +``` + + false [4 5 6] [3 2 1] + + +```Joy +check-gt +``` + + false [4 5 6] [3 2 1] + + +```Joy +clear +``` + + + +### Subtraction, at last... + +So now that we can compare digit lists to see if one is larger than the other we can subtract (inverting the sign if necessary) much like we did addition: + + sub-bignums == [same-sign] [sub-like-bignums] [1 0 /] ifte + + sub-like-bignums == [uncons] dip rest sub-digits cons + ^ + | + +At this point we would have the sign bit then the two digit lists. + + sign [c b a] [z y x] + +We want to use `check-gt` here: + + sign [c b a] [z y x] check-gt + sign swapped? [c b a] [z y x] check-gt + +It seems we should just flip the sign bit if we swap, eh? + + check-gt == [gt-bignum] [swap [not] dipd] [] ifte + +Now we subtract the digits: + + sign [c b a] [z y x] sub-digits cons + +So: + + sub-like-bignums == [uncons] dip rest check-gt sub-digits cons + + sub-digits == initial-carry sub-digits' + + sub-digits' == + [sub-carry-from-digits] + [swap sub-carry] + [sub-with-carry] + build-two-list-combiner + genrec + +We just need to define the pieces. + +#### `sub-with-carry` + +We know we will never be subtracting a larger (absolute) number from a smaller (absolute) number (they might be equal) so the carry flag will never be true *at the end of a digit list subtraction.* + + carry a b sub-with-carry + ------------------------------ + (a-b-carry) new-carry + + _sub-with-carry0 ≡ [bool-to-int] dipd - - + _sub-with-carry1 ≡ [base + base mod] [0 <] clop + + sub-with-carry ≡ _sub-with-carry0 _sub-with-carry1 + + + +```Joy +[_sub-with-carry0 rolldown bool-to-int [-] ii] inscribe +[_sub-with-carry1 [base + base mod] [0 <] cleave] inscribe +[sub-with-carry _sub-with-carry0 _sub-with-carry1] inscribe +``` + + + + +```Joy +clear false 3 base -- +``` + + false 3 9 + + +```Joy +sub-with-carry +``` + + 4 true + + +```Joy +clear +``` + + + +#### `sub-carry-from-digits` + +Should be easy to make modeled on `add-carry-to-digits`, another very simple recursive function. The predicate, base case, and `R1` are the same: + + carry [n ...] sub-carry-from-digits + carry [n ...] [pop not] [popd] [_scfd_R0] [i cons] genrec + +That leaves the recursive branch: + + true [n ...] _scfd_R0 [sub-carry-from-digits] i cons + +-or- + + true [] _scfd_R0 [sub-carry-from-digits] i cons + +**Except** that this should should never happen when subtracting, because we already made sure that we're only ever subtracting a number less than or equal to the, uh, number we are subtracting from (TODO rewrite this trainwreck of a sentence). + + true [a ...] _scfd_R0 [sub-carry-from-digits] i cons + ---------------------------------------------------------------- + true 0 a add-with-carry [...] [sub-carry-from-digits] i cons + ------------------------------------------------------------------ + (a+1) carry [...] [sub-carry-from-digits] i cons + + + true [a ...] _scfd_R0 + true [a ...] 0 swap uncons [sub-with-carry] dip + true 0 [a ...] uncons [sub-with-carry] dip + true 0 a [...] [sub-with-carry] dip + true 0 a sub-with-carry [...] + + _scfd_R0 == 0 swap uncons [sub-with-carry] dip + +But there's a problem! This winds up subtracting `a` from 0 rather than the other way around: + + _scfd_R0 == uncons 0 swap [sub-with-carry] dip + + +```Joy +[sub-carry-from-digits + [pop not] + [popd] + [_scfd_R0] + [i cons] + genrec +] inscribe +[_scfd_R0 uncons 0 swap [sub-with-carry] dip] inscribe +``` + + + +Try it out: + + +```Joy +clear + +false [3 2 1] sub-carry-from-digits +``` + + [3 2 1] + + +```Joy +clear + +true [0 1] sub-carry-from-digits +``` + + [9 0] + + +```Joy +clear + +true [3 2 1] sub-carry-from-digits +``` + + [2 2 1] + + +```Joy +clear + +true [0 0 1] sub-carry-from-digits +``` + + [9 9 0] + + +```Joy +clear +``` + + + +But what about those leading zeroes? + +We could use a version of `cons` that refuses to put 0 onto an empty list? + + cons-but-not-leading-zeroes == [[bool] ii | not] [popd] [cons] ifte + + +```Joy +[cons-but-not-leading-zeroes [[bool] ii | not] [popd] [cons] ifte] inscribe +``` + + + + +```Joy +[sub-carry-from-digits + [pop not] + [popd] + [_scfd_R0] + [i cons-but-not-leading-zeroes] + genrec +] inscribe +``` + + + + +```Joy +[_scfd_R0 uncons 0 swap [sub-with-carry] dip] inscribe +``` + + + + +```Joy +clear + +true [0 0 1] sub-carry-from-digits +``` + + [9 9] + + +```Joy +clear +``` + + + +#### `sub-carry` + + sub-carry == pop + + +```Joy +[sub-like-bignums [uncons] dip rest check-gt sub-digits cons] inscribe +[sub-digits initial-carry sub-digits'] inscribe +[sub-digits' + [sub-carry-from-digits] + [swap pop] + [sub-with-carry] + build-two-list-combiner + genrec +] inscribe +``` + + + + +```Joy +clear +true [3 2 1] [6 5 4] +``` + + true [3 2 1] [6 5 4] + + +```Joy +check-gt initial-carry +``` + + false false [6 5 4] [3 2 1] + + +```Joy +sub-digits' +``` + + false [3 3 3] + + +```Joy +clear +12345 to-bignum 109 to-bignum +``` + + [true 5 4 3 2 1] [true 9 0 1] + + +```Joy +sub-like-bignums +``` + + [true 6 3 2 2 1] + + +```Joy +from-bignum +``` + + 12236 + + +```Joy +clear +``` + + + +#### `neg-bignum` + + +```Joy +[neg-bignum [not] infra] inscribe +``` + + + + +```Joy +123 +``` + + 123 + + +```Joy +to-bignum neg-bignum from-bignum +``` + + -123 + + +```Joy +to-bignum neg-bignum from-bignum +``` + + 123 + + +```Joy +clear +[sub-bignums [same-sign] [sub-like-bignums] [neg-bignum add-like-bignums] ifte] inscribe +[add-bignums [same-sign] [add-like-bignums] [neg-bignum sub-like-bignums] ifte] inscribe +``` + + + +## Multiplication + + + + +```Joy + +``` + +## Appendix: Source Code + clear + [base 2147483648] + [ditch-empty-list [bool] [popd] [pop] ifte] + [bool-to-int [0] [1] branch] + [uncons-two [uncons] ii swapd] + [sandwich swap [cons] dip swoncat] + + [digitalize [0 <=] [pop []] [base divmod swap] [i cons] genrec] + [to-bignum [!-] [abs digitalize] cleave cons] + + [prep rest 1 0 rolldown] + [from-bignum′ [next-digit] step popd] + [next-digit [increase-power] [accumulate-digit] clop popdd] + [increase-power popop base *] + [accumulate-digit rolldown * +] + + [sign-int [first] [prep from-bignum′] cleave] + [neg-if-necessary swap [neg] [] branch] + [from-bignum sign-int neg-if-necessary] + + [add-with-carry _add-with-carry0 _add-with-carry1] + [_add-with-carry0 [bool-to-int] dipd + +] + [_add-with-carry1 base [mod] [>=] clop] + + [add-carry-to-digits [pop not] [popd] [actd.R0] [i cons] genrec] + [actd.R0 [bool] [actd.R0.then] [actd.R0.else] ifte] + [actd.R0.else popd 1 false rolldown] + [actd.R0.then 0 swap uncons [add-with-carry] dip] + + [add-digits initial-carry add-digits'] + [initial-carry false rollup] + + [add-digits' [P] [THEN] [R0] [R1] genrec] + [P [bool] ii & not] + [THEN [P'] [THEN'] [ELSE] ifte] + [R0 uncons-two [add-with-carry] dipd] + [R1 i cons] + [P' [bool] ii |] + [THEN' ditch-empty-list add-carry-to-digits] + [ELSE pop swap [] [1 swons] branch] + + [same-sign [first] ii xor not] + [add-like-bignums [uncons] dip rest add-digits cons] + [add-bignums [same-sign] [add-like-bignums] [neg-bignum sub-like-bignums] ifte] + + [build-two-list-combiner _btlc0 _btlc1 [i cons]] + [_btlc0.0 [[ditch-empty-list] swoncat] dip] + [_btlc0.1 [pop] swoncat] + [_btlc0.3 [_btlc0.0 _btlc0.1] dip] + [_btlc0.4 [uncons-two] [dipd] sandwich] + [_btlc0 _btlc0.3 _btlc0.4] + [_btlc1 [[ifte] ccons [P'] swons [P] swap] dip] + + [carry [] [1 swons] branch] + + [compare-pairs [bool not] [pop false] [[first [>=] infrst] [pop true]] [[rest] swoncat ifte] genrec] + [xR1 uncons-two [unit cons swons] dipd] + [xP [bool] ii & not] + [BASE [bool] [popop pop true] [[pop bool] [popop pop false] [popop compare-pairs] ifte] ifte] + [gt-bignum <<{} [xP] [BASE] [xR1] tailrec] + [check-gt [gt-bignum] [swap [not] dipd] [] ifte] + + [sub-carry pop] + + [sub-carry-from-digits [pop not] [popd] [_scfd_R0] [i cons-but-not-leading-zeroes] genrec] inscribe + [_scfd_R0 uncons 0 swap [sub-with-carry] dip] inscribe + [cons-but-not-leading-zeroes [P'] [cons] [popd] ifte] + + [sub-with-carry _sub-with-carry0 _sub-with-carry1] + [_sub-with-carry0 rolldown bool-to-int [-] ii] + [_sub-with-carry1 [base + base mod] [0 <] cleave] + + [sub-like-bignums [uncons] dip rest check-gt sub-digits cons] + [sub-digits initial-carry sub-digits'] + + enstacken [inscribe] step + + [add-carry-to-digits] + [swap carry] + [add-with-carry] + build-two-list-combiner + [genrec] ccons ccons + [add-digits'] swoncat + inscribe + + [sub-carry-from-digits] + [swap sub-carry] + [sub-with-carry] + build-two-list-combiner + [genrec] ccons ccons + [sub-digits'] swoncat + inscribe + + +### notes + +So far I have three formats for Joy source: + +- `def.txt` is a list of definitions (UTF-8), one per line, with no special marks. +- `foo ≡ bar baz...` lines in the `joy.py` embedded definition text, because why not? (Sometimes I use `==` instead of `≡` mostly because some tools can't handle the Unicode glyph. Like converting this notebook to PDF via LaTeX just omitted them.) +- `[name body] inscribe` Joy source code that literally defines new words in the dictionary at runtime. A text of those commands can be fed to the interpreter to customize it without any special processing (like the other two formats require.) + +So far I prefer the `def.txt` style but that makes it tricky to embed them automatically into the `joy.py` file. + +#### Refactoring + +We have `i cons` but that's pretty tight already, eh? + +However, `[i cons] genrec` is an interesting combinator. It's almost `tailrec` with that `i` combinator for the recursion, but then `cons` means it's a list-builder (an *anamorphism* if you go for that sort of thing.) + + simple-list-builder == [i cons] genrec + +And maybe: + + boolii == [bool] ii + + both? == boolii & + one-of? == boolii | + diff --git a/docs/source/notebooks/Generator_Programs.md b/docs/source/notebooks/Generator_Programs.md index a3c500c..e7354d0 100644 --- a/docs/source/notebooks/Generator_Programs.md +++ b/docs/source/notebooks/Generator_Programs.md @@ -294,66 +294,72 @@ Lastly: Putting it all together: F == + [popdd over] cons infra uncons - fib_gen == [1 1 F] -Let's call `F` `fib_gen`: +### `fib-gen` - [fib_gen + [popdd over] cons infra uncons] inscribe +Let's call `F` `fib-gen`: + + [fib-gen + [popdd over] cons infra uncons] inscribe We can just write the initial quote and then "force" it with `x`: - joy? [1 1 fib_gen] 10 [x] times - 1 2 3 5 8 13 21 34 55 89 [144 89 fib_gen] + joy? [1 1 fib-gen] 10 [x] times + 1 2 3 5 8 13 21 34 55 89 [144 89 fib-gen] It skips the first term (1) but if that bothers you you can just prepend it to the program: - 1 [1 1 fib_gen] 10 [x] times + 1 [1 1 fib-gen] 10 [x] times + ## Project Euler Problem Two > By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms. -Now that we have a generator for the Fibonacci sequence, we need a function that adds a term in the sequence to a sum if it is even, and `pop`s it otherwise. +Now that we have a generator for the Fibonacci sequence, we need a function that adds +a term in the sequence to a sum if it is even, and `pop`s it otherwise. +### `even` -```python -define('PE2.1 == dup 2 % [+] [pop] branch') -``` + [even 2 % bool] inscribe + +### `PE2.1` + + [PE2.1 dup even [+] [pop] branch] inscribe And a predicate function that detects when the terms in the series "exceed four million". +### `>4M` -```python -define('>4M == 4000000 >') -``` + [>4M 4000000 >] inscribe -Now it's straightforward to define `PE2` as a recursive function that generates terms in the Fibonacci sequence until they exceed four million and sums the even ones. - - -```python -define('PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec') -``` - - -```python -J('PE2') -``` +Now it's straightforward to define `PE2` as a recursive function that generates terms +in the Fibonacci sequence until they exceed four million and sums the even ones. + joy? 0 [1 1 fib-gen] x [pop >4M] [popop] [[PE2.1] dip x] tailrec 4613732 +### `PE2` -Here's the collected program definitions: + [PE2 0 [1 1 fib-gen] x [pop >4M] [popop] [[PE2.1] dip x] tailrec] inscribe - fib == + swons [popdd over] infra uncons - fib_gen == [1 1 fib] +Here's the collected program definitions (with a little editorializing): - even == dup 2 % - >4M == 4000000 > + fib-gen + [popdd over] cons infra uncons + even 2 % bool + >4M 4000000 > + PE2.1 dup even [+] [pop] branch + PE2.2 [PE2.1] dip x + PE2.init 0 [1 1 fib-gen] x + PE2.rec [pop >4M] [popop] [PE2.2] tailrec + PE2 PE2.init PE2.rec - PE2.1 == even [+] [pop] branch - PE2 == 0 fib_gen x [pop >4M] [popop] [[PE2.1] dip x] primrec -### Even-valued Fibonacci Terms +### Hmm... + + fib-gen + swons [popdd over] infra uncons + + +## Even-valued Fibonacci Terms Using `o` for odd and `e` for even: @@ -363,93 +369,116 @@ Using `o` for odd and `e` for even: So the Fibonacci sequence considered in terms of just parity would be: - o o e o o e o o e o o e o o e o o e - 1 1 2 3 5 8 . . . + o o e o o e o o e o o e . . . + 1 1 2 3 5 8 13 21 34 55 89 144 . . . Every third term is even. +So what if we drive the generator three times and discard the odd terms? +We would have to initialize our `fib` generator with 1 0: + [1 0 fib-gen] -```python -J('[1 0 fib] x x x') # To start the sequence with 1 1 2 3 instead of 1 2 3. -``` +### `third-term` - 1 1 2 [3 2 fib] + [third-term x x x [popop] dipd] inscribe +So: -Drive the generator three times and `popop` the two odd terms. + joy? [1 0 fib-gen] + [1 0 fib-gen] + + joy? third-term + 2 [3 2 fib-gen] + + joy? third-term + 2 8 [13 8 fib-gen] + + joy? third-term + 2 8 34 [55 34 fib-gen] + + joy? third-term + 2 8 34 144 [233 144 fib-gen] +So now we need a sum: -```python -J('[1 0 fib] x x x [popop] dipd') -``` + joy? 0 + 0 - 2 [3 2 fib] +And our Fibonacci generator: + joy? [1 0 fib-gen] + 0 [1 0 fib-gen] +We want to generate the initial term: -```python -define('PE2.2 == x x x [popop] dipd') -``` + joy? third-term + 0 2 [3 2 fib-gen] +Now we check if the term is less than four million, +if so we add it and recur, +otherwise we discard the term and the generator leaving the sum on the stack: -```python -J('[1 0 fib] 10 [PE2.2] times') -``` - - 2 8 34 144 610 2584 10946 46368 196418 832040 [1346269 832040 fib] - - -Replace `x` with our new driver function `PE2.2` and start our `fib` generator at `1 0`. - - -```python -J('0 [1 0 fib] PE2.2 [pop >4M] [popop] [[PE2.1] dip PE2.2] primrec') -``` - + joy? [pop >4M] [popop] [[PE2.1] dip third-term] tailrec 4613732 +## Math -## How to compile these? -You would probably start with a special version of `G`, and perhaps modifications to the default `x`? + a b + b a+b + a+b a+b+b + a+b+b a+a+b+b+b -## An Interesting Variation +So if (a,b) and a is even then the next even term pair is (a+2b, 2a+3b) + +Reconsider: + + [b a F] x + [b a F] b a F + +From here we want to arrive at: + + (a+2b) [(2a+3b) (a+2b) F] + + b a F + b a [F0] [F1] fork + + b a over [+] ii + --------------------- + a+2b + +And: + + b a over [dup + +] ii + --------------------------- + 2a+3b -```python -define('codireco == cons dip rest cons') -``` + [over [dup + +] ii] [over [+] ii] clop + roll< rrest [tuck] dip ccons -```python -V('[0 [dup ++] codireco] x') -``` + [b a F] b a F - . [0 [dup ++] codireco] x - [0 [dup ++] codireco] . x - [0 [dup ++] codireco] . 0 [dup ++] codireco - [0 [dup ++] codireco] 0 . [dup ++] codireco - [0 [dup ++] codireco] 0 [dup ++] . codireco - [0 [dup ++] codireco] 0 [dup ++] . cons dip rest cons - [0 [dup ++] codireco] [0 dup ++] . dip rest cons - . 0 dup ++ [0 [dup ++] codireco] rest cons - 0 . dup ++ [0 [dup ++] codireco] rest cons - 0 0 . ++ [0 [dup ++] codireco] rest cons - 0 1 . [0 [dup ++] codireco] rest cons - 0 1 [0 [dup ++] codireco] . rest cons - 0 1 [[dup ++] codireco] . cons - 0 [1 [dup ++] codireco] . + [b a F] (2a+3b) (a+2b) roll< + (2a+3b) (a+2b) [b a F] rrest + (2a+3b) (a+2b) [F] [tuck] dip ccons + joy? [1 0 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons] + [1 0 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons] + + joy? x + 2 [3 2 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons] + + joy? x + 2 8 [13 8 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons] + + joy? x + 2 8 34 [55 34 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons] + + joy? x + 2 8 34 144 [233 144 [over [dup + +] ii] [over [+] ii] clop roll< rrest [tuck] dip ccons] -```python -define('G == [codireco] cons cons') -``` - - -```python -J('230 [dup ++] G 5 [x] times pop') -``` - - 230 231 232 233 234 +And so it goes...