X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=da8be8a7afda04735e7ba3e07abae4c5252ae602;hb=d2fb40118bbcc404ea242d57dd6be196e70d171d;hp=d1bf3751e3209dc0d1b8b8f8453bdb225ba12b57;hpb=743f2dcf9a7a37c71fc06ce552f605fac3120e56;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs"
index d1bf375..da8be8a 100644
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Generate.hs"
@@ -167,16 +167,18 @@ mkStateProcSm ::
 mkStateProcSm (old, new) = do
   nonempty <- hasNonEmptyType old 
   if nonempty 
-    then return [AST.CSPSm $ AST.ProcSm label [clk] [statement]]
+    then return [AST.CSPSm $ AST.ProcSm label [clockId,resetId] [statement]]
     else return []
   where
     label       = mkVHDLBasicId $ "state"
-    clk         = mkVHDLBasicId "clock"
     rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge"
     wform       = AST.Wform [AST.WformElem (AST.PrimName $ varToVHDLName new) Nothing]
-    assign      = AST.SigAssign (varToVHDLName old) wform
-    rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
-    statement   = AST.IfSm rising_edge_clk [assign] [] Nothing
+    clk_assign      = AST.SigAssign (varToVHDLName old) wform
+    rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clockId)]
+    resetn_is_low  = (AST.PrimName $ AST.NSimple resetId) AST.:=: (AST.PrimLit "'0'")
+    reset_statement = []
+    clk_statement = [AST.ElseIf rising_edge_clk [clk_assign]]
+    statement   = AST.IfSm resetn_is_low reset_statement clk_statement Nothing
 
 
 -- | Transforms a core binding into a VHDL concurrent statement
@@ -205,7 +207,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
   let valargs = get_val_args (Var.varType f) args
   genApplication (Left bndr) f (map Left valargs)
 
--- A single alt case must be a selector. This means thee scrutinee is a simple
+-- A single alt case must be a selector. This means the scrutinee is a simple
 -- variable, the alternative is a dataalt with a single non-wild binder that
 -- is also returned.
 mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt])) 
@@ -232,7 +234,8 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
 -- first is the default case, if there is any.
 mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do
   scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
-  let cond_expr = scrut' AST.:=: (altconToVHDLExpr con)
+  altcon <- MonadState.lift tsType $ altconToVHDLExpr con
+  let cond_expr = scrut' AST.:=: altcon
   true_expr <- MonadState.lift tsType $ varToVHDLExpr true
   false_expr <- MonadState.lift tsType $ varToVHDLExpr false
   return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], [])
@@ -290,14 +293,16 @@ genVarArgs wrap dst func args = wrap dst func args'
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be Literals
 genLitArgs ::
-  (dst -> func -> [Literal.Literal] -> res)
-  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
-genLitArgs wrap dst func args = wrap dst func args'
-  where
-    args' = map exprToLit litargs
-    -- FIXME: Check if we were passed an CoreSyn.App
-    litargs = concat (map getLiterals exprargs)
-    (exprargs, []) = Either.partitionEithers args
+  (dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
+  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
+genLitArgs wrap dst func args = do
+  hscenv <- MonadState.lift tsType $ getA tsHscEnv
+  let (exprargs, []) = Either.partitionEithers args
+  -- FIXME: Check if we were passed an CoreSyn.App
+  let litargs = concat (map (getLiterals hscenv) exprargs)
+  let args' = map exprToLit litargs
+  concsms <- wrap dst func args'
+  return concsms    
 
 -- | A function to wrap a builder-like function that produces an expression
 -- and expects it to be assigned to the destination.
@@ -879,7 +884,7 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do
         wform       = AST.Wform [AST.WformElem data_in Nothing]
         ramassign      = AST.SigAssign ramloc wform
         rising_edge_clk = genExprFCall rising_edge (AST.PrimName $ AST.NSimple clockId)
-        statement   = AST.IfSm (AST.And rising_edge_clk (wrenable AST.:=: AST.PrimLit "'1'")) [ramassign] [] Nothing
+        statement   = AST.IfSm (AST.And rising_edge_clk wrenable) [ramassign] [] Nothing
 
 -----------------------------------------------------------------------------
 -- Function to generate VHDL for applications
@@ -1444,6 +1449,10 @@ globalNameTable = Map.fromList
   , (hwnotId          , (1, genOperator1 AST.Not    ) )
   , (equalityId       , (2, genOperator2 (AST.:=:)  ) )
   , (inEqualityId     , (2, genOperator2 (AST.:/=:) ) )
+  , (ltId             , (2, genOperator2 (AST.:<:)  ) )
+  , (lteqId           , (2, genOperator2 (AST.:<=:) ) )
+  , (gtId             , (2, genOperator2 (AST.:>:)  ) )
+  , (gteqId           , (2, genOperator2 (AST.:>=:) ) )
   , (boolOrId         , (2, genOperator2 AST.Or     ) )
   , (boolAndId        , (2, genOperator2 AST.And    ) )
   , (plusId           , (2, genOperator2 (AST.:+:)  ) )