Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project
authorChristiaan Baaij <christiaan.baaij@gmail.com>
Tue, 23 Jun 2009 13:10:21 +0000 (15:10 +0200)
committerChristiaan Baaij <christiaan.baaij@gmail.com>
Tue, 23 Jun 2009 13:10:21 +0000 (15:10 +0200)
* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Ignore cast expressions when generating VHDL.
  Add Cast propagation transform.
  Make subeverywhere support Cast expressions.
  Remove a double line introduced a few commits back.
  Make subeverywhere complain for unknown expressions.

1  2 
VHDL.hs

diff --combined VHDL.hs
index 24c4eb0f1fc788b9cebfdcb28332a5eb9d8bf0fe,b2d5b30e448964d450934b88a343d309a44c8b09..99aa08907f33f1153a773b1bbdd9e6e558167812
+++ b/VHDL.hs
@@@ -264,6 -264,11 +264,11 @@@ mkConcSm :
    (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The binding to process
    -> VHDLState [AST.ConcSm] -- ^ The corresponding VHDL component instantiations.
  
+ -- Ignore Cast expressions, they should not longer have any meaning as long as
+ -- the type works out.
+ mkConcSm (bndr, Cast expr ty) = mkConcSm (bndr, expr)
  mkConcSm (bndr, app@(CoreSyn.App _ _))= do
    let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
    let valargs' = filter isValArg args
        -- It's a global value imported from elsewhere. These can be builtin
        -- functions.
        funSignatures <- getA vsNameTable
 +      signatures <- getA vsSignatures
        case (Map.lookup (bndrToString f) funSignatures) of
          Just (arg_count, builder) ->
            if length valargs == arg_count then
 -            let
 -              sigs = map (bndrToString.varBndr) valargs
 -              sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
 -              func = builder sigsNames
 -              src_wform = AST.Wform [AST.WformElem func Nothing]
 -              dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
 -              assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
 -            in
 -              return [AST.CSSASm assign]
 +            case builder of
 +              Left funBuilder ->
 +                let
 +                  sigs = map (bndrToString.varBndr) valargs
 +                  sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
 +                  func = funBuilder sigsNames
 +                  src_wform = AST.Wform [AST.WformElem func Nothing]
 +                  dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
 +                  assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
 +                in
 +                  return [AST.CSSASm assign]
 +              Right genBuilder ->
 +                let
 +                  sigs = map varBndr valargs
 +                  signature = Maybe.fromMaybe
 +                    (error $ "Using function '" ++ (bndrToString (head sigs)) ++ "' without signature? This should not happen!") 
 +                    (Map.lookup (head sigs) signatures)
 +                  arg_names = map (mkVHDLExtId . bndrToString) (tail sigs)
 +                  dst_name = mkVHDLExtId (bndrToString bndr)
 +                  genSm = genBuilder 4 signature (arg_names ++ [dst_name])  
 +                in return [AST.CSGSm genSm]
            else
              error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs
          Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f