X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=84e4e379eabc6dce461728272a96ae0c41056d41;hb=daba7a870fe4808faf6e54b26572a707237ec3c2;hp=ecf6406f95e3f3f621b835d74497eb4feb5b2110;hpb=4e34d6b1baa6e0754432254fabc2fa822b755f0b;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/VHDL.hs b/VHDL.hs
index ecf6406..84e4e37 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -63,6 +63,9 @@ createDesignFiles binds =
     tyfun_decls = Map.elems (final_session ^.vsTypeFuns)
     ty_decls = map mktydecl $ Map.elems (final_session ^. vsTypes)
     vec_decls = map (\(v_id, v_def) -> AST.PDITD $ AST.TypeDec v_id v_def) (Map.elems (final_session ^. vsElemTypes))
+    tfvec_index_decl = AST.PDISD $ AST.SubtypeDec tfvec_indexTM tfvec_index_def
+    tfvec_range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit "-1") (AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerTM) highId Nothing)
+    tfvec_index_def = AST.SubtypeIn integerTM (Just tfvec_range)
     ieee_context = [
         AST.Library $ mkVHDLBasicId "IEEE",
         mkUseAll ["IEEE", "std_logic_1164"],
@@ -71,7 +74,7 @@ createDesignFiles binds =
     full_context =
       mkUseAll ["work", "types"]
       : ieee_context
-    type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") (vec_decls ++ ty_decls ++ subProgSpecs)
+    type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ vec_decls ++ ty_decls ++ subProgSpecs)
     type_package_body = AST.LUPackageBody $ AST.PackageBody typesId (concat tyfun_decls)
     subProgSpecs = concat (map subProgSpec tyfun_decls)
     subProgSpec = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec)
@@ -196,10 +199,12 @@ createArchitecture (fname, expr) = do
   -- Strip off lambda's, these will be arguments
   let (args, letexpr) = CoreSyn.collectBinders expr
   -- There must be a let at top level 
-  let (CoreSyn.Let (CoreSyn.Rec binds) res) = letexpr
+  let (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) = letexpr
 
-  -- Create signal declarations for all internal and state signals
-  sig_dec_maybes <- mapM (mkSigDec' . fst) binds
+  -- Create signal declarations for all binders in the let expression, except
+  -- for the output port (that will already have an output port declared in
+  -- the entity).
+  sig_dec_maybes <- mapM (mkSigDec' . fst) (filter ((/=res).fst) binds)
   let sig_decs = Maybe.catMaybes $ sig_dec_maybes
 
   statements <- Monad.mapM mkConcSm binds
@@ -572,13 +577,13 @@ construct_vhdl_ty ty = do
       let name = Name.getOccString (TyCon.tyConName tycon)
       case name of
         "TFVec" -> do
-          res <- mk_vector_ty (tfvec_len ty) (tfvec_elem ty) ty
+          res <- mk_vector_ty (tfvec_len ty) (tfvec_elem ty)
           return $ Just $ (Arrow.second Right) res
         -- "SizedWord" -> do
         --   res <- mk_vector_ty (sized_word_len ty) ty
         --   return $ Just $ (Arrow.second Left) res
         "RangedWord" -> do 
-          res <- mk_natural_ty 0 (ranged_word_bound ty) ty
+          res <- mk_natural_ty 0 (ranged_word_bound ty)
           return $ Just $ (Arrow.second Right) res
         -- Create a custom type from this tycon
         otherwise -> mk_tycon_ty tycon args
@@ -617,14 +622,13 @@ mk_tycon_ty tycon args =
 mk_vector_ty ::
   Int -- ^ The length of the vector
   -> Type.Type -- ^ The Haskell element type of the Vector
-  -> Type.Type -- ^ The Haskell type to create a VHDL type for
   -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
 
-mk_vector_ty len el_ty ty = do
+mk_vector_ty len el_ty = do
   elem_types_map <- getA vsElemTypes
   el_ty_tm <- vhdl_ty el_ty
   let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId el_ty_tm) ++ "-0_to_" ++ (show len)
-  let range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
+  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
   let existing_elem_ty = (fmap fst) $ Map.lookup (OrdType el_ty) elem_types_map
   case existing_elem_ty of
     Just t -> do
@@ -632,23 +636,22 @@ mk_vector_ty len el_ty ty = do
       return (ty_id, ty_def)
     Nothing -> do
       let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId el_ty_tm)
-      let vec_def = AST.TDA $ AST.UnconsArrayDef [naturalTM] el_ty_tm
+      let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] el_ty_tm
       modA vsElemTypes (Map.insert (OrdType el_ty) (vec_id, vec_def))
-      modA vsTypeFuns (Map.insert (OrdType ty) (genUnconsVectorFuns el_ty_tm vec_id)) 
+      modA vsTypeFuns (Map.insert (OrdType el_ty) (genUnconsVectorFuns el_ty_tm vec_id)) 
       let ty_def = AST.SubtypeIn vec_id (Just range)
       return (ty_id, ty_def)
 
 mk_natural_ty ::
   Int -- ^ The minimum bound (> 0)
   -> Int -- ^ The maximum bound (> minimum bound)
-  -> Type.Type -- ^ The Haskell type to create a VHDL type for
   -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
-mk_natural_ty min_bound max_bound ty = do
+mk_natural_ty min_bound max_bound = do
   let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
-  let ty_def = AST.SubtypeIn naturalTM (Nothing)
+  let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound))
+  let ty_def = AST.SubtypeIn naturalTM (Just range)
   return (ty_id, ty_def)
-
-
+  
 builtin_types = 
   Map.fromList [
     ("Bit", std_logic_ty),