From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Tue, 23 Jun 2009 13:17:12 +0000 (+0200)
Subject: Merge git://github.com/darchon/clash into cλash
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;ds=sidebyside;h=5ffa570103939a4e732d2a2c6ec99d77674b34e8;hp=-c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Merge git://github.com/darchon/clash into cλash

* git://github.com/darchon/clash:
  Added singleton
  Almost finished support for 'map'

Conflicts:
	VHDL.hs
---

5ffa570103939a4e732d2a2c6ec99d77674b34e8
diff --combined VHDL.hs
index 15eb4c5,99aa089..6a89930
--- a/VHDL.hs
+++ b/VHDL.hs
@@@ -294,17 -294,31 +294,30 @@@ mkConcSm (bndr, app@(CoreSyn.App _ _))
        -- 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 (varToVHDLExpr.varBndr) valargs
-               func = builder 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)
-             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
++                  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)
+                 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
@@@ -350,7 -364,7 +363,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
@@@ -426,26 -440,13 +439,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
@@@ -454,6 -455,9 +467,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!"
 -
  
  
  {-