That's alotta nands!

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
import Prelude hiding (and, or, not, add)
import Control.Boolean          -- http://lpaste.net/108295
import Analytics.Theory.Number  -- http://lpaste.net/107480 -- for pow

{--

A solution to the boolean arithmetic problem posted at http://lpaste.net/108358

The meta language:

Given the operators from yesterday (and, or, not, etc), and only one data type, 
Bool, okay: two data types, you can string the bool values together with 
whatever array-like structure you choose (list, deque, vector, array, pick one).

Define the arithmetic operators: addition, subtraction, multiplication,
exponentiation.

Bonus, define division.

The machine language:

Reduce the arithmetic operators to a set of combinations of a single boolean
operator. How are these arithmetic operators defined? How did you manage carry?

 --}

-- we use the least-significant-bit-first implementation of binary numbers:

data BNum = B [Bool]

bzero = B []

-- The approach for add:

-- tt: tt = f, tf = t, ft = t, ff = f           -- xor
-- tt for the carry bit: tt = t, otherwise f    -- and

-- splitter = t = t,t, f = f,f

add :: BNum -> BNum -> BNum
add (B a) (B b) = B $ add' a b False

add' :: [Bool] -> [Bool] -> Bool -> [Bool]
add' (h1:t1) (h2:t2) carry = 
   xor (xor h1 h2) carry : add' t1 t2 (or carry (and h1 h2))
add' [] [] carry = appendCarry [] carry
add' list [] carry = add' list [carry] False
add' [] list carry = add' [carry] list False

appendCarry :: [Bool] -> Bool -> [Bool]
appendCarry list False = list
appendCarry list True  = list ++ [True]

{--

*Main> B $ replicate 6 True
B63
*Main> add it (B [True, True, False])
B66
*Main> B $ replicate 6 True
B63
*Main> add it (B [True, True])
B66
*Main> add (B [True, True]) (B [False, True, True])
B9
*Main> add (B [True, True]) (B [False, True])
B5

Now, add as a set of nand-instructions:

From Control.Boolean:

xor a b = not (equ a b)
   so not = nand True
   so equ a b = or (and a b) (nor a b)
      so or a b = nand (not a) (not b)
      so and a b = not (nand a b)
      so nor a b = not (or a b)

SO:

nand True (nand (nand True a) (nand True b)) 
   where a = and a b
         b = nor a b

SO:

nand True (nand (nand True (nand True (nand a b)))
                (nand True (nand True (nand (nand True a) (nand True b)))))

... and there you have it! YAY!

... um, actually, that's just xor. Let's prove that:

 --}

myxor :: Bool -> Bool -> Bool
myxor a b = nand True (nand (nand True (nand True (nand a b)))
                            (nand True (nand True (nand (nand True a)
                                                  (nand True b)))))

-- yep: testBool myxor == testBool xor ~> True

-- Wow.

-- But you get the point, xor reduces to those nands, then iterate.

mult :: BNum -> BNum -> BNum
mult (B a) (B b) = m' a [] []   -- we take the simple shift-add approach
   where m' [] _ sums = foldr add bzero sums
         m' (bit:rest) shift sums =
            m' rest (False:shift) (if bit then (B (shift ++ b)):sums else sums)

{--

Some multiplies:

*Main> mult (B [True, True]) (B [True, True])
B9
*Main> mult (B [False, False, True]) (B [False, True, True])
B24

 --}

-- a sample circuit that does multiplication is at:
-- https://en.wikipedia.org/wiki/Binary_multiplier

----- and helpful printy-like thingies to see what B-numbers we're working with

instance Num BNum where
   fromInteger x = B $ fromInt x
      where fromInt 0 = []
            fromInt x = let (d, m) = x `divMod` 2
                        in nb m : fromInt d
   a + b = add a b
   a * b = mult a b
   abs a = a
   signum a | toNum a == 0 = 0
            | otherwise    = 1

instance Show BNum where
   show bools = "B" ++ show (toNum bools)

toNum :: BNum -> Integer
toNum (B bools) = t' bools 0
   where t' [] _ = 0
         t' (h : t) n = bn h * pow 2 n + t' t (succ n)

bn :: Bool -> Integer
bn True = 1
bn False = 0

bc :: Bool -> Char
bc True = '1'
bc False = '0'

nb :: Integer -> Bool
nb 0 = False
nb 1 = True

bits :: BNum -> String
bits (B b) = b' b
   where b' [] = []
         b' (h : t) = bc h : b' t
112:48: Warning: Redundant bracket
Found:
(B (shift ++ b)) : sums
Why not:
B (shift ++ b) : sums
142:17: Warning: Use :
Found:
"B" ++ show (toNum bools)
Why not:
'B' : show (toNum bools)
163:10: Error: Use map
Found:
b' [] = []
b' (h : t) = bc h : b' t
Why not:
b' t = map bc t