From 7c377a7aaee5fb2df00a3c612c364b606293b161 Mon Sep 17 00:00:00 2001
From: Roman Leshchinskiy <rl@cse.unsw.edu.au>
Date: Sun, 18 Nov 2007 03:43:51 +0000
Subject: [PATCH] Extend vectorisation built-in mappings with datacons

---
 compiler/vectorise/VectBuiltIn.hs |   13 ++++++++++---
 compiler/vectorise/VectMonad.hs   |    8 +++++++-
 2 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs
index ec7faa3..995d16f 100644
--- a/compiler/vectorise/VectBuiltIn.hs
+++ b/compiler/vectorise/VectBuiltIn.hs
@@ -7,7 +7,8 @@
 
 module VectBuiltIn (
   Builtins(..), sumTyCon, prodTyCon, combinePAVar,
-  initBuiltins, initBuiltinTyCons, initBuiltinPAs, initBuiltinPRs,
+  initBuiltins, initBuiltinTyCons, initBuiltinDataCons,
+  initBuiltinPAs, initBuiltinPRs,
   initBuiltinBoxedTyCons,
 
   primMethod, primPArray
@@ -19,7 +20,7 @@ import DsMonad
 import IfaceEnv        ( lookupOrig )
 
 import Module          ( Module )
-import DataCon         ( DataCon )
+import DataCon         ( DataCon, dataConName )
 import TyCon           ( TyCon, tyConName, tyConDataCons )
 import Var             ( Var )
 import Id              ( mkSysLocal )
@@ -32,7 +33,7 @@ import Type            ( Type )
 import TysPrim
 import TysWiredIn      ( unitTyCon, tupleTyCon,
                          intTyCon, intTyConName,
-                         boolTyCon, boolTyConName )
+                         boolTyCon, boolTyConName, trueDataCon, falseDataCon )
 import Module
 import BasicTypes      ( Boxity(..) )
 
@@ -191,6 +192,12 @@ initBuiltinTyCons bi = (tyConName funTyCon, closureTyCon bi)
 defaultTyCons :: [TyCon]
 defaultTyCons = [intTyCon, boolTyCon]
 
+initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
+initBuiltinDataCons bi = [(dataConName dc, dc)| dc <- defaultDataCons]
+
+defaultDataCons :: [DataCon]
+defaultDataCons = [trueDataCon, falseDataCon]
+
 initBuiltinDicts :: [(Name, Module, FastString)] -> DsM [(Name, Var)]
 initBuiltinDicts ps
   = do
diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs
index 27f90f6..d75cbab 100644
--- a/compiler/vectorise/VectMonad.hs
+++ b/compiler/vectorise/VectMonad.hs
@@ -162,6 +162,10 @@ extendTyConsEnv :: [(Name, TyCon)] -> GlobalEnv -> GlobalEnv
 extendTyConsEnv ps genv
   = genv { global_tycons = extendNameEnvList (global_tycons genv) ps }
 
+extendDataConsEnv :: [(Name, DataCon)] -> GlobalEnv -> GlobalEnv
+extendDataConsEnv ps genv
+  = genv { global_datacons = extendNameEnvList (global_datacons genv) ps }
+
 extendPAFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv
 extendPAFunsEnv ps genv
   = genv { global_pa_funs = extendNameEnvList (global_pa_funs genv) ps }
@@ -485,7 +489,8 @@ initV hsc_env guts info p
     go =
       do
         builtins       <- initBuiltins
-        let builtin_tycons = initBuiltinTyCons builtins
+        let builtin_tycons   = initBuiltinTyCons   builtins
+            builtin_datacons = initBuiltinDataCons builtins
         builtin_pas    <- initBuiltinPAs builtins
         builtin_prs    <- initBuiltinPRs builtins
         builtin_boxed  <- initBuiltinBoxedTyCons builtins
@@ -495,6 +500,7 @@ initV hsc_env guts info p
             instEnvs    = (eps_inst_env     eps, mg_inst_env     guts)
 
         let genv = extendTyConsEnv builtin_tycons
+                 . extendDataConsEnv builtin_datacons
                  . extendPAFunsEnv builtin_pas
                  . setPRFunsEnv    builtin_prs
                  . setBoxedTyConsEnv builtin_boxed
-- 
1.7.10.4