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
baseWe can inscribe a constant function base to keep this value handy.
2147483648
joy? unit [base] swoncat
[base 2147483648]
joy? inscribe
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 hands 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.
[base 10] inscribe
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:
moddivWe 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.
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?
digitalizeLet'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
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-digitLet'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.
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-bignumThis gives:
[from-bignum [from-bignum′] [first] cleave [neg] [] branch] inscribe
[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
add-digitsLet'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:
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 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 \/
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.
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-carryTo 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
add-carry-to-digitsThis 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
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.
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
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
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-twoWe 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-digitsadd-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-bignumsThere 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...
We'll get to those in a moment, but first an interlude.
list-combinerLet's review the form of our function add-digits (eliding the preamble
false rollup) and add-digits.THEN:
add-digits′ == [add-digits.P] [add-digits.THEN] [add-digits.R0] [add-digits.R1] genrec
add-digits.THEN == [add-digits.THEN.P] [add-digits.THEN.THEN] [add-digits.THEN.ELSE] ifte
Recall also:
add-digits.P == [null] ii \/
add-digits.THEN.P == [null] ii /\
Generalizing the names:
F == [P] [THEN] [R0] [R1] genrec
THEN == [THEN.P] [THEN.THEN] [THEN.ELSE] ifte
With auxiliary definitions:
null-two == [null] ii
both-null == null-two /\
either-or-both-null == null-two \/
Rename predicates:
F == [either-or-both-null] [THEN] [R0] [R1] genrec
THEN == [both-null] [THEN.THEN] [THEN.ELSE] ifte
Substitute THEN:
F == [either-or-both-null] [[both-null] [THEN.THEN] [THEN.ELSE] ifte] [R0] [R1] genrec
This is a little awkward, so let's pretend that we have a new combinator
two-list-genrec that accepts four quotes and does F:
F == [THEN.THEN] [THEN.ELSE] [R0] [R1] two-list-genrec
So THEN.THEN handles the (non-recursive) case of both lists being
empty, THEN.ELSE handles the (non-recursive) case of one or the other
list being empty, and R0 [F] R1 handles the (recursive) case of both
lists being non-empty.
Recall that our R1 is just i cons, we can fold that in to the
definition of another new combinator that combines two lists into one:
list-combiner-genrec == [i cons] two-list-genrec
So:
F == [both-empty] [one-empty] [both-non-empty] list-combiner-genrec
Then for add-digits′ we would have:
both-empty == pop swap [] [1 swons] branch
one-empty == ditch-empty-list add-carry-to-digits
both-non-empty == uncons-two [add-with-carry] dipd
add-digits′ == [both-empty] [one-empty] [both-non-empty] list-combiner-genrec
Which would expand into:
add-digits′ == [either-or-both-null]
[[both-null] [both-empty] [one-empty] ifte]
[both-non-empty]
[i cons]
genrec
It's pretty straight forward to make a functions that converts the three
quotes into the expanded form (a kind of "macro") but you might want to
separate that from the actual genrec evaluation. It would be better to
run the "macro" once, append the [genrec] quote to the resulting form,
and inscribe that, rather than putting the "macro" into the definition.
That way you avoid re-evaluating the "macro" on each iteration.
The simplification of the expanded form to the simpler version by coining
the list-combiner-genrec function is the "semantic compression" aspect
of factoring. If you choose your seams and names well, the code is
(relatively) self-descriptive.
In any event, now that we know what's going on, we don't actually need the "macro", we can just write out the expanded version directly.
Source code:
[null-two [null] ii] inscribe
[both-null null-two /\] inscribe
[either-or-both-null null-two \/] inscribe
[add-digits.both-empty pop swap [] [1 swons] branch] inscribe
[add-digits.one-empty ditch-empty-list add-carry-to-digits] inscribe
[add-digits.both-non-empty uncons-two [add-with-carry] dipd] inscribe
[add-digits′ [either-or-both-null] [[both-null] [add-digits.both-empty] [add-digits.one-empty] ifte] [add-digits.both-non-empty] [i cons] genrec] inscribe
neg-bignumWell, that was fun! And we'll reuse it in a moment when we derive sub-bignums.
But for now let's clear our palate with a nice simple function: neg-bignum.
To negate a Joy bignum you just invert the Boolean value at the head of the list.
neg-bignum == [not] infra
Subtraction is similar to addition in that it's a simple recursive algorithm that works digit-by-digit.
It has the same three cases as well, so we can reuse the list-combiner-genrec "macro" that
we specified (but did not yet derive) a moment ago.
sub-digits == initial-carry sub-digits'
sub-digits' == [both-empty] [one-empty] [both-non-empty] list-combiner-genrec
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.
lengthGentle reader, it was at this time that I realized I don't have a list length function yet!
[length [pop ++] step_zero] inscribe
We only need to compare the digits of the numbers if one list of digits is longer than the other.
We could use length on both lists and then cmp:
a b [G] [E] [L] cmp
If the top list is longer than the second list the function should return true,
and if the top list is shorter than the second list the function should return false,
dup2 [length] ii [true] [E] [false] cmp
If both lists are non-empty we have to compare digits starting with the ends.
E == zip reverse compare-digits
But this is inefficient! The length function will traverse each list once,
then the zip function will traverse both lists and build a new list of pairs,
then the reverse function will traverse that list and rebuild it,
then the compare-digits will traverse that list looking for unequal pairs...
It's a lot of work that we don't really want or need to do.
What we really want is a function that iterates through both lists together and:
false.true.uncons-two digits for later comparison and recur.Let's start designing the function.
[...] [...] F
-------------------
bool
We will need a list on which to put pairs
F == <<{} F′
[] [...] [...] F′
----------------------
bool
It's a recursive function:
F′ == [P] [THEN] [R0] [R1] genrec
The predicate tests whether both of the two input lists are non-empty:
P = null-two \/
(We defined this as either-or-both-null above.)
Let's look at the recursive case first:
[...] [b ...] [a ...] R0 [F] R1
-------------------------------------------
[[b a] ...] [...] [...] F
So R0 transfers items from the source list to the pairs list,
let's call it shift-pair:
[...] [b ...] [a ...] shift-pair
--------------------------------------
[[b a] ...] [...] [...]
I'll leave that as an exercise for the reader for now.
R1 is just i (this is a tailrec function.)
F == <<{} [either-or-both-null] [THEN] [shift-pair] tailrec
Now let's derive THEN, there are three cases:
[pairs...] [] [] THEN
[pairs...] [b ...] [] THEN
[pairs...] [] [a ...] THEN
We can model this as a pair of ifte expressions, one nested in the other:
[P] [THEN′] [[P′] [THEN′′] [ELSE′] ifte] ifte
But in the event we won't need the inner ifte, see below.
The first predicate should check if both lists are empty:
P == null-two /\
(We defined this as both-null above.)
If both lists are empty we check the pairs:
THEN′ == popop compare-pairs
Otherwise if the top list is empty we return false, otherwise true,
and since this is a destructive operation we don't have to use ifte here:
THEN == [both-null] [popop compare-pairs] [popopd null] ifte
F == <<{} [either-or-both-null] [THEN] [shift-pair] tailrec
Now we just have to write compare-pairs (and shift-pair.)
shift-pair[pair-up unit cons] inscribe
[shift-pair uncons-two [pair-up swons] dipd] inscribe
This function takes a list of pairs of digits (ints) and compares them until it finds an unequal pair or runs out of pairs.
We are implementing "greater than" (b > a) so if we run out of digits
that means the two numbers were equal, and so we return false:
F == [null] [pop false] [R0] [R1] genrec
That leaves the recursive branch:
[[b a] ...] R0 [F] R1
I figure we're going to want some sort of ifte. (But this turns out to
be a mistake!)
[[b a] ...] [P] [THEN] [F] ifte
if b > a we can stop and report true, otherwise we discard the pair and recur.
P == first i >
THEN == pop true
Note that that fails to discard the pair!
[[b a] ...] [first i >] [pop true] [F] ifte
If b <= a this would just re-run F with the same list!
Oops! D'oh! I didn't think it through properly.
We need to distinguish all three case (> = <) so we want to use cmp:
[[b a] ...] unswons i [G] [F] [L] cmp
Becomes:
[...] b a [G] [F] [L] cmp
Note that we recur on equality (that is our E function is just F itself).
If we the digits are not equal we can quit the loop with the answer:
[...] b a [pop true] [F] [pop false] cmp
So:
R0 == unswons i [pop true]
R1 == [pop false] cmp
compare-pairs[compare-pairs.R0 unswons i [pop true]] inscribe
[compare-pairs.R1 [pop false] cmp] inscribe
[compare-pairs [null] [pop false] [compare-pairs.R0] [compare-pairs.R1] genrec] inscribe
gt-digits[gt-digits.THEN [both-null] [popop compare-pairs] [popopd null] ifte] inscribe
[gt-digits <<{} [either-or-both-null] [gt-digits.THEN] [shift-pair] tailrec] inscribe
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-digits] [swap true] [false] ifte
To keep the decision around as a Boolean flag? We can xor it with the sign bit?
Let's start with two numbers on the stack, with the same sign:
[bool int int int] [bool int int int]
Then we keep one of the sign Booleans around and discard the other:
[bool int int int] [bool int int int] [uncons] dip rest
[bool int int int] uncons [bool int int int] rest
bool [int int int] [bool int int int] rest
bool [int int int] [int int int]
So what we really want to do is swap and not:
check-gt == [gt-digits] [swap [not] dipd] [] ifte
extract-sign[extract-sign [uncons] dip rest] inscribe
check-gt[check-gt [gt-bignum] [swap [not] dipd] [] ifte] inscribe
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 == extract-sign check-gt sub-digits cons
sub-digits == initial-carry sub-digits'
initial-carry == false rollup
both-empty == pop swap [] [1 swons] branch
one-empty == ditch-empty-list sub-carry-from-digits
both-non-empty == uncons-two [sub-with-carry] dipd
sub-digits′ == [both-empty] [one-empty] [both-non-empty] list-combiner-genrec
Which would expand into:
sub-digits′ == [either-or-both-null]
[[both-null] [both-empty] [one-empty] ifte]
[both-non-empty]
[i cons]
genrec
sub-digits′ == [either-or-both-null] [[both-null] [both-empty] [ditch-empty-list sub-carry-from-digits] ifte] [uncons-two [sub-with-carry] dipd] [i cons] genrec
We just need to define the pieces.
sub-with-carryWe 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-carry.0 - swap [] [--] branch] inscribe
[sub-with-carry.1 [base + base mod] [0 <] cleave] inscribe
[sub-with-carry sub-with-carry.0 sub-with-carry.1] inscribe
sub-carry-from-digitsShould 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] [R0] [i cons] genrec
That leaves the recursive branch:
true [n ...] R0 [sub-carry-from-digits] i cons
-or-
true [] R0 [sub-carry-from-digits] i cons
Except that this latter case 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.
true [a ...] R0 [sub-carry-from-digits] i cons
----------------------------------------------------------------
true 0 a sub-with-carry [...] [sub-carry-from-digits] i cons
------------------------------------------------------------------
(a-1) carry [...] [sub-carry-from-digits] i cons
It would work like this:
true [a ...] 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 [...]
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:
R0 == uncons 0 swap [sub-with-carry] dip
sub-carry-from-digits[sub-carry-from-digits.R0 uncons 0 swap [sub-with-carry] dip] inscribe
[sub-carry-from-digits [pop not] [popd] [sub-carry-from-digits.R0] [i cons] genrec] 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]
But what about those leading zeroes?
cons-but-not-leading-zeroes and sub-carry-from-digitsWe 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] inscribe
[sub-carry-from-digits [pop not] [popd] [sub-carry-from-digits.R0] [i cons-but-not-leading-zeroes] genrec] inscribe
Good enough:
joy? clear true [0 1] sub-carry-from-digits
[9]
joy? clear true [0 0 1] sub-carry-from-digits
[9 9]
sub-carrysub-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-bignumJoy
[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
```Joy
```
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
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.
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 |