From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Thu, 20 Aug 2009 07:15:43 +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=a09063e81d573bfa513d30ae97dba95485dc67e9;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:
  Add a not in isUserDefined.
  Let vhld_ty handle free tyvars gracefully.
  Add ty_has_free_tyvars predicate.
  Split substitute into substitute and substitute_clone.
  Rewrite substitute to clone the substitution range.
  Don't error on type abstraction when cloning binders.
  When inlining top level functions, guarantee uniqueness.
  Make all binders unique before normalizing.
  Add genUniques function to regenerate all uniques.
  Add mapAccumLM helper function.
  Don't try to inline non-normalizeable top level  functions.
  Add andM and orM utility functions.
  Add isNormalizeable predicate.
  Make isRepr work on TypedThings instead of CoreExpr.
  Also inline functions named "fromInteger".
  Don't extra non-representable values in simplres.
  Use isUserDefined for (not) inlining top level functions.
  Add isUserDefined predicate.
  Inline all top level functions that look simple.
---

a09063e81d573bfa513d30ae97dba95485dc67e9
diff --combined "c\316\273ash/CLasH/VHDL/VHDLTools.hs"
index e273da8,39506f8..cff65a6
--- "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs"
+++ "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs"
@@@ -119,8 -119,7 +119,8 @@@ mkComponentInst label entity_id portass
    where
      -- We always have a clock port, so no need to map it anywhere but here
      clk_port = mkAssocElem clockId (idToVHDLExpr clockId)
 -    compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect (portassigns ++ [clk_port]))
 +    resetn_port = mkAssocElem resetId (idToVHDLExpr resetId)
 +    compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect (portassigns ++ [clk_port,resetn_port]))
  
  -----------------------------------------------------------------------------
  -- Functions to generate VHDL Exprs
@@@ -239,7 -238,7 +239,7 @@@ mkVHDLExtId s 
    AST.unsafeVHDLExtId $ strip_invalid s
    where 
      -- Allowed characters, taken from ForSyde's mkVHDLExtId
 -    allowed = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ " \"#&\\'()*+,./:;<=>_|!$%@?[]^`{}~-"
 +    allowed = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ " \"#&'()*+,./:;<=>_|!$%@?[]^`{}~-"
      strip_invalid = filter (`elem` allowed)
  
  -- Create a record field selector that selects the given label from the record
@@@ -290,7 -289,8 +290,8 @@@ vhdl_ty_either tything 
      Just ty -> vhdl_ty_either' ty
  
  vhdl_ty_either' :: Type.Type -> TypeSession (Either String (Maybe AST.TypeMark))
- vhdl_ty_either' ty = do
+ vhdl_ty_either' ty | ty_has_free_tyvars ty = return $ Left $ "VHDLTools.vhdl_ty_either': Cannot create type: type has free type variables: " ++ pprString ty
+                    | otherwise = do
    typemap <- getA tsTypes
    htype_either <- mkHType ty
    case htype_either of
@@@ -437,10 -437,9 +438,10 @@@ mk_natural_ty :
    -> TypeSession (Either String (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn)))
        -- ^ An error message or The typemark created.
  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)
 +  let bitsize = floor (logBase 2 (fromInteger (toInteger max_bound)))
 +  let ty_id = mkVHDLExtId $ "natural_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
 +  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit $ show min_bound) (AST.PrimLit $ show bitsize)]
 +  let ty_def = AST.SubtypeIn unsignedTM (Just range)
    return (Right $ Just (ty_id, Right ty_def))
  
  mk_unsigned_ty ::
@@@ -683,14 -682,14 +684,14 @@@ mkBuiltInShow = [ AST.SubProgBody showB
                  , AST.SubProgBody showBoolSpec [] [showBoolExpr]
                  , AST.SubProgBody showSingedSpec [] [showSignedExpr]
                  , AST.SubProgBody showUnsignedSpec [] [showUnsignedExpr]
 -                , AST.SubProgBody showNaturalSpec [] [showNaturalExpr]
 +                -- , AST.SubProgBody showNaturalSpec [] [showNaturalExpr]
                  ]
    where
      bitPar      = AST.unsafeVHDLBasicId "s"
      boolPar     = AST.unsafeVHDLBasicId "b"
      signedPar   = AST.unsafeVHDLBasicId "sint"
      unsignedPar = AST.unsafeVHDLBasicId "uint"
 -    naturalPar  = AST.unsafeVHDLBasicId "nat"
 +    -- naturalPar  = AST.unsafeVHDLBasicId "nat"
      showBitSpec = AST.Function showId [AST.IfaceVarDec bitPar std_logicTM] stringTM
      -- if s = '1' then return "'1'" else return "'0'"
      showBitExpr = AST.IfSm (AST.PrimName (AST.NSimple bitPar) AST.:=: AST.PrimLit "'1'")
@@@ -715,10 -714,10 +716,10 @@@
                            (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [unsignToInt]) Nothing )
                          where
                            unsignToInt = genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ unsignedPar)
 -    showNaturalSpec = AST.Function showId [AST.IfaceVarDec naturalPar naturalTM] stringTM
 -    showNaturalExpr = AST.ReturnSm (Just $
 -                        AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId)
 -                        (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [AST.PrimName $ AST.NSimple $ naturalPar]) Nothing )
 +    -- showNaturalSpec = AST.Function showId [AST.IfaceVarDec naturalPar naturalTM] stringTM
 +    -- showNaturalExpr = AST.ReturnSm (Just $
 +    --                     AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerId)
 +    --                     (AST.NIndexed $ AST.IndexedName (AST.NSimple imageId) [AST.PrimName $ AST.NSimple $ naturalPar]) Nothing )
                        
    
  genExprFCall :: AST.VHDLId -> AST.Expr -> AST.Expr