Moved to new GHC API (6.11). Also use vhdl package for the VHDL AST
[matthijs/master-project/cλash.git] / Generate.hs
index 4f0acf319760946a632e5a5b45970164c1b8e0dc..8dc7a0aaaef50b0dacc7bc0be63df0f0d5a28013 100644 (file)
@@ -14,7 +14,7 @@ import Data.Accessor.MonadState as MonadState
 import Debug.Trace
 
 -- ForSyDe
-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.AST as AST
 
 -- GHC API
 import CoreSyn
@@ -38,12 +38,12 @@ import Pretty
 
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be expressions.
-genExprArgs ::
-  TypeState
-  -> (dst -> func -> [AST.Expr] -> res)
-  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
-genExprArgs ty_state wrap dst func args = wrap dst func args'
-  where args' = map (either ((varToVHDLExpr ty_state).exprToVar) id) args
+genExprArgs wrap dst func args = do
+  args' <- eitherCoreOrExprArgs args
+  wrap dst func args'
+
+eitherCoreOrExprArgs :: [Either CoreSyn.CoreExpr AST.Expr] -> VHDLSession [AST.Expr]
+eitherCoreOrExprArgs args = mapM (Either.either ((MonadState.lift vsType) . varToVHDLExpr . exprToVar) return) args
 
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be variables.
@@ -79,34 +79,34 @@ genExprRes wrap dst func args = do
 
 -- | Generate a binary operator application. The first argument should be a
 -- constructor from the AST.Expr type, e.g. AST.And.
