X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;fp=VHDL.hs;h=6a89930bf57c1d21d0a3c5bfb69f61923b225a88;hb=5ffa570103939a4e732d2a2c6ec99d77674b34e8;hp=99aa08907f33f1153a773b1bbdd9e6e558167812;hpb=b4ae262efb842ce254721f0f9ed9f0936241e094;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/VHDL.hs b/VHDL.hs
index 99aa089..6a89930 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -301,9 +301,8 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
             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)
@@ -364,7 +363,7 @@ mkConcSm (bndr, expr@(Case (Var scrut) b ty [alt])) =
 -- 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
@@ -440,13 +439,26 @@ getFieldLabels ty = do
 
 -- 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
@@ -455,9 +467,6 @@ conToVHDLExpr (DataAlt dc) = AST.PrimLit lit
       -- 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!"
-
 
 
 {-