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

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Support turning dataconstructors into VHDL constants.
  Use varToVHDLExpr in mkConcSm.

diff --combined VHDL.hs
index 08375b7bd1d54a178d327b8905a4334e217031ec,6a89930bf57c1d21d0a3c5bfb69f61923b225a88..90fc9dd7e9b7cec6e738c1f59b4b71281d6cec0b
--- 1/VHDL.hs
--- 2/VHDL.hs
+++ b/VHDL.hs
@@@ -301,9 -301,8 +301,8 @@@ mkConcSm (bndr, app@(CoreSyn.App _ _))
              case builder of
                Left funBuilder ->
                  let
-                   sigs = map (bndrToString.varBndr) valargs
-                   sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
-                   func = funBuilder sigsNames
+                   sigs = map (varToVHDLExpr.varBndr) valargs
+                   func = funBuilder sigs
                    src_wform = AST.Wform [AST.WformElem func Nothing]
                    dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
                    assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
@@@ -311,15 -310,13 +310,15 @@@
                    return [AST.CSSASm assign]
                Right genBuilder ->
                  let
 +                  ty = Var.varType bndr
 +                  len = tfvec_len ty 
                    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])  
 +                  genSm = genBuilder len 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
@@@ -366,7 -363,7 +365,7 @@@ mkConcSm (bndr, expr@(Case (Var scrut) 
  -- first is the default case, if there is any.
  mkConcSm (bndr, (Case (Var scrut) b ty [(_, _, Var false), (con, _, Var true)])) =
    let
-     cond_expr = (varToVHDLExpr scrut) AST.:=: (conToVHDLExpr con)
+     cond_expr = (varToVHDLExpr scrut) AST.:=: (altconToVHDLExpr con)
      true_expr  = (varToVHDLExpr true)
      false_expr  = (varToVHDLExpr false)
    in
@@@ -442,13 -439,26 +441,26 @@@ getFieldLabels ty = d
  
  -- Turn a variable reference into a AST expression
  varToVHDLExpr :: Var.Var -> AST.Expr
- varToVHDLExpr var = AST.PrimName $ AST.NSimple $ bndrToVHDLId var
- 
- -- Turn a constructor into an AST expression. For dataconstructors, this is
- -- only the constructor itself, not any arguments it has. Should not be called
- -- with a DEFAULT constructor.
- conToVHDLExpr :: CoreSyn.AltCon -> AST.Expr
- conToVHDLExpr (DataAlt dc) = AST.PrimLit lit
+ varToVHDLExpr var = 
+   case Id.isDataConWorkId_maybe var of
+     Just dc -> dataconToVHDLExpr dc
+     -- This is a dataconstructor.
+     -- Not a datacon, just another signal. Perhaps we should check for
+     -- local/global here as well?
+     Nothing -> AST.PrimName $ AST.NSimple $ bndrToVHDLId var
+ 
+ -- Turn a alternative constructor into an AST expression. For
+ -- dataconstructors, this is only the constructor itself, not any arguments it
+ -- has. Should not be called with a DEFAULT constructor.
+ altconToVHDLExpr :: CoreSyn.AltCon -> AST.Expr
+ altconToVHDLExpr (DataAlt dc) = dataconToVHDLExpr dc
+ 
+ altconToVHDLExpr (LitAlt _) = error "VHDL.conToVHDLExpr Literals not support in case alternatives yet"
+ altconToVHDLExpr DEFAULT = error "VHDL.conToVHDLExpr DEFAULT alternative should not occur here!"
+ 
+ -- Turn a datacon (without arguments!) into a VHDL expression.
+ dataconToVHDLExpr :: DataCon.DataCon -> AST.Expr
+ dataconToVHDLExpr dc = AST.PrimLit lit
    where
      tycon = DataCon.dataConTyCon dc
      tyname = TyCon.tyConName tycon
@@@ -457,9 -467,6 +469,6 @@@
        -- TODO: Do something more robust than string matching
        "Bit"      -> case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"
        "Bool" -> case Name.getOccString dcname of "True" -> "true"; "False" -> "false"
- conToVHDLExpr (LitAlt _) = error "VHDL.conToVHDLExpr Literals not support in case alternatives yet"
- conToVHDLExpr DEFAULT = error "VHDL.conToVHDLExpr DEFAULT alternative should not occur here!"
- 
  
  
  {-