Fix higher-order cpu, also corrected in paper
authorChristiaan Baaij <baaijcpr@wlan228123.mobiel.utwente.nl>
Wed, 3 Mar 2010 13:23:57 +0000 (14:23 +0100)
committerChristiaan Baaij <baaijcpr@wlan228123.mobiel.utwente.nl>
Wed, 3 Mar 2010 13:23:57 +0000 (14:23 +0100)
HigherOrderCPU.hs
cλash.lhs

index 94bb7b6..8833766 100644 (file)
@@ -14,32 +14,26 @@ type Index  = RangedWord
 
 const a b = a
 
-fu op inputs (addr1, addr2) out =
-  (out', out)
+fu op inputs (addr1, addr2) = regIn
   where
-    in1  = inputs!addr1
-    in2  = inputs!addr2
-    out' = op in1 in2
+    in1   = inputs!addr1
+    in2   = inputs!addr2
+    regIn = op in1 in2
 
 type CpuState = State (Vector D4 Word)
 
 {-# ANN cpu TopEntity #-}
 {-# ANN cpu (InitState 'cpuState) #-}
-cpu :: 
-  Word 
-  -> Vector D4 (Index D6, Index D6)
-  -> CpuState
+cpu :: CpuState -> Word -> Vector D4 (Index D6, Index D6)
   -> (CpuState, Word)
-cpu input addrs (State fuss) =
-  (State fuss', out)
+cpu (State fuss) input addrs = (State fuss', out)
   where
-    fures = (fu const inputs (addrs!(0 :: Index D3)) (fuss!(0 :: Index D3))) +> (
-            (fu (+)   inputs (addrs!(1 :: Index D3)) (fuss!(1 :: Index D3))) +> (
-            (fu (-)   inputs (addrs!(2 :: Index D3)) (fuss!(2 :: Index D3))) +> (
-            (fu (*)   inputs (addrs!(3 :: Index D3)) (fuss!(3 :: Index D3))) +> empty)))
-    (fuss', outputs) = unzip fures
-    inputs = 0 +> (1 +> (input +> outputs))
-    out = head outputs
+    fuss'   = (fu const inputs (addrs!(0 :: Index D3))) +> (
+              (fu (+)   inputs (addrs!(1 :: Index D3))) +> (
+              (fu (-)   inputs (addrs!(2 :: Index D3))) +> (
+              (fu (*)   inputs (addrs!(3 :: Index D3))) +> empty)))
+    inputs  = 0 +> (1 +> (input +> fuss))
+    out     = head fuss
 
 cpuState :: Vector D4 Word
 cpuState = copy 0
\ No newline at end of file
index a1fadea..95c7738 100644 (file)
@@ -1207,10 +1207,10 @@ cpu :: Word -> [(Index 6, Index 6) | 4]
   -> State [Word | 4] -> (State [Word | 4], Word)
 cpu input addrs (State fuss) = (State fuss', out)
   where
-    fuss' =   [ fu const  inputs (addrs!0) (fuss!0)
-              , fu (+)    inputs (addrs!1) (fuss!1)
-              , fu (-)    inputs (addrs!2) (fuss!2)
-              , fu (*)    inputs (addrs!3) (fuss!3)
+    fuss' =   [ fu const  inputs (addrs!0)
+              , fu (+)    inputs (addrs!1)
+              , fu (-)    inputs (addrs!2)
+              , fu (*)    inputs (addrs!3)
               ]
     inputs    = 0 +> (1 +> (input +> fuss))
     out       = head fuss