X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=b2ce3ef59d679f95afb9b8aa8010af708b4bd21b;hb=296146a80304f2763e7bc0d7d4f7cbe63036937b;hp=40362cd614f580969c834982be7a607f8eb3ab4a;hpb=75136a5c9de4712777d4800c01b16a33d9e5c839;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Translator.hs b/Translator.hs
index 40362cd..b2ce3ef 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -521,6 +521,9 @@ data HsValueUse =
   | State --- ^ Use it as state (input or output)
   deriving (Show, Eq)
 
+useAsPort = mkHsValueMap (\x -> Single Port)
+useAsState = mkHsValueMap (\x -> Single State)
+
 -- | This type describes a particular use of a Haskell function and is used to
 --   look up an appropriate hardware description.  
 data HsFunction = HsFunction {
@@ -556,21 +559,19 @@ mkHsFunction ::
 mkHsFunction f ty =
   HsFunction hsname hsargs hsres
   where
-    mkPort = mkHsValueMap (\x -> Single Port)
-    mkState = mkHsValueMap (\x -> Single State)
     hsname  = getOccString f
     (arg_tys, res_ty) = Type.splitFunTys ty
     -- The last argument must be state
     state_ty = last arg_tys
-    state    = mkState state_ty
+    state    = useAsState state_ty
     -- All but the last argument are inports
-    inports = map mkPort (init arg_tys)
+    inports = map useAsPort (init arg_tys)
     hsargs   = inports ++ [state]
     hsres    = case splitTupleType res_ty of
       -- Result type must be a two tuple (state, ports)
       Just [outstate_ty, outport_ty] -> if Type.coreEqType state_ty outstate_ty
         then
-          Tuple [state, mkPort outport_ty]
+          Tuple [state, useAsPort outport_ty]
         else
           error $ "Input state type of function " ++ hsname ++ ": " ++ (showSDoc $ ppr state_ty) ++ " does not match output state type: " ++ (showSDoc $ ppr outstate_ty)
       otherwise                -> error $ "Return type of top-level function " ++ hsname ++ " must be a two-tuple containing a state and output ports."