MagicHaskeller 0.9.6.6 → 0.9.6.6.1
raw patch · 7 files changed
+71/−24 lines, 7 files
Files
- MagicHaskeller.cabal +2/−2
- MagicHaskeller.lhs +12/−2
- MagicHaskeller/ExecuteAPI610.hs +34/−12
- MagicHaskeller/Individual.hs +1/−1
- MagicHaskeller/LibTH.hs +6/−6
- MagicHaskeller/SimpleServer.hs +13/−1
- changelog.txt +3/−0
MagicHaskeller.cabal view
@@ -1,5 +1,5 @@ Name: MagicHaskeller-Version: 0.9.6.6+Version: 0.9.6.6.1 Cabal-Version: >= 1.8 License: BSD3 License-file: LICENSE @@ -17,7 +17,7 @@ Category: Language data-files: ExperimIOP.hs MagicHaskeller/predicates MagicHaskeller/predicatesAug2014 MagicHaskeller.conf MagicHaskeller/predicatesServed primitives.txt Extra-source-files: xlmap changelog.txt-Tested-with: GHC == 7.6.3, GHC == 7.10.3+Tested-with: GHC == 7.6.3, GHC == 7.10.3, GHC == 8.0.2 Flag TFRANDOM Description: Use the tf-random package instead of the random package
MagicHaskeller.lhs view
@@ -259,9 +259,19 @@ _ -> (return . ListE . return) =<< p1 e -- This default pattern should also be defined, because it takes two (or more) to tuple! p1 :: TH.Exp -> TH.ExpQ p1 (SigE e ty) = p1' (SigE e $ useArrowT ty) e ty-p1 e@(ConE name) = do DataConI _ ty _ _ <- reify name+p1 e@(ConE name) = do+#if __GLASGOW_HASKELL__ < 800+ DataConI _ ty _ _ <- reify name+#else + DataConI _ ty _ <- reify name+#endif p1' e e ty-p1 e@(VarE name) = do VarI _ ty _ _ <- reify name+p1 e@(VarE name) = do+#if __GLASGOW_HASKELL__ < 800+ VarI _ ty _ _ <- reify name+#else+ VarI _ ty _ <- reify name+#endif p1' e e ty p1 e = [| (HV (unsafeCoerce# $(return e)), $(expToExpExp e), trToTHType (typeOf $(return e))) |]
MagicHaskeller/ExecuteAPI610.hs view
@@ -41,7 +41,7 @@ import ErrUtils import StringBuffer (stringToStringBuffer) import Outputable (ppr, pprPanic, showSDocDebug, showSDoc)-import TypeRep (pprType, Type)+import Type (pprType, Type) import CoreLint (lintUnfolding) import VarSet (varSetElems)@@ -88,7 +88,16 @@ import UniqSupply import ByteCodeLink(linkBCO,extendClosureEnv)+#ifdef PRELINK+# if __GLASGOW_HASKELL__ >= 800+import ByteCodeTypes(UnlinkedBCO(unlinkedBCOName))+# else import ByteCodeAsm(UnlinkedBCO(unlinkedBCOName))+# endif+#endif+# if __GLASGOW_HASKELL__ >= 800+import GHCi(wormhole)+#endif import Data.Array @@ -173,7 +182,11 @@ #if __GLASGOW_HASKELL__ < 710 packageNameToFlag = ExposePackage #else+# if __GLASGOW_HASKELL__ < 800 packageNameToFlag name = ExposePackage (PackageArg name) (ModRenaming False []) -- I am not sure this is the correct conversion, because I could not find any documentation on the change.+# else+packageNameToFlag name = ExposePackage ("-package "++name) (PackageArg name) (ModRenaming False []) -- I am not sure this is the correct conversion, because I could not find any documentation on the change.+# endif #endif {-@@ -221,10 +234,14 @@ -- unwrapCore' hscEnv ce = fmap head $ unsafeCoerce# =<< HscMain.compileExpr hscEnv (srcLocSpan interactiveSrcLoc) ce -#if __GLASGOW_HASKELL__ >= 700-ce2b dfs pe = coreExprToBCOs dfs undefined pe+#if __GLASGOW_HASKELL__ >= 800+ce2b hscEnv pe = coreExprToBCOs hscEnv undefined pe #else-ce2b dfs pe = coreExprToBCOs dfs pe+# if __GLASGOW_HASKELL__ >= 700+ce2b hscEnv pe = coreExprToBCOs (hsc_dflags hscEnv) undefined pe+# else+ce2b hscEnv pe = coreExprToBCOs (hsc_dflags hscEnv) pe+# endif #endif runCoreExpr, runPrepedCoreExpr :: HscEnv -> CoreExpr -> IO a@@ -238,8 +255,7 @@ pe <- corePrepExpr dfs ce -- runPrepedCoreExprとの違いはこのcorePrepExprがあるかどうかだけ #endif bcos <- -- repeatIO 10 $- ce2b dfs pe-+ ce2b hscEnv pe #ifdef PRELINK hv <- linkTheExpr bcos #else@@ -250,9 +266,7 @@ runPrepedCoreExpr hscEnv ce = -- repeatIO 10 $ do- let dfs = hsc_dflags hscEnv-- bcos <- ce2b dfs ce+ bcos <- ce2b hscEnv ce -- repeatIO 10 $ #ifdef PRELINK hv <- linkTheExpr bcos@@ -312,7 +326,12 @@ -- thExpToStmt :: HscEnv -> TH.Exp -> HsExpr.LStmt RdrName.RdrName thExpToStmt hscEnv = wrapLHsExpr . thExpToLHsExpr hscEnv -- wrapLHsExpr :: HsExpr.LHsExpr RdrName.RdrName -> HsExpr.LStmt RdrName.RdrName-wrapLHsExpr expr = noLoc $ LetStmt (HsValBinds (ValBindsIn (Bag.unitBag (HsUtils.mk_easy_FunBind noSrcSpan (Unqual $ mkOccName OccName.varName "__cmCompileExpr") [] expr)) []))+wrapLHsExpr expr =+ noLoc $ LetStmt $ +#if __GLASGOW_HASKELL__ >= 800+ noLoc $ +#endif+ HsValBinds (ValBindsIn (Bag.unitBag (HsUtils.mk_easy_FunBind noSrcSpan (Unqual $ mkOccName OccName.varName "__cmCompileExpr") [] expr)) []) thExpToLHsExpr :: HscEnv -> TH.Exp -> HsExpr.LHsExpr RdrName.RdrName thExpToLHsExpr hscEnv e = case Convert.convertToHsExpr noSrcSpan e of #if __GLASGOW_HASKELL__ >= 706@@ -355,7 +374,6 @@ rtis (NonRec b e) = NonRec b (removeTInfo e) rtis (Rec ts) = Rec [ (b, removeTInfo e) | (b,e) <- ts ] -}- compileExprHscMain :: HscEnv -> CoreExpr -> IO HValue compileExprHscMain hscEnv ce = do let dflags = hsc_dflags hscEnv@@ -365,8 +383,12 @@ #else prep <- corePrepExpr dflags smpl #endif- bcos <- ce2b dflags prep+ bcos <- ce2b hscEnv prep linkExpr hscEnv noSrcSpan bcos+#if __GLASGOW_HASKELL__ >= 800+ >>= wormhole dflags+#endif+ #ifdef GHC6 {-
MagicHaskeller/Individual.hs view
@@ -59,7 +59,7 @@ availableNames :: [String] availableNames = map fst assocAvailables --- postprocess¤ò»È¤¤¤¿¤¯¤Ê¤ë¤±¤É¡¤·ë²ÌƱ¤¸É½¸½¤Ë¤Ê¤Ã¤Á¤ã¤¦¤È¤Þ¤º¤¤¡¥+-- postprocessを使いたくなるけど，結果同じ表現になっちゃうとまずい． pprintPrim :: Primitive -> String pprintPrim (_, e@(VarE name), t) = case nameBase name of
MagicHaskeller/LibTH.hs view
@@ -271,8 +271,8 @@ by1 name = name -} --- ¤³¤ÎÊÕ¤ÏCoreLang¤Ç¤ä¤ë¤Ù¤¤È¤¤¤¦µ¤¤â¡¥¾¯¤Ê¤¯¤È¤â¡¤¤½¤Ã¤Á¤Ç´Ø¿ô¤òÄêµÁ¤¹¤Ù¤¡¥--- \x -> iF foo bar x ¤Î¾ì¹ç¤âÀè¤Ë¦Ç´ÊÌ󤵤ì¤Æ¤·¤Þ¤¦¤È¥¤¥Þ¥¤¥Á¤Ç¤Ï¤¢¤ë¡¥¤Î¤Ç¡¤¦Ç´ÊÌó¤ÏiF, nat_cata, tail¤Ê¤É¤Î½èÍý¤Î¸å¤Ë¤ä¤ë¡¥+-- この辺はCoreLangでやるべきという気も．少なくとも，そっちで関数を定義すべき．+-- \x -> iF foo bar x の場合も先にη簡約されてしまうとイマイチではある．ので，η簡約はiF, nat_cata, tailなどの処理の後にやる． -- For readability, we apply eta-reduction only when we can fully eta-reduce at the outermost lambda-abstraction. ppLambda [VarP n] (AppE e (VarE n')) | shown == show n' && not (shown `appearsIn` e) = e where shown = show n@@ -397,7 +397,7 @@ -} newtype Partial a = Part {undef :: a} undefs = map (\[a,b] -> (a,b)) $- [-- Bool ã Orderingã®ããã«ããããã¡ãªå¤ãè¿ãã¦ãã¾ããã®ã¯ãæ¡ç¨ãã¹ãã§ãªãã$(p [| (Part False :: Partial Bool, undefined :: Partial Bool) |]), $(p [| (Part EQ :: Partial Ordering, undefined :: Partial Ordering) |]),+ [-- Bool や Orderingのように、ありがちな値を返してしまうものは、採用すべきでない。$(p [| (Part False :: Partial Bool, undefined :: Partial Bool) |]), $(p [| (Part EQ :: Partial Ordering, undefined :: Partial Ordering) |]), $(p [| (Part 53 :: Partial Int, undefined :: Partial Int) |]), $(p [| (Part '\29' :: Partial Char, undefined :: Partial Char) |]), $(p [| (Part [43] :: Partial [Int], undefined :: Partial [Int]) |]), @@ -508,7 +508,7 @@ by2_cmpPair (Ord compare1) (Ord compare2) = Ord $ comparePairBy compare1 compare2 comparePairBy compare1 compare2 (x,y) (z,w) = case compare1 x z of EQ -> compare2 y w o -> o-ords = $(p [| (cmp :: Ordered Bool, cmp :: Ordered Ordering, -- ãªããcomment outããã¦ããã®ã§å¾©æ´»ããã¦ã¿ããåé¡ãããªãæ»ããã+ords = $(p [| (cmp :: Ordered Bool, cmp :: Ordered Ordering, -- なぜかcomment outされていたので復活させてみた。問題あるなら戻すが。 cmp :: Ordered Int, cmp :: Ordered Char, -- cmp :: Ordered (Ratio Int) is defined in ratioCls by1_cmpMaybe :: Ordered a -> Ordered (Maybe a), by1_cmpList :: Ordered a -> Ordered [a], by2_cmpEither :: Ordered a -> Ordered b -> Ordered (Either a b), by2_cmpPair :: Ordered a -> Ordered b -> Ordered (a,b)) |])@@ -649,7 +649,7 @@ -- | Library used by the program server backend pgfull :: ProgGenSF--- pgfull = mkPG ($(MagicHaskeller.LibTH.load "libsrc/PreludeList.hs") ++ mb ++ bool ++ boolean ++ $(p [| ([], (:), (+) :: Int -> Int -> Int, replicate :: Int -> a -> [a]) |]) ++ $(p [| until :: (a -> Bool) -> (a -> a) -> a -> a |]) ++ nat ++ intinst) -- rich ã¨ãã¾ãå¤ãããªãï¼+-- pgfull = mkPG ($(MagicHaskeller.LibTH.load "libsrc/PreludeList.hs") ++ mb ++ bool ++ boolean ++ $(p [| ([], (:), (+) :: Int -> Int -> Int, replicate :: Int -> a -> [a]) |]) ++ $(p [| until :: (a -> Bool) -> (a -> a) -> a -> a |]) ++ nat ++ intinst) -- rich とあまり変わらない． pgfull = mkPGXOpt options{tv1=True,nrands=repeat 20,timeout=Just 100000} (eqs++ords) clspartialss full tupartialssNormal -- A pgfull must be a CAF, so we must have pgfulls and access pgfullSized via pgfulls. Directly calling pgfullSized is heap-inefficient. pgfulls :: [ProgGenSF]@@ -713,7 +713,7 @@ flip (flip . either) :: (->) (Either a b) ((a -> c) -> (b -> c) -> c)) |]) ++ intinst2 ++ $(p [| (sum :: (->) [Int] Int, product :: (->) [Int] Int) |]), list2 ++ $(p [| (scanl :: (a -> b -> a) -> a -> [b] -> [a], scanr :: (a -> b -> b) -> b -> [a] -> [b], scanl1 :: (a -> a -> a) -> [a] -> [a], scanr1 :: (a -> a -> a) -> [a] -> [a],- -- until :: (a -> Bool) -> (a -> a) -> a -> a) ãå ¥ãã¦ããï¼ã©ããuntilãããã¨æ¥ã«é ããªãï¼ãã®å²ã«ï¼å ¨ã使ãããªãï¼ä½ããããã¤+ -- until :: (a -> Bool) -> (a -> a) -> a -> a) を入れてたが，どうもuntilがあると急に遅くなる．その割に，全く使われない．何じゃらホイ show :: Int -> [Char]) |])++ $(p [| ((,) :: a -> b -> (a,b), flip uncurry :: (->) (a,b) ((a->b->c) -> c)) |]), $(p [| ((,,) :: a -> b -> c -> (a,b,c), Left :: a -> Either a b, Right :: b -> Either a b, zip :: (->) [a] ((->) [b] [(a, b)]),
MagicHaskeller/SimpleServer.hs view
@@ -404,8 +404,11 @@ #endif return $ Left (funIO, sig) +-- Note that the following causes a type mismatch with ghc>=8.0 because mkForAllTys takes TyBinder (which includes visibility info).+#if __GLASGOW_HASKELL__ < 706 -- assumes rank-1 types extractArgTy ty = case splitForAllTys ty of (tvs, fty) -> case splitFunTys fty of (args, _bool) -> mkForAllTys tvs $ mkFunTys (Prelude.init args) $ last args+#endif crlfToSpace '\n' = ' ' crlfToSpace c = c@@ -429,7 +432,12 @@ -- x # if __GLASGOW_HASKELL__ >= 708 -- x let newf = xopt_set dfs{packageFlags = [ packageNameToFlag "MagicHaskeller" ], optLevel=2, parMakeCount=Nothing} Opt_ExtendedDefaultRules -- parMakeCount=Nothing corresponds to -j. See http://downloads.haskell.org/~ghc/7.10.2/docs/html/libraries/ghc-7.10.2/DynFlags.html -- but seemingly this does not make the code faster, so is commented out. -- x # else- let newf = xopt_set dfs{packageFlags = [ packageNameToFlag "MagicHaskeller" ], optLevel=2} Opt_ExtendedDefaultRules+ let newf = xopt_set dfs{packageFlags = [ packageNameToFlag "MagicHaskeller" ], optLevel=2}+# if __GLASGOW_HASKELL__ >= 800+ ExtendedDefaultRules+# else+ Opt_ExtendedDefaultRules+# endif -- x # endif #else let newf = dfs{packageFlags = [ packageNameToFlag "MagicHaskeller" ], optLevel=2}@@ -452,5 +460,9 @@ #if __GLASGOW_HASKELL__ < 710 packageNameToFlag = ExposePackage #else+# if __GLASGOW_HASKELL__ < 800 packageNameToFlag name = ExposePackage (PackageArg name) (ModRenaming False []) -- I am not sure this is the correct conversion, because I could not find any documentation on the change.+# else+packageNameToFlag name = ExposePackage ("-package "++name) (PackageArg name) (ModRenaming False []) -- I am not sure this is the correct conversion, because I could not find any documentation on the change.+# endif #endif
changelog.txt view
@@ -1,3 +1,6 @@+0.9.6.6.1:+ * support GHC 8.0+ 0.9.6.6: * enable selecting functions individually