shithub: MicroHs

Info  •  Files  •  Log  •  Branches

Temp

--- a/lib/Data/Typeable.hs

+++ b/lib/Data/Typeable.hs

@@ -18,7 +18,6 @@

   typeRepArgs,

   ) where

 import Primitives

-import Prelude

 import Control.Monad.ST

 import Data.IORef

 import Data.Proxy

--- a/src/MicroHs/Compile.hs

+++ b/src/MicroHs/Compile.hs

@@ -24,6 +24,7 @@

 import System.Process

 import Control.DeepSeq

 import MicroHs.Abstract

+import MicroHs.Builtin

 import MicroHs.CompileCache

 import MicroHs.Desugar

 import MicroHs.Exp

@@ -209,11 +210,15 @@

         isImportPrelude (Import (ImportSpec _ _ i _ _)) = i == idPrelude

         isImportPrelude _ = False

         idPrelude = mkIdent "Prelude"

+        idBuiltin = mkIdent "Mhs.Builtin"

+        idB = mkIdent builtinMdl

+        iblt = Import $ ImportSpec ImpNormal True idBuiltin (Just idB) Nothing

         ps' =

           case ps of

-            [] -> [Import $ ImportSpec ImpNormal False idPrelude Nothing Nothing]     -- no Prelude imports, so add 'import Prelude'

-            [Import (ImportSpec ImpNormal False _ Nothing (Just (False, [])))] -> []  -- exactly 'import Prelude()', so import nothing

-            _ -> ps                                                         -- keep the given Prelude imports

+            [] -> [Import $ ImportSpec ImpNormal False idPrelude Nothing Nothing,      -- no Prelude imports, so add 'import Prelude'

+                   iblt]                                                               -- and 'import Mhs.Builtin as @B'

+            [Import (ImportSpec ImpNormal False _ Nothing (Just (False, [])))] -> []   -- exactly 'import Prelude()', so import nothing

+            _ -> iblt : ps                                                             -- keep the given Prelude imports, add Builtin

 -------------------------------------------

--- a/src/MicroHs/Deriving.hs

+++ b/src/MicroHs/Deriving.hs

@@ -3,6 +3,7 @@

 import Data.Char

 import Data.Function

 import Data.List

+import MicroHs.Builtin

 import MicroHs.Expr

 import MicroHs.Ident

 import MicroHs.TCMonad

@@ -62,8 +63,8 @@

       undef = mkExn loc (unIdent fld) "recSelError"

       iHasField = mkBuiltin loc nameHasField

       iSetField = mkBuiltin loc nameSetField

-      igetField = mkBuiltin loc namegetField

-      isetField = mkBuiltin loc namesetField

+      igetField = mkIdentSLoc loc namegetField

+      isetField = mkIdentSLoc loc namesetField

       hdrGet = eForall iks $ eApp3 (EVar iHasField)

                                    (ELit loc (LStr (unIdent fld)))

                                    (eApps (EVar qtycon) (map (EVar . idKindIdent) iks))

@@ -125,9 +126,9 @@

   mn <- gets moduleName

   let

     loc = getSLoc i

-    itypeRep  = mkBuiltin loc "typeRep"

+    itypeRep  = mkIdentSLoc loc "typeRep"

     imkTyConApp = mkBuiltin loc "mkTyConApp"

-    imkTyCon = mkTyConApp loc "mkTyCon"

+    imkTyCon = mkBuiltin loc "mkTyCon"

     hdr = EApp etyp (EVar $ qualIdent mn i)

     mdl = ELit loc $ LStr $ unIdent mn

     nam = ELit loc $ LStr $ unIdent i

@@ -172,8 +173,8 @@

             (yp, ys) = mkPat c "y"

         in  eEqn [xp, yp] $ if null xs then eTrue else foldr1 eAnd $ zipWith eEq xs ys

       eqns = map mkEqn cs ++ [eEqn [eDummy, eDummy] eFalse]

-      iEq = mkBuiltin loc "=="

-      eEq = EApp . EApp (EVar iEq)

+      iEq = mkIdentSLoc loc "=="

+      eEq = EApp . EApp (EVar $ mkBuiltin loc "==")

       eAnd = EApp . EApp (EVar $ mkBuiltin loc "&&")

       eTrue = EVar $ mkBuiltin loc "True"

       eFalse = EVar $ mkBuiltin loc "False"

@@ -181,9 +182,6 @@

 --  traceM $ showEDefs [inst]

   return [inst]

 derEq (c, _) _ e = cannotDerive "Eq" c e

-

-nameDataEq :: String

-nameDataEq = "Data.Eq"

 --------------------------------------------

--- a/src/MicroHs/Ident.hs

+++ b/src/MicroHs/Ident.hs

@@ -16,7 +16,6 @@

   SLoc(..), noSLoc,

   showSLoc,

   ) where

-import Data.Eq

 import Data.Char

 import Text.PrettyPrint.HughesPJLite

 import GHC.Stack

--- a/src/MicroHs/SymTab.hs

+++ b/src/MicroHs/SymTab.hs

@@ -14,8 +14,9 @@

   ) where

 import Control.Applicative

 import Data.List

+import MicroHs.Builtin(builtinMdl)

 import MicroHs.Expr(Expr(..), EType, conIdent)

-import MicroHs.Ident(Ident, showIdent)

+import MicroHs.Ident(Ident(..), showIdent)

 import MicroHs.List

 import qualified MicroHs.IdentMap as M

@@ -82,12 +83,16 @@

   case lookup i l of

     Just e -> Right e

     Nothing ->

-      case M.lookup i ug <|> M.lookup i qg of

+      case M.lookup i ug <|> M.lookup i qg <|> M.lookup (hackBuiltin i) ug of

         Just [e] -> Right e

         Just es  -> Left $ "ambiguous " ++ msg ++ ": " ++ showIdent i ++ " " ++

                            showListS showIdent [ getIdent e | Entry e _ <- es ]

         Nothing  -> Left $ "undefined " ++ msg ++ ": " ++ showIdent i

                            -- ++ "\n" ++ show lenv ++ "\n" ++ show genv

+

+hackBuiltin :: Ident -> Ident

+hackBuiltin (Ident l qs) | Just ('.':s) <- stripPrefix builtinMdl qs = Ident l s

+hackBuiltin i = i

 stFromList :: [(Ident, [Entry])] -> [(Ident, [Entry])] -> SymTab

 stFromList us qs = SymTab [] (M.fromListWith union us) (M.fromListWith union qs)

--- a/src/MicroHs/TypeCheck.hs

+++ b/src/MicroHs/TypeCheck.hs

@@ -1006,7 +1006,7 @@

   dsf <- concat <$> mapM expandField dsc              -- Add HasField instances

 --  traceM $ showEDefs dsf

   dsd <- concat <$> mapM doDeriving  dsf              -- Add derived instances

---  traceM $ showEDefs dsd

+  traceM $ showEDefs dsd

   dsi <- concat <$> mapM expandInst  dsd              -- Expand all instance definitions

   return dsi

-- 

⑨