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

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Use highordtest in main, since that can now be normalized.
  Add a (fairly complete) set of transforms.
  Add is_lam and is_fun predicates.
  Add a inlinebind helper function.
  Add a substitute helper function.
  Print the type in the transform debug output.
  Add infrastructure for running core to core transformations.
  Add a higher order testcase.
  Add is_wild function to check for wild binders.
  Generate VHDL from Core instead of flat functions.

Conflicts:
	Translator.hs
	VHDL.hs

diff --cc CoreTools.hs
Simple merge

diff --cc Main.hs
index be0a0a077f5496d7c9f3c06daa4fd58ae12779b7,0000000000000000000000000000000000000000..be48aa3bb3d86aaac2b0ac7e4aaf4fc6614a79ac
mode 100644,000000..100644
--- 1/Main.hs
--- /dev/null
+++ b/Main.hs
@@@ -1,6 -1,0 +1,6 @@@
-   makeVHDL "Alu.hs" "exec" True
 +module Main where
 +
 +import Translator
 +
 +main = do
++  makeVHDL "Adders.hs" "highordtest" True

diff --cc Translator.hs
Simple merge

diff --cc VHDL.hs
index 846cd814e376ed2e84ca965fc44ba57562d943f5,561c2790d5537bc56d4f5b12d6d9505b2f2a30fb..d177a10b934dc8004425a150552de5df83c12e4e
--- 1/VHDL.hs
--- 2/VHDL.hs
+++ b/VHDL.hs
@@@ -34,22 -38,19 +38,22 @@@ import TranslatorType
  import HsValueMap
  import Pretty
  import CoreTools
 +import Constants
 +import Generate
 +import GlobalNameTable
  
  createDesignFiles ::
-   FlatFuncMap
+   [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)]
    -> [(AST.VHDLId, AST.DesignFile)]
  
- createDesignFiles flatfuncmap =
+ createDesignFiles binds =
    (mkVHDLBasicId "types", AST.DesignFile ieee_context [type_package]) :
    map (Arrow.second $ AST.DesignFile full_context) units
    
    where
 -    init_session = VHDLSession Map.empty builtin_funcs
 +    init_session = VHDLSession Map.empty Map.empty builtin_funcs globalNameTable
      (units, final_session) = 
