From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Tue, 23 Jun 2009 10:24:25 +0000 (+0200)
Subject: Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=daba7a870fe4808faf6e54b26572a707237ec3c2;hp=-c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Merge branch 'cλash' of git.stderr.nl/matthijs/projects/master-project

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Don't generate a signal for the output port.
  Perform subsititutions one after another.
---

daba7a870fe4808faf6e54b26572a707237ec3c2
diff --combined VHDL.hs
index ec6e583,d2fbc63..84e4e37
--- a/VHDL.hs
+++ b/VHDL.hs
@@@ -63,9 -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"],
@@@ -74,7 -71,7 +74,7 @@@
      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)
@@@ -199,10 -196,12 +199,12 @@@ createArchitecture (fname, expr) = d
    -- 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
@@@ -575,13 -574,13 +577,13 @@@ construct_vhdl_ty ty = d
        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
@@@ -620,9 -619,10 +622,9 @@@ 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)
@@@ -634,22 -634,24 +636,22 @@@
        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 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),