Checkpoint; not sure where this code is, but I'm rethinking.

2018-10-27 15:10:19 -07:00
parent b30fe6a75f
commit 43b73139cd
248 changed files with 801610 additions and 516822 deletions
--- a/test.hs
+++ b/test.hs
@@ -0,0 +1,104 @@
+import Data.Bits
+import Numeric
+
+a :: Integer
+a = 0xffffffffffffffffffffffffffffffffa275ec6d0ffbb359
+
+b :: Integer
+b = 0xffffffffffffffffffffffffffffffffa14e39a19260951d
+
+outs :: Integer
+outs = -0x9124a315de33a9
+
+outt :: Integer
+outt = 0x180b603717d35f66
+
+outg :: Integer
+outg = 1
+
+x :: Integer
+y :: Integer
+g :: Integer
+(x, y, g) = loop a b 1
+ where loop x y g
+         | even x && even y = loop (x `shiftR` 1) (y `shiftR` 1) (g `shiftL` 1)
+         | otherwise        = (x, y, g)
+
+u0 :: Integer
+u0 = x
+
+v0 :: Integer
+v0 = y
+
+bigA0 :: Integer
+bigA0 =  1
+
+bigB0 :: Integer
+bigB0 =  0
+
+bigC0 :: Integer
+bigC0 =  0
+
+bigD0 :: Integer
+bigD0 =  1
+
+step4 :: (Integer, Integer, Integer, Integer, Integer, Integer) ->
+         (Integer, Integer, Integer, Integer, Integer, Integer)
+step4 (u, v, bigA, bigB, bigC, bigD) = (resu, v, resA, resB, bigC, bigD)
+ where
+   (resu, resA, resB) = step4 u bigA bigB
+   step4 inu inA inB
+     | even inu = let outu = inu `div` 2
+                  in if even inA && even inB
+                       then step4 outu (inA `div` 2) (inB `div` 2)
+                       else step4 outu ((inA + y) `div` 2) ((inB - x) `div` 2)
+     | otherwise = (inu, inA, inB)
+
+step5 :: (Integer, Integer, Integer, Integer, Integer, Integer) ->
+         (Integer, Integer, Integer, Integer, Integer, Integer)
+step5 (u, v, bigA, bigB, bigC, bigD) = (u, resv, bigA, bigB, resC, resD)
+ where
+   (resv, resC, resD) = step5 v bigC bigD
+   step5 inv inC inD
+     | even inv = let outv = inv `div` 2
+                  in if even inC && even inD
+                       then step5 outv (inC `div` 2) (inD `div` 2)
+                       else step5 outv ((inC + y) `div` 2) ((inD - x) `div` 2)
+     | otherwise = (inv, inC, inD)
+
+step6 :: (Integer, Integer, Integer, Integer, Integer, Integer) ->
+         (Integer, Integer, Integer, Integer, Integer, Integer)
+step6 (u, v, bigA, bigB, bigC, bigD)
+  | u >= v    = (u - v, v, bigA - bigC, bigB - bigD, bigC, bigD)
+  | otherwise = (u, v - u, bigA, bigB, bigC - bigA, bigD - bigB)
+
+iteration :: (Integer, Integer, Integer, Integer, Integer, Integer) ->
+             (Integer, Integer, Integer, Integer, Integer, Integer)
+iteration = step6 . step5 . step4
+
+state0 :: (Integer, Integer, Integer, Integer, Integer, Integer)
+state0 = (u0, v0, bigA0, bigB0, bigC0, bigD0)
+
+printIter :: (Integer, Integer, Integer, Integer, Integer, Integer) -> IO ()
+printIter (u, v, a, b, c, d) =
+  do printVal "u" u
+     printVal "v" v
+     printVal "A" a
+     printVal "B" b
+     printVal "C" c
+     printVal "D" d
+
+printVal :: String -> Integer -> IO ()
+printVal name x =
+  do putStr (name ++ ": ")
+     if x < 0
+        then putStr "-"
+        else putStr " "
+     let x' = abs x
+     putStrLn (showHex x' "")
+
+myImpl inState | u == 0    = outState
+               | otherwise = myImpl outState
+ where
+  outState@(u,_,_,_,_,_) = iteration inState
+