-       State.runState (createLibraryUnits flatfuncmap) init_session
+       State.runState (createLibraryUnits binds) init_session
      ty_decls = Map.elems (final_session ^. vsTypes)
      ieee_context = [
          AST.Library $ mkVHDLBasicId "IEEE",
@@@ -106,24 -105,23 +108,23 @@@ createEntity (fname, expr) = d
        return ent_decl'
    where
      mkMap :: 
-       [(SignalId, SignalInfo)] 
-       -> SignalId 
+       --[(SignalId, SignalInfo)] 
+       CoreSyn.CoreBndr 
        -> VHDLState VHDLSignalMapElement
      -- We only need the vsTypes element from the state
-     mkMap sigmap = (\id ->
 -    mkMap = MonadState.lift vsTypes . (\bndr ->
++    mkMap = (\bndr ->
        let
-         info = Maybe.fromMaybe
-           (error $ "Signal not found in the name map? This should not happen!")
-           (lookup id sigmap)
-         nm = Maybe.fromMaybe
-           (error $ "Signal not named? This should not happen!")
-           (sigName info)
-         ty = sigTy info
+         --info = Maybe.fromMaybe
+         --  (error $ "Signal not found in the name map? This should not happen!")
+         --  (lookup id sigmap)
+         --  Assume the bndr has a valid VHDL id already
+         id = bndrToVHDLId bndr
+         ty = Var.varType bndr
        in
-         if isPortSigUse $ sigUse info
+         if True -- isPortSigUse $ sigUse info
            then do
              type_mark <- vhdl_ty ty
-             return $ Just (mkVHDLExtId nm, type_mark)
+             return $ Just (id, type_mark)
            else
              return $ Nothing
         )
@@@ -170,31 -167,31 +170,31 @@@ mkEntityId hsfunc 
  
  -- | Create an architecture for a given function
  createArchitecture ::
-   HsFunction -- ^ The function signature
-   -> FlatFunction -- ^ The FlatFunction
+   (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The function
    -> VHDLState AST.ArchBody -- ^ The architecture for this function
  
- createArchitecture hsfunc flatfunc = do
-   signaturemap <- getA vsSignatures
-   let signature = Maybe.fromMaybe 
-         (error $ "Generating architecture for function " ++ (prettyShow hsfunc) ++ "without signature? This should not happen!")
-         (Map.lookup hsfunc signaturemap)
-   let entity_id = ent_id signature
+ createArchitecture (fname, expr) = do
+   --signaturemap <- getA vsSignatures
+   --let signature = Maybe.fromMaybe 
+   --      (error $ "Generating architecture for function " ++ (prettyShow hsfunc) ++ "without signature? This should not happen!")
+   --      (Map.lookup hsfunc signaturemap)
+   let entity_id = mkVHDLBasicId $ bndrToString fname
+   -- Strip off lambda's, these will be arguments
+   let (args, letexpr) = CoreSyn.collectBinders expr
+   -- There must be a let at top level 
+   let (CoreSyn.Let (CoreSyn.Rec binds) res) = letexpr
+ 
    -- Create signal declarations for all internal and state signals
-   sig_dec_maybes <- mapM (mkSigDec' . snd) sigs
+   sig_dec_maybes <- mapM (mkSigDec' . fst) binds
    let sig_decs = Maybe.catMaybes $ sig_dec_maybes
-   -- Create concurrent statements for all signal definitions
-   statements <- Monad.zipWithM (mkConcSm sigs) defs [0..]
+ 
+   statements <- Monad.mapM mkConcSm binds
    return $ AST.ArchBody (mkVHDLBasicId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
    where
-     sigs = flat_sigs flatfunc
-     args = flat_args flatfunc
-     res  = flat_res  flatfunc
-     defs = flat_defs flatfunc
-     procs = map mkStateProcSm (makeStatePairs flatfunc)
+     procs = map mkStateProcSm [] -- (makeStatePairs flatfunc)
      procs' = map AST.CSPSm procs
      -- mkSigDec only uses vsTypes from the state
 -    mkSigDec' = MonadState.lift vsTypes . mkSigDec
 +    mkSigDec' = mkSigDec
  
  -- | Looks up all pairs of old state, new state signals, together with
  --   the state id they represent.
@@@ -223,16 -220,13 +223,13 @@@ mkStateProcSm (num, old, new) 
      rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
      statement   = AST.IfSm rising_edge_clk [assign] [] Nothing
  
- mkSigDec :: SignalInfo -> VHDLState (Maybe AST.SigDec)
- mkSigDec info =
-   let use = sigUse info in
-   if isInternalSigUse use || isStateSigUse use then do
-     type_mark <- vhdl_ty ty
-     return $ Just (AST.SigDec (getSignalId info) type_mark Nothing)
 -mkSigDec :: CoreSyn.CoreBndr -> TypeState (Maybe AST.SigDec)
++mkSigDec :: CoreSyn.CoreBndr -> VHDLState (Maybe AST.SigDec)
+ mkSigDec bndr =
+   if True then do --isInternalSigUse use || isStateSigUse use then do
+     type_mark <- vhdl_ty $ Var.varType bndr
+     return $ Just (AST.SigDec (bndrToVHDLId bndr) type_mark Nothing)
    else
      return Nothing
-   where
-     ty = sigTy info
  
  -- | Creates a VHDL Id from a named SignalInfo. Errors out if the SignalInfo
  --   is not named.

diff --cc VHDLTypes.hs
index f317167a86b857a02f675f8570c03b07cbe52805,784b09706e6a6742a4fb504640983e8973349225..e517a8ba08166d6c5800bdb5d4f41b3e4ab74876
--- 1/VHDLTypes.hs
--- 2/VHDLTypes.hs
+++ b/VHDLTypes.hs
@@@ -44,25 -45,15 +45,25 @@@ instance Ord OrdType wher
  -- A map of a Core type to the corresponding type name
  type TypeMap = Map.Map OrdType (AST.VHDLId, AST.TypeDec)
  
 +-- A map of a vector Core type to the coressponding VHDL functions
 +type TypeFunMap = Map.Map OrdType [AST.SubProgBody]
 +
  -- A map of a Haskell function to a hardware signature
- type SignatureMap = Map.Map HsFunction Entity
+ type SignatureMap = Map.Map String Entity
  
 +-- A map of a builtin function to VHDL function builder 
 +type NameTable = Map.Map String (Int, [AST.Expr] -> AST.Expr )
 +
  data VHDLSession = VHDLSession {
    -- | A map of Core type -> VHDL Type
 -  vsTypes_ :: TypeMap,
 +  vsTypes_      :: TypeMap,
 +  -- | A map of vector Core type -> VHDL type function
 +  vsTypeFuns_   :: TypeFunMap,
    -- | A map of HsFunction -> hardware signature (entity name, port names,
    --   etc.)
 -  vsSignatures_ :: SignatureMap
 +  vsSignatures_ :: SignatureMap,
 +  -- | A map of Vector HsFunctions -> VHDL function call
 +  vsNameTable_  :: NameTable
  }
  
  -- Derive accessors