-genOperator2 :: TypeState -> (AST.Expr -> AST.Expr -> AST.Expr) -> BuiltinBuilder 
-genOperator2 ty_state op = (genExprArgs ty_state) $ genExprRes (genOperator2' op)
+genOperator2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> BuiltinBuilder 
+genOperator2 op = genExprArgs $ genExprRes (genOperator2' op)
 genOperator2' :: (AST.Expr -> AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
 genOperator2' op _ f [arg1, arg2] = return $ op arg1 arg2
 
 -- | Generate a unary operator application
-genOperator1 :: TypeState -> (AST.Expr -> AST.Expr) -> BuiltinBuilder 
-genOperator1 ty_state op = (genExprArgs ty_state) $ genExprRes (genOperator1' op)
+genOperator1 :: (AST.Expr -> AST.Expr) -> BuiltinBuilder 
+genOperator1 op = genExprArgs $ genExprRes (genOperator1' op)
 genOperator1' :: (AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
 genOperator1' op _ f [arg] = return $ op arg
 
 -- | Generate a unary operator application
-genNegation :: TypeState -> BuiltinBuilder 
-genNegation ty_state = genVarArgs $ genExprRes (genNegation' ty_state)
-genNegation' :: TypeState -> dst -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession AST.Expr
-genNegation' ty_state _ f [arg] = return $ op ((varToVHDLExpr ty_state) arg)
-  where
-    ty = Var.varType arg
-    (tycon, args) = Type.splitTyConApp ty
-    name = Name.getOccString (TyCon.tyConName tycon)
-    op = case name of
-      "SizedInt" -> AST.Neg
-      otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name 
+genNegation :: BuiltinBuilder 
+genNegation = genVarArgs $ genExprRes genNegation'
+genNegation' :: dst -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession AST.Expr
+genNegation' _ f [arg] = do
+  arg1 <- MonadState.lift vsType $ varToVHDLExpr arg
+  let ty = Var.varType arg
+  let (tycon, args) = Type.splitTyConApp ty
+  let name = Name.getOccString (TyCon.tyConName tycon)
+  case name of
+    "SizedInt" -> return $ AST.Neg arg1
+    otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name 
 
 -- | Generate a function call from the destination binder, function name and a
 -- list of expressions (its arguments)
-genFCall :: TypeState -> Bool -> BuiltinBuilder 
-genFCall ty_state switch = (genExprArgs ty_state) $ genExprRes (genFCall' switch)
+genFCall :: Bool -> BuiltinBuilder 
+genFCall switch = genExprArgs $ genExprRes (genFCall' switch)
 genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
 genFCall' switch (Left res) f args = do
   let fname = varToString f
@@ -116,8 +116,8 @@ genFCall' switch (Left res) f args = do
              map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
-genFromSizedWord :: TypeState -> BuiltinBuilder
-genFromSizedWord ty_state = (genExprArgs ty_state) $ genExprRes genFromSizedWord'
+genFromSizedWord :: BuiltinBuilder
+genFromSizedWord = genExprArgs $ genExprRes genFromSizedWord'
 genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
 genFromSizedWord' (Left res) f args = do
   let fname = varToString f
@@ -125,6 +125,22 @@ genFromSizedWord' (Left res) f args = do
              map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
 genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
+genResize :: BuiltinBuilder
+genResize = genExprArgs $ genExprRes genResize'
+genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
+genResize' (Left res) f [arg] = do {
+  ; let { ty = Var.varType res
+        ; (tycon, args) = Type.splitTyConApp ty
+        ; name = Name.getOccString (TyCon.tyConName tycon)
+        } ;
+  ; len <- case name of
+      "SizedInt" -> MonadState.lift vsType $ tfp_to_int (sized_int_len_ty ty)
+      "SizedWord" -> MonadState.lift vsType $ tfp_to_int (sized_word_len_ty ty)
+  ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId))
+             [Nothing AST.:=>: AST.ADExpr arg, Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
+  }
+genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+
 -- FIXME: I'm calling genLitArgs which is very specific function,
 -- which needs to be fixed as well
 genFromInteger :: BuiltinBuilder
@@ -198,23 +214,29 @@ genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
   ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms]
   }
 
-genFoldl :: TypeState -> BuiltinBuilder
-genFoldl ty_state = genFold ty_state True
+genFoldl :: BuiltinBuilder
+genFoldl = genFold True
+
+genFoldr :: BuiltinBuilder
+genFoldr = genFold False
+
+genFold :: Bool -> BuiltinBuilder
+genFold left = genVarArgs (genFold' left)
 
-genFoldr :: TypeState -> BuiltinBuilder
-genFoldr ty_state = genFold ty_state False
+genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+genFold' left res f args@[folded_f , start ,vec]= do
+  len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty (Var.varType vec))
+  genFold'' len left res f args
 
-genFold :: TypeState -> Bool -> BuiltinBuilder
-genFold ty_state left = genVarArgs (genFold' ty_state left)
-genFold' :: TypeState -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+genFold'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
 -- Special case for an empty input vector, just assign start to res
-genFold' ty_state left (Left res) _ [_, start, vec] | len == 0 = return [mkUncondAssign (Left res) ((varToVHDLExpr ty_state) start)]
-  where 
-    len = State.evalState (tfp_to_int $ (tfvec_len_ty . Var.varType) vec) ty_state
+genFold'' len left (Left res) _ [_, start, vec] | len == 0 = do
+  arg <- MonadState.lift vsType $ varToVHDLExpr start
+  return [mkUncondAssign (Left res) arg]
     
-genFold' ty_state left (Left res) f [folded_f, start, vec] = do
+genFold'' len left (Left res) f [folded_f, start, vec] = do
   -- The vector length
-  len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
+  --len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
   -- An expression for len-1
   let len_min_expr = (AST.PrimLit $ show (len-1))
   -- evec is (TFVec n), so it still needs an element type
@@ -262,7 +284,7 @@ genFold' ty_state left (Left res) f [folded_f, start, vec] = do
       -- Output to tmp[current n]
       let resname = mkIndexedName tmp_name n_cur
       -- Input from start
-      let argexpr1 = (varToVHDLExpr ty_state) start
+      argexpr1 <- MonadState.lift vsType $ varToVHDLExpr start
       -- Input from vec[current n]
       let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
       app_concsms <- genApplication (Right resname) folded_f  ( if left then
@@ -389,27 +411,33 @@ genConcat' (Left res) f args@[arg] = do {
     vecSlice init last =  AST.NSlice (AST.SliceName (varToVHDLName res) 
                             (AST.ToRange init last))
 
-genIteraten :: TypeState -> BuiltinBuilder
-genIteraten ty_state dst f args = genIterate ty_state dst f (tail args)
+genIteraten :: BuiltinBuilder
+genIteraten dst f args = genIterate dst f (tail args)
+
+genIterate :: BuiltinBuilder
+genIterate = genIterateOrGenerate True
 
-genIterate :: TypeState -> BuiltinBuilder
-genIterate ty_state = genIterateOrGenerate ty_state True
+genGeneraten :: BuiltinBuilder
+genGeneraten dst f args = genGenerate dst f (tail args)
 
-genGeneraten :: TypeState -> BuiltinBuilder
-genGeneraten ty_state dst f args = genGenerate ty_state dst f (tail args)
+genGenerate :: BuiltinBuilder
+genGenerate = genIterateOrGenerate False
 
-genGenerate :: TypeState -> BuiltinBuilder
-genGenerate ty_state = genIterateOrGenerate ty_state False
+genIterateOrGenerate :: Bool -> BuiltinBuilder
+genIterateOrGenerate iter = genVarArgs (genIterateOrGenerate' iter)
 
-genIterateOrGenerate :: TypeState -> Bool -> BuiltinBuilder
-genIterateOrGenerate ty_state iter = genVarArgs (genIterateOrGenerate' ty_state iter)
-genIterateOrGenerate' :: TypeState -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+genIterateOrGenerate' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+genIterateOrGenerate' iter (Left res) f args = do
+  len <- MonadState.lift vsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
+  genIterateOrGenerate'' len iter (Left res) f args
+
+genIterateOrGenerate'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
 -- Special case for an empty input vector, just assign start to res
-genIterateOrGenerate' ty_state iter (Left res) _ [app_f, start] | len == 0 = return [mkUncondAssign (Left res) (AST.PrimLit "\"\"")]
-    where len = State.evalState (tfp_to_int $ (tfvec_len_ty . Var.varType) res) ty_state
-genIterateOrGenerate' ty_state iter (Left res) f [app_f, start] = do
+genIterateOrGenerate'' len iter (Left res) _ [app_f, start] | len == 0 = return [mkUncondAssign (Left res) (AST.PrimLit "\"\"")]
+
+genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
   -- The vector length
-  len <- MonadState.lift vsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
+  -- len <- MonadState.lift vsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
   -- An expression for len-1
   let len_min_expr = (AST.PrimLit $ show (len-1))
   -- -- evec is (TFVec n), so it still needs an element type
@@ -451,7 +479,7 @@ genIterateOrGenerate' ty_state iter (Left res) f [app_f, start] = do
       -- Output to tmp[current n]
       let resname = mkIndexedName tmp_name n_cur
       -- Input from start
-      let argexpr = (varToVHDLExpr ty_state) start
+      argexpr <- MonadState.lift vsType $ varToVHDLExpr start
       let startassign = mkUncondAssign (Right resname) argexpr
       app_concsms <- genApplication (Right resname) app_f  [Right argexpr]
       -- Return the conditional generate part
@@ -483,67 +511,68 @@ genApplication ::
   -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply
   -> VHDLSession [AST.ConcSm] -- ^ The resulting concurrent statements
 genApplication dst f args = do
-  ty_state <- getA vsType
-  case Var.globalIdVarDetails f of
-    IdInfo.DataConWorkId dc -> case dst of
-      -- It's a datacon. Create a record from its arguments.
-      Left bndr -> do
-        -- We have the bndr, so we can get at the type
-        labels <- MonadState.lift vsType $ getFieldLabels (Var.varType bndr)
-        return $ zipWith mkassign labels $ map (either (exprToVHDLExpr ty_state) id) args
-        where
-          mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
-          mkassign label arg =
-            let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
-            mkUncondAssign (Right sel_name) arg
-      Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
-    IdInfo.VanillaGlobal -> do
-      -- It's a global value imported from elsewhere. These can be builtin
-      -- functions. Look up the function name in the name table and execute
-      -- the associated builder if there is any and the argument count matches
-      -- (this should always be the case if it typechecks, but just to be
-      -- sure...).
-      case (Map.lookup (varToString f) (globalNameTable ty_state)) of
-        Just (arg_count, builder) ->
-          if length args == arg_count then
-            builder dst f args
-          else
-            error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
-        Nothing -> error $ "\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ pprString f
-    IdInfo.NotGlobalId -> do
+  case Var.isGlobalId f of
+    False -> do
       signatures <- getA vsSignatures
       -- This is a local id, so it should be a function whose definition we
       -- have and which can be turned into a component instantiation.
       case (Map.lookup f signatures) of
-        Just signature -> let
+        Just signature -> do
+          args' <- eitherCoreOrExprArgs args
           -- We have a signature, this is a top level binding. Generate a
           -- component instantiation.
-          entity_id = ent_id signature
+          let entity_id = ent_id signature
           -- TODO: Using show here isn't really pretty, but we'll need some
           -- unique-ish value...
-          label = "comp_ins_" ++ (either show prettyShow) dst
-          portmaps = mkAssocElems (map (either (exprToVHDLExpr ty_state) id) args) ((either varToVHDLName id) dst) signature
-          in
-            return [mkComponentInst label entity_id portmaps]
+          let label = "comp_ins_" ++ (either show prettyShow) dst
+          let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
+          return [mkComponentInst label entity_id portmaps]
         Nothing -> do
           -- No signature, so this must be a local variable reference. It
           -- should have a representable type (and thus, no arguments) and a
           -- signal should be generated for it. Just generate an
           -- unconditional assignment here.
-          ty_state <- getA vsType
-          return $ [mkUncondAssign dst ((varToVHDLExpr ty_state) f)]
-            
-    IdInfo.ClassOpId cls -> do
-      -- FIXME: Not looking for what instance this class op is called for
-      -- Is quite stupid of course.
-      case (Map.lookup (varToString f) (globalNameTable ty_state)) of
-        Just (arg_count, builder) ->
-          if length args == arg_count then
-            builder dst f args
-          else
-            error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
-        Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
-    details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
+          f' <- MonadState.lift vsType $ varToVHDLExpr f
+          return $ [mkUncondAssign dst f']
+    True ->
+      case Var.idDetails f of
+        IdInfo.DataConWorkId dc -> case dst of
+          -- It's a datacon. Create a record from its arguments.
+          Left bndr -> do
+            -- We have the bndr, so we can get at the type
+            labels <- MonadState.lift vsType $ getFieldLabels (Var.varType bndr)
+            args' <- eitherCoreOrExprArgs args
+            return $ zipWith mkassign labels $ args'
+            where
+              mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
+              mkassign label arg =
+                let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
+                mkUncondAssign (Right sel_name) arg
+          Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
+        IdInfo.VanillaId -> do
+          -- It's a global value imported from elsewhere. These can be builtin
+          -- functions. Look up the function name in the name table and execute
+          -- the associated builder if there is any and the argument count matches
+          -- (this should always be the case if it typechecks, but just to be
+          -- sure...).
+          case (Map.lookup (varToString f) globalNameTable) of
+            Just (arg_count, builder) ->
+              if length args == arg_count then
+                builder dst f args
+              else
+                error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+            Nothing -> error $ "\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ pprString f
+        IdInfo.ClassOpId cls -> do
+          -- FIXME: Not looking for what instance this class op is called for
+          -- Is quite stupid of course.
+          case (Map.lookup (varToString f) globalNameTable) of
+            Just (arg_count, builder) ->
+              if length args == arg_count then
+                builder dst f args
+              else
+                error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+            Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
+        details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
 
 -----------------------------------------------------------------------------
 -- Functions to generate functions dealing with vectors.
@@ -959,50 +988,51 @@ genUnconsVectorFuns elemTM vectorTM  =
 
 -- | The builtin functions we support. Maps a name to an argument count and a
 -- builder function.
-globalNameTable :: TypeState -> NameTable
-globalNameTable ty_state = Map.fromList
-  [ (exId             , (2, genFCall ty_state False         ) )
-  , (replaceId        , (3, genFCall ty_state False         ) )
-  , (headId           , (1, genFCall ty_state True          ) )
-  , (lastId           , (1, genFCall ty_state True          ) )
-  , (tailId           , (1, genFCall ty_state False         ) )
-  , (initId           , (1, genFCall ty_state False         ) )
-  , (takeId           , (2, genFCall ty_state False         ) )
-  , (dropId           , (2, genFCall ty_state False         ) )
-  , (selId            , (4, genFCall ty_state False         ) )
-  , (plusgtId         , (2, genFCall ty_state False         ) )
-  , (ltplusId         , (2, genFCall ty_state False         ) )
-  , (plusplusId       , (2, genFCall ty_state False         ) )
-  , (mapId            , (2, genMap                          ) )
-  , (zipWithId        , (3, genZipWith                      ) )
-  , (foldlId          , (3, genFoldl ty_state               ) )
-  , (foldrId          , (3, genFoldr ty_state               ) )
-  , (zipId            , (2, genZip                          ) )
-  , (unzipId          , (1, genUnzip                        ) )
-  , (shiftlId         , (2, genFCall ty_state False         ) )
-  , (shiftrId         , (2, genFCall ty_state False         ) )
-  , (rotlId           , (1, genFCall ty_state False         ) )
-  , (rotrId           , (1, genFCall ty_state False         ) )
-  , (concatId         , (1, genConcat                       ) )
-  , (reverseId        , (1, genFCall ty_state False         ) )
-  , (iteratenId       , (3, genIteraten ty_state            ) )
-  , (iterateId        , (2, genIterate ty_state             ) )
-  , (generatenId      , (3, genGeneraten ty_state           ) )
-  , (generateId       , (2, genGenerate ty_state            ) )
-  , (emptyId          , (0, genFCall ty_state False         ) )
-  , (singletonId      , (1, genFCall ty_state False         ) )
-  , (copynId          , (2, genFCall ty_state False         ) )
-  , (copyId           , (1, genCopy                         ) )
-  , (lengthTId        , (1, genFCall ty_state False         ) )
-  , (nullId           , (1, genFCall ty_state False         ) )
-  , (hwxorId          , (2, genOperator2 ty_state AST.Xor   ) )
-  , (hwandId          , (2, genOperator2 ty_state AST.And   ) )
-  , (hworId           , (2, genOperator2 ty_state AST.Or    ) )
-  , (hwnotId          , (1, genOperator1 ty_state AST.Not   ) )
-  , (plusId           , (2, genOperator2 ty_state (AST.:+:) ) )
-  , (timesId          , (2, genOperator2 ty_state (AST.:*:) ) )
-  , (negateId         , (1, genNegation ty_state            ) )
-  , (minusId          , (2, genOperator2 ty_state (AST.:-:) ) )
-  , (fromSizedWordId  , (1, genFromSizedWord ty_state       ) )
-  , (fromIntegerId    , (1, genFromInteger                  ) )
+globalNameTable :: NameTable
+globalNameTable = Map.fromList
+  [ (exId             , (2, genFCall False          ) )
+  , (replaceId        , (3, genFCall False          ) )
+  , (headId           , (1, genFCall True           ) )
+  , (lastId           , (1, genFCall True           ) )
+  , (tailId           , (1, genFCall False          ) )
+  , (initId           , (1, genFCall False          ) )
+  , (takeId           , (2, genFCall False          ) )
+  , (dropId           , (2, genFCall False          ) )
+  , (selId            , (4, genFCall False          ) )
+  , (plusgtId         , (2, genFCall False          ) )
+  , (ltplusId         , (2, genFCall False          ) )
+  , (plusplusId       , (2, genFCall False          ) )
+  , (mapId            , (2, genMap                  ) )
+  , (zipWithId        , (3, genZipWith              ) )
+  , (foldlId          , (3, genFoldl                ) )
+  , (foldrId          , (3, genFoldr                ) )
+  , (zipId            , (2, genZip                  ) )
+  , (unzipId          , (1, genUnzip                ) )
+  , (shiftlId         , (2, genFCall False          ) )
+  , (shiftrId         , (2, genFCall False          ) )
+  , (rotlId           , (1, genFCall False          ) )
+  , (rotrId           , (1, genFCall False          ) )
+  , (concatId         , (1, genConcat               ) )
+  , (reverseId        , (1, genFCall False          ) )
+  , (iteratenId       , (3, genIteraten             ) )
+  , (iterateId        , (2, genIterate              ) )
+  , (generatenId      , (3, genGeneraten            ) )
+  , (generateId       , (2, genGenerate             ) )
+  , (emptyId          , (0, genFCall False          ) )
+  , (singletonId      , (1, genFCall False          ) )
+  , (copynId          , (2, genFCall False          ) )
+  , (copyId           , (1, genCopy                 ) )
+  , (lengthTId        , (1, genFCall False          ) )
+  , (nullId           , (1, genFCall False          ) )
+  , (hwxorId          , (2, genOperator2 AST.Xor    ) )
+  , (hwandId          , (2, genOperator2 AST.And    ) )
+  , (hworId           , (2, genOperator2 AST.Or     ) )
+  , (hwnotId          , (1, genOperator1 AST.Not    ) )
+  , (plusId           , (2, genOperator2 (AST.:+:)  ) )
+  , (timesId          , (2, genOperator2 (AST.:*:)  ) )
+  , (negateId         , (1, genNegation             ) )
+  , (minusId          , (2, genOperator2 (AST.:-:)  ) )
+  , (fromSizedWordId  , (1, genFromSizedWord        ) )
+  , (fromIntegerId    , (1, genFromInteger          ) )
+  , (resizeId         , (1, genResize               ) )
   ]