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".)
1 31 lshift
We can inscribe a constant function base to keep this value handy.
unit
[base] swoncat
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:
[valid_digit [0 >] [base <] &&] inscribe
32 valid_digit 1232147483648 valid_digit
clear
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:
12345678901234567890 base divmod swap
base divmod swap
base divmod swap
We keep it up until we get to zero. This suggests a while loop:
[0 >=] [base divmod swap] while
clear 1234567890123456789012345678901234567890
[0 >] [base divmod swap] 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.
clear [1234567890123456789012345678901234567890]
[ [0 >] [base divmod swap] while pop ]
infra
We could just reverse the list, but it's more efficient to build the result list in the order we want, LSB to MSB:
clear 1234567890123456789012345678901234567890
[0 <=]
[pop []]
[base divmod swap]
[i cons]
genrec
This will return the empty list for zero:
clear
0 [0 <=] [pop []] [base divmod swap] [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"
Eh?
digitalize¶Let's inscribe this function under the name digitalize:
clear
[digitalize [0 <=] [pop []] [base divmod swap] [i cons] genrec] inscribe
Try it out:
clear
1234567890123456789012345678901234567890 digitalize
Putting it all together we have !- for the sign and abs digitalize for the digits, followed by cons:
clear 1234567890123456789012345678901234567890
[!-] [abs digitalize] cleave cons
clear
to-bigint¶[to-bigint [!-] [abs digitalize] cleave cons] inscribe
Try it out:
clear 1234567890123456789012345678901234567890 to-bigint
With negative numbers:
clear -1234567890123456789012345678901234567890 to-bigint
clear
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]
We will deal with the sign bit later.
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:
F == [G] [H] clop
Then I noticed that power * is a sub-function of both G and H, but let's not overthink it, eh?
G == popop base *
H == rolldown * +
F == [G] [H] clop popdd
clear 1 0 23 [popop base *] trace
clear 1 0 23 [rolldown * +] trace
clear 1 0 23
[popop base *]
[rolldown * +]
clop
popdd
clear
prep and from-bigint'¶[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
1 0 [1312754386 1501085485 57659106 105448366 58]
from-bigint'
to-bigint
prep
from-bigint'
to-bigint prep from-bigint'
What about that sign bit?
neg
to-bigint prep from-bigint'
That's no good, we lose the sign. Time to deal with that.
to-bigint
We want to get the sign bit and the Python int,
[first] [prep from-bigint'] cleave
and then use the sign bit to negate the Python int if the bigint was negative:
swap [] [neg] branch
This gives:
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¶clear
[foo [prep from-bigint'] [first] cleave] inscribe
[bar [neg] [] branch] inscribe
[from-bigint foo bar] inscribe
1234567890123456789012345678901234567890 to-bigint from-bigint
neg to-bigint from-bigint
clear
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'
I think we're going to want a recursive function (duh!?) 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.
bool [a ...] [b ...] P
The first thing to do is convert them to Booleans. Let's make a little truth table to work with:
clear
[
[[a] [b]]
[[a] []]
[[] [b]]
[[] []]
]
Then we can map our predicate over this list to be sure ti does what we want:
[[[bool] ii] infra] map
We want to and the bools and invert the result:
clear [[[a] [b]] [[a] []] [[] [b]] [[] []]]
[[[bool] ii & not] infra] map
So the predicate function we want here is:
P == [bool] ii & not
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
So we have an ifte expression:
THEN ≡ [P'] [THEN'] [ELSE] ifte
Let's define the predicate:
clear
[
[[a] []]
[[] [b]]
[[] []]
]
[[[bool] ii |] infra] map
P' ≡ [bool] 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.
In the cases where one of the two lists (but not both) is empty:
carry [a ...] [] THEN'
carry [] [b ...] THEN'
We first get rid of the empty list:
ditch-empty-list ≡ [bool] [popd] [pop] ifte
clear
[ditch-empty-list [bool] [popd] [pop] ifte] inscribe
Try it out:
[1][] ditch-empty-list
clear
[][1] ditch-empty-list
THEN' ≡ ditch-empty-list THEN''
Now we have:
carry [n ...] THEN''
This is add-carry-to-digits...
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
(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¶clear
[bool-to-int [0] [1] branch] inscribe
Try it out:
false bool-to-int
true bool-to-int
We can use this function to convert the carry flag to an integer and then add it to the sum of the two digits:
clear
false 1 2 [bool-to-int] dipd + +
clear
true 1 2 [bool-to-int] dipd + +
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:
clear
4 base [mod] [>=] clop
clear
base 100 +
base [mod] [>=] clop
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¶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:
clear
false base 100 add-with-carry
clear
true base 100 add-with-carry
clear
false 2 100 add-with-carry
clear
true 2 100 add-with-carry
clear
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
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
The base case simply discards the carry flag:
_actd_THEN ≡ popd
That leaves the recursive branch:
true [n ...] R0 [add-carry-to-digits] 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
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
----------------------------------------------------------------
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¶[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:
clear
false [3 2 1] add-carry-to-digits
clear
true [] add-carry-to-digits
clear
true [3 2 1] add-carry-to-digits
clear
true base -- [2 1] cons
add-carry-to-digits
clear
So that handles the cases where one of the two lists (but not both) is 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
[carry [] [1 swons] branch] inscribe
Try it out:
clear
true [] [] pop swap carry
clear
false [] [] pop swap carry
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
We just need to knock out those recursive functions R0 and R1 and we're done.
bool [a ...] [b ...] R0 [add-digits'] R1
First we will want to uncons the digits
clear
false [1 2 3] [4 5 6] [uncons] ii swapd
uncons-two¶We could call this uncons-two:
clear
[uncons-two [uncons] ii swapd] inscribe
[1 2 3] [4 5 6] uncons-two
clear
bool a b [...] [...] R0' [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 R0'' [add-digits'] R1
bool a b add-with-carry [...] [...] R0'' [add-digits'] R1
(a+b) bool [...] [...] R0'' [add-digits'] R1
If we postulate a cons in our R1 function...
(a+b) bool [...] [...] 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¶[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
[3 2 1] [1 1 1]
add-digits
base -- unit
add-digits
base -- dup dup unit ccons
add-digits
243 + 999 =
clear 243 999 +
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
But we haven't implemented neg-bigint or sub-bigints yet...
clear
123 to-bigint 456 to-bigint
[first] ii xor not
clear
123 to-bigint 456 to-bigint
[uncons] dip
rest
add-digits
cons
add-bigints¶[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
base -- to-bigint
add-bigints
clear
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
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]
[sandwich swap [cons] dip swoncat] inscribe
clear [B] [A] [C]
sandwich
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:
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
[A] [B] [C] _foo0
_foo1
clear
[add-carry-to-digits]
[swap carry]
[add-with-carry]
_foo0 _foo1
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
clear
[3 2 1] [6 5 4] initial-carry
[add-carry-to-digits]
[swap carry]
[add-with-carry]
_foo0 _foo1
[i cons] genrec
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
clear
[3 2 1] [6 5 4] initial-carry
combine-two-lists
genrec
[base 10] inscribe
clear
123456 to-bigint
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.
[add-carry-to-digits]
[swap carry]
[add-with-carry]
build-two-list-combiner
Now grab the definition, add the genrec and symbol (name) and inscribe it:
[genrec] ccons ccons [add-digits'] swoncat
inscribe
Try it out...
false [3 2 1] [4 3 2] add-digits'
false swap base -- unit
add-digits'
clear
add-bigints¶1234 999 [to-bigint] ii
add-bigints
from-bigint
1234 999 +
clear
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!
[length [pop ++] step_zero] inscribe
clear
[] length
clear
[this is a list] length
clear
[1 2 3] [4 5] over over [length] app2
[swap][6][7]cmp
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?
clear
[1 2 3] [4 5 6] [bool] ii &
clear
[1 2 3] [4 5 6]
[[bool] ii | not]
[pop]
[uncons-two]
[i [unit cons] dip cons]
genrec
clear
[1 2 3] [4 5 6]
[[bool] ii | not]
[pop]
[uncons-two]
[i [unit cons] dip cons]
genrec
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
[xR1 uncons-two [unit cons swons] dipd] inscribe
clear
[] [3 2 1] [4 5 6]
xR1 xR1 xR1
clear
[xP [bool] ii & not] inscribe
clear
[] [3 2 1] [5 4] [xP] [] [xR1] tailrec
clear
[] [3 2] [4 5 1] [xP] [] [xR1] tailrec
clear
[] [3 2 1] [5 4 3] [xP] [] [xR1] tailrec
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
clear
[][][1]
[bool]
[popop pop true]
[
[pop bool]
[popop pop false]
[popop 23 swons]
ifte
]
ifte
clear
[][1][]
[bool]
[popop pop true]
[
[pop bool]
[popop pop false]
[popop 23 swons]
ifte
]
ifte
clear
[1][][]
[bool]
[popop pop true]
[
[pop bool]
[popop pop false]
[popop 23 swons]
ifte
]
ifte
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
clear
[[1 3] [2 4] [3 5]] first [>] infrst
clear
[[1 3] [2 4] [3 5]] [[>] infrst] map
THEN.rec == pop true
clear
[compare-pairs
[bool not]
[pop false]
[
[first [>] infrst]
[pop true]
]
[ifte]
genrec
] inscribe
clear [[1 3] [2 4] [3 5]] compare-pairs
clear [[1 3] [3 3] [3 5]] compare-pairs
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!)
clear
[compare-pairs
[bool not]
[pop false]
[
[first [>=] infrst]
[pop true]
]
[[rest] swoncat ifte]
genrec
] inscribe
This is clunky and inefficient but it works.
clear [[1 0] [2 2] [3 3]] compare-pairs
clear [[1 1] [2 2] [3 3]] compare-pairs
clear [[1 2] [2 2] [3 3]] compare-pairs
clear
clear [[1 1] [2 1] [3 3]] compare-pairs
clear [[1 1] [2 2] [3 3]] compare-pairs
clear [[1 1] [2 3] [3 3]] compare-pairs
clear
[[1 1] [2 1] [3 3]] [] []
[bool]
[popop pop true]
[
[pop bool]
[popop pop false]
[popop compare-pairs]
ifte
]
ifte
[BASE
[bool]
[popop pop true]
[
[pop bool]
[popop pop false]
[popop compare-pairs]
ifte
]
ifte
] inscribe
clear
[] [3 2 1] [4 5 6]
[xP] [BASE] [xR1] tailrec
clear
[] [3 2 1] [4 5 6] swap
[xP] [BASE] [xR1] tailrec
clear
[] [3 2 1] dup
[xP] [BASE] [xR1] tailrec
clear
[gt-bigint <<{} [xP] [BASE] [xR1] tailrec] inscribe
clear [3 2 1] [4 5 6] gt-bigint
clear [3 2 1] [4 5 6] swap gt-bigint
clear [3 2 1] dup gt-bigint
clear [3 2 1] [4 5 6] [gt-bigint] [swap] [] ifte
clear [4 5 6] [3 2 1] [gt-bigint] [swap] [] ifte
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
To keep the decision around as a Boolean flag? We can xor it with the sign bit?
clear
[check-gt [gt-bigint] [swap [not] dipd] [] ifte] inscribe
false [4 5 6] [3 2 1]
check-gt
clear
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
^
|
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-bigint] [swap [not] dipd] [] ifte
Now we subtract the digits:
sign [c b a] [z y x] sub-digits cons
So:
sub-like-bigints == [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
[_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
clear false 3 base --
sub-with-carry
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
[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:
clear
false [3 2 1] sub-carry-from-digits
clear
true [0 1] sub-carry-from-digits
clear
true [3 2 1] sub-carry-from-digits
clear
true [0 0 1] sub-carry-from-digits
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
[cons-but-not-leading-zeroes [[bool] ii | not] [popd] [cons] ifte] inscribe
[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
clear
true [0 0 1] sub-carry-from-digits
clear
sub-carry¶sub-carry == pop
[sub-like-bigints [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
clear
true [3 2 1] [6 5 4]
check-gt initial-carry
sub-digits'
clear
12345 to-bigint 109 to-bigint
sub-like-bigints
from-bigint
clear
neg-bigint¶[neg-bigint [not] infra] inscribe
123
to-bigint neg-bigint from-bigint
to-bigint neg-bigint from-bigint
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
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-bigint [!-] [abs digitalize] cleave cons]
[prep rest 1 0 rolldown]
[from-bigint' [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]
[neg-if-necessary swap [neg] [] branch]
[from-bigint 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-bigints [uncons] dip rest add-digits cons]
[add-bigints [same-sign] [add-like-bigints] [neg-bigint sub-like-bigints] 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-bigint <<{} [xP] [BASE] [xR1] tailrec]
[check-gt [gt-bigint] [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-bigints [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 |