shithub: MicroHs

Download patch

ref: 0b9fc139e6268d7a8b9374592847903959d6c927
parent: 85934531635bf5b05a242813c002d7504bdff043
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Fri Sep 22 07:12:42 EDT 2023 

Use rnf.


--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v3.5
-887
-(($A :0 _774) (($A :1 (($B _820) _0)) (($A :2 ((($S' _820) _0) $I)) (($A :3 _744) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _773) (($C _48) _5))) (($A :7 ((($C' _6) (_791 _45)) ((_48 _789) _44))) (($A :8 (($B (($S _820) _789)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_48 _160)) _10)) (($A :12 (($B ($B (_47 _9))) ((($C' $B) (($B $C) _10)) ($B _10)))) (($A :13 (($B ($B (_47 _9))) ((($C' $B) (($B $C) _10)) ($BK _10)))) (($A :14 (($B (_47 _9)) $P)) (($A :15 (($B ($B (_47 _9))) (($B (($C' $C) _10)) ($B $P)))) (($A :16 _15) (($A :17 (($B (_47 _9)) ($B ($P _714)))) (($A :18 (($B (_47 _9)) ($BK ($P _714)))) (($A :19 ((_47 _9) (($S $P) $I))) (($A :20 (($B (_47 _9)) (($C ($S' $P)) $I))) (($A :21 (($B $Y) (($B ($B ($P (_14 _88)))) ((($C' $B) (($B ($C' $B)) ($B _12))) ((($C' ($C' $B)) ($B _12)) (($B ($B _14)) _89)))))) (($A :22 (($B $Y) (($B ($B ($P (_14 _714)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _714))) (($A :25 (($C $C) _32)) (($A :26 ($T _31)) (($A :27 (($P _32) _31)) (($A :28 _32) (($A :29 (($C (($C $S') _27)) $I)) (($A :30 (($C $S) _27)) (($A :31 $K) (($A :32 $A) (($A :33 _749) (($A :34 _750) (($A :35 ((($S' _26) (_741 97)) (($C _741) 122))) (($A :36 ((($S' _26) (_741 65)) (($C _741) 90))) (($A :37 ((($S' _25) _35) _36)) (($A :38 ((($S' _26) (_741 48)) (($C _741) 57))) (($A :39 ((($S' _26) (_741 32)) (($C _741) 126))) (($A :40 _738) (($A :41 _739) (($A :42 _741) (($A :43 _740) (($A :44 (($B $BK) $T)) (($A :45 ($BK $T)) (($A :46 $P) (($A :47 $I) (($A :48 $B) (($A :49 $I) (($A :50 $K) (($A :51 $C) (($A :52 _745) (($A :53 (($C (($C $S') _160)) _161)) (($A :54 ((($C' ($S' ($C' $B))) $B) $I)) (($A :55 _715) (($A :56 _716) (($A :57 _717) (($A :58 _718) (($A :59 _719) (($A :60 _720) (($A :61 (_56 0)) (($A :62 _726) (($A :63 _727) (($A :64 _728) (($A :65 _729) (($A :66 _730) (($A :67 _731) (($A :68 _62) (($A :69 ($BK $K)) (($A :70 (($B $BK) (($B ($B $BK)) $P))) (($A :71 (($B ($B ($B $BK))) (($B ($B ($B $BK))) (($B ($B ($B $C))) (($B ($B $C)) $P))))) (($A :72 ((($S' $S) ((($S' ($S' $C)) ((($C' ($C' $S)) ((($C' $B) (($B ($S' $S')) ((($C' $B) (($B _25) (_65 0))) (_62 0)))) (($B ($B (($C' $P) (_60 1)))) _55))) ($C $P))) _58)) _59)) (($A :73 _69) (($A :74 ((($S' $C) (($B ($P _149)) ((($C' ($C' $B)) ((($C' $C) _62) _149)) _150))) (($B (($C' ($C' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) (($B (($C' ($C' ($C' $C))) (($B ($B ($B (($S' $S') (_62 0))))) (($B (($C' ($C' $C)) (($B ($B (($S' $S') (_62 1)))) (($B (($C' $C) (($B (($C' $S') (_62 2))) ($C _74)))) ($C _74))))) ($C _74))))) ($C _74)))) ($T $K))) ($T $A)))) (($C _72) 4)))) (($A :75 (_81 _50)) (($A :76 ((_96 (_53 _75)) _73)) (($A :77 (($C ((($C' $B) (($P _88) ((($C' ($C' $O)) $P) $K))) ((($S' ($C' ($C' ($C' $B)))) (($B ($B ($B ($B _78)))) ((($S' ($C' ($C' $B))) (($B ($B ($B _78))) ((($S' ($C' $B)) (($B ($B _78)) ((($C' $B) (($B _94) ($T 0))) _77))) ((($C' $B) (($B _94) ($T 1))) _77)))) ((($C' $B) (($B _94) ($T 2))) _77)))) ((($C' $B) (($B _94) ($T 3))) _77)))) (($B $T) (($B ($B $P)) (($C' _55) (_57 4)))))) (($A :78 (($S $S) (($B $BK) (($B $BK) ((($S' $S) $T) (($B $BK) (($B $BK) (($C ((($S' $C') $S) (($B ($B ($B ($S $B)))) (($B ($B ($B ($B ($B $BK))))) (($B (($S' ($C' $B)) (($B $B') $B'))) (($B ($B ($B ($B ($B ($S $B)))))) (($B ($B ($B ($B ($B ($B ($B $BK))))))) ((($C' $B) ($B' ($B' (($B ($C' ($C' ($C' $C)))) (($B (($C' $B) ($B' (($B $C) _64)))) (($B (($C' $B) _89)) _78)))))) (($B (($C' $B) _89)) ($C _78)))))))))) (((_713 "lib/Data/IntMap.hs") 3) 8))))))))) (($A :79 ((_48 (_94 _160)) _77)) (($A :80 ((($C' $C) ((($C' $C) ($C _74)) (_3 "Data.IntMap.!"))) $I)) (($A :81 (($B (($C' $B) $T)) (($B ($B $Y)) ((($C' ($C' ($S' ($S' $C)))) (($B (($S' $B) (($B ($S' $P)) ($C _70)))) (($B ($B (($C' ($S' $C)) (($B (($S' ($S' $S')) _62)) ((($C' ($C' $B)) (($B $B') ($B _47))) ((($C' ($C' _47)) _75) ((((_71 _69) _69) _69) _69))))))) ($B (($C' $B) _70))))) ((($C' $B) (($B ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($S' ($S' ($S' ($S' ($S' $C))
\ No newline at end of file
+882
+(($A :0 _769) (($A :1 (($B _815) _0)) (($A :2 ((($S' _815) _0) $I)) (($A :3 _739) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _768) (($C _48) _5))) (($A :7 ((($C' _6) (_786 _45)) ((_48 _784) _44))) (($A :8 (($B (($S _815) _784)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_48 _159)) _10)) (($A :12 (($B ($B (_47 _9))) ((($C' $B) (($B $C) _10)) ($B _10)))) (($A :13 (($B ($B (_47 _9))) ((($C' $B) (($B $C) _10)) ($BK _10)))) (($A :14 (($B (_47 _9)) $P)) (($A :15 (($B ($B (_47 _9))) (($B (($C' $C) _10)) ($B $P)))) (($A :16 _15) (($A :17 (($B (_47 _9)) ($B ($P _709)))) (($A :18 (($B (_47 _9)) ($BK ($P _709)))) (($A :19 ((_47 _9) (($S $P) $I))) (($A :20 (($B (_47 _9)) (($C ($S' $P)) $I))) (($A :21 (($B $Y) (($B ($B ($P (_14 _88)))) ((($C' $B) (($B ($C' $B)) ($B _12))) ((($C' ($C' $B)) ($B _12)) (($B ($B _14)) _89)))))) (($A :22 (($B $Y) (($B ($B ($P (_14 _709)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _709))) (($A :25 (($C $C) _32)) (($A :26 ($T _31)) (($A :27 (($P _32) _31)) (($A :28 _32) (($A :29 (($C (($C $S') _27)) $I)) (($A :30 (($C $S) _27)) (($A :31 $K) (($A :32 $A) (($A :33 _744) (($A :34 _745) (($A :35 ((($S' _26) (_736 97)) (($C _736) 122))) (($A :36 ((($S' _26) (_736 65)) (($C _736) 90))) (($A :37 ((($S' _25) _35) _36)) (($A :38 ((($S' _26) (_736 48)) (($C _736) 57))) (($A :39 ((($S' _26) (_736 32)) (($C _736) 126))) (($A :40 _733) (($A :41 _734) (($A :42 _736) (($A :43 _735) (($A :44 (($B $BK) $T)) (($A :45 ($BK $T)) (($A :46 $P) (($A :47 $I) (($A :48 $B) (($A :49 $I) (($A :50 $K) (($A :51 $C) (($A :52 _740) (($A :53 (($C (($C $S') _159)) _160)) (($A :54 ((($C' ($S' ($C' $B))) $B) $I)) (($A :55 _710) (($A :56 _711) (($A :57 _712) (($A :58 _713) (($A :59 _714) (($A :60 _715) (($A :61 (_56 0)) (($A :62 _721) (($A :63 _722) (($A :64 _723) (($A :65 _724) (($A :66 _725) (($A :67 _726) (($A :68 _62) (($A :69 ($BK $K)) (($A :70 (($B $BK) (($B ($B $BK)) $P))) (($A :71 (($B ($B ($B $BK))) (($B ($B ($B $BK))) (($B ($B ($B $C))) (($B ($B $C)) $P))))) (($A :72 ((($S' $S) ((($S' ($S' $C)) ((($C' ($C' $S)) ((($C' $B) (($B ($S' $S')) ((($C' $B) (($B _25) (_65 0))) (_62 0)))) (($B ($B (($C' $P) (_60 1)))) _55))) ($C $P))) _58)) _59)) (($A :73 _69) (($A :74 ((($S' $C) (($B ($P _148)) ((($C' ($C' $B)) ((($C' $C) _62) _148)) _149))) (($B (($C' ($C' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) (($B (($C' ($C' ($C' $C))) (($B ($B ($B (($S' $S') (_62 0))))) (($B (($C' ($C' $C)) (($B ($B (($S' $S') (_62 1)))) (($B (($C' $C) (($B (($C' $S') (_62 2))) ($C _74)))) ($C _74))))) ($C _74))))) ($C _74)))) ($T $K))) ($T $A)))) (($C _72) 4)))) (($A :75 (_81 _50)) (($A :76 ((_96 (_53 _75)) _73)) (($A :77 (($C ((($C' $B) (($P _88) ((($C' ($C' $O)) $P) $K))) ((($S' ($C' ($C' ($C' $B)))) (($B ($B ($B ($B _78)))) ((($S' ($C' ($C' $B))) (($B ($B ($B _78))) ((($S' ($C' $B)) (($B ($B _78)) ((($C' $B) (($B _94) ($T 0))) _77))) ((($C' $B) (($B _94) ($T 1))) _77)))) ((($C' $B) (($B _94) ($T 2))) _77)))) ((($C' $B) (($B _94) ($T 3))) _77)))) (($B $T) (($B ($B $P)) (($C' _55) (_57 4)))))) (($A :78 (($S $S) (($B $BK) (($B $BK) ((($S' $S) $T) (($B $BK) (($B $BK) (($C ((($S' $C') $S) (($B ($B ($B ($S $B)))) (($B ($B ($B ($B ($B $BK))))) (($B (($S' ($C' $B)) (($B $B') $B'))) (($B ($B ($B ($B ($B ($S $B)))))) (($B ($B ($B ($B ($B ($B ($B $BK))))))) ((($C' $B) ($B' ($B' (($B ($C' ($C' ($C' $C)))) (($B (($C' $B) ($B' (($B $C) _64)))) (($B (($C' $B) _89)) _78)))))) (($B (($C' $B) _89)) ($C _78)))))))))) (((_708 "lib/Data/IntMap.hs") 3) 8))))))))) (($A :79 ((_48 (_94 _159)) _77)) (($A :80 ((($C' $C) ((($C' $C) ($C _74)) (_3 "Data.IntMap.!"))) $I)) (($A :81 (($B (($C' $B) $T)) (($B ($B $Y)) ((($C' ($C' ($S' ($S' $C)))) (($B (($S' $B) (($B ($S' $P)) ($C _70)))) (($B ($B (($C' ($S' $C)) (($B (($S' ($S' $S')) _62)) ((($C' ($C' $B)) (($B $B') ($B _47))) ((($C' ($C' _47)) _75) ((((_71 _69) _69) _69) _69))))))) ($B (($C' $B) _70))))) ((($C' $B) (($B ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($S' ($S' ($S' ($S' ($S' $C))
\ No newline at end of file
--- a/ghc/Primitives.hs
+++ b/ghc/Primitives.hs
@@ -6,7 +6,7 @@
   Int,
   IO,
   Word,
-  NFData,
+  NFData(..),
   ) where
 import Control.DeepSeq
 import Control.Exception(try)
--- a/lib/Control/DeepSeq.hs
+++ b/lib/Control/DeepSeq.hs
@@ -1,5 +1,5 @@
 module Control.DeepSeq(module Control.DeepSeq) where
-import Primitives
+import Primitives --Yhiding(rnf)
 import Prelude
 
 rnf :: forall a . --YNFData a =>
--- a/lib/Data/List.hs
+++ b/lib/Data/List.hs
@@ -305,7 +305,3 @@
 last [] = error "last: []"
 last [x] = x
 last (_:xs) = last xs
-
-forceList :: forall a . (a -> ()) -> [a] -> ()
-forceList _ [] = ()
-forceList f (a:as) = case f a of { () -> forceList f as }
--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -8,10 +8,7 @@
   ) where
 import Prelude --Xhiding (Monad(..), mapM, showString, showList)
 import qualified System.IO as IO
---Ximport Compat
---Ximport qualified CompatIO as IO
---Ximport System.IO(Handle)
-
+import Control.DeepSeq
 import qualified MicroHs.IdentMap as M
 import MicroHs.StateIO as S
 import MicroHs.Desugar
@@ -20,6 +17,9 @@
 import MicroHs.Ident
 import MicroHs.Parse
 import MicroHs.TypeCheck
+--Ximport Compat
+--Ximport qualified CompatIO as IO
+--Ximport System.IO(Handle)
 
 data Flags = Flags Int Bool [String] String
   --Xderiving (Show)
@@ -67,7 +67,7 @@
   t1 <- getTimeMilli
   let
     dsn = [ (n, compileOpt e) | (n, e) <- ds ]
-  () <- IO.return (forceList forceLDef dsn)
+  () <- IO.return (rnf dsn)
   t2 <- getTimeMilli
   IO.when (verbose flags > 0) $
     putStrLn $ "combinator conversion " ++ padLeft 6 (showInt (t2-t1)) ++ "ms"
--- a/src/MicroHs/Desugar.hs
+++ b/src/MicroHs/Desugar.hs
@@ -3,7 +3,7 @@
 {-# OPTIONS_GHC -Wno-type-defaults -Wno-incomplete-uni-patterns -Wno-unused-imports -Wno-dodgy-imports #-}
 module MicroHs.Desugar(
   desugar,
-  LDef, showLDefs, forceLDef
+  LDef, showLDefs,
   ) where
 import Prelude --Xhiding(showList)
 import Data.Char
@@ -507,7 +507,3 @@
     (i1:i2:_) : _ ->
       errorMessage (getSLocIdent i1) $ "Duplicate " ++ showIdent i1 ++ " " ++ showSLoc (getSLocIdent i2)
     _ -> error "checkDup"
-
-forceLDef :: LDef -> ()
-forceLDef (i, e) = case forceIdent i of { () -> forceExp e }
-
--- a/src/MicroHs/Exp.hs
+++ b/src/MicroHs/Exp.hs
@@ -9,14 +9,15 @@
   encodeString,
   app2, cCons, cNil, cFlip,
   allVarsExp, freeVars,
-  forceExp
   ) where
 import Prelude
 import Data.Char
 import Data.List
 import MicroHs.Ident
-import MicroHs.Expr(Lit(..), showLit, eqLit, forceLit)
+import MicroHs.Expr(Lit(..), showLit, eqLit)
+--Ximport Control.DeepSeq
 --Ximport Compat
+--Yimport Primitives(NFData(..))
 --import Debug.Trace
 
 type PrimOp = String
@@ -28,6 +29,9 @@
   | Lit Lit
   --Xderiving (Show, Eq)
 
+--Xinstance NFData Exp where rnf (Var i) = rnf i; rnf (App f a) = rnf f `seq` rnf a; rnf (Lam i e) = rnf i `seq` rnf e; rnf (Lit l) = rnf l
+--Yinstance NFData Exp where rnf (Var i) = rnf i; rnf (App f a) = rnf f `seq` rnf a; rnf (Lam i e) = rnf i `seq` rnf e; rnf (Lit l) = rnf l
+
 eqExp :: Exp -> Exp -> Bool
 eqExp (Var i1) (Var i2) = eqIdent i1 i2
 eqExp (App f1 a1) (App f2 a2) = eqExp f1 f2 && eqExp a1 a2
@@ -34,12 +38,6 @@
 eqExp (Lam i1 e1) (Lam i2 e2) = eqIdent i1 i2 && eqExp e1 e2
 eqExp (Lit l1) (Lit l2) = eqLit l1 l2
 eqExp _ _ = False
-
-forceExp :: Exp -> ()
-forceExp (Var i) = forceIdent i
-forceExp (App f a) = case forceExp f of { () -> forceExp a }
-forceExp (Lam i e) = case forceIdent i of { () -> forceExp e }
-forceExp (Lit l) = forceLit l
 
 data MaybeApp = NotApp | IsApp Exp Exp
 
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -7,7 +7,7 @@
   EDef(..), showEDefs,
   Expr(..), showExpr,
   Listish(..),
-  Lit(..), showLit, eqLit, forceLit,
+  Lit(..), showLit, eqLit,
   EBind(..),
   Eqn(..),
   EStmt(..),
@@ -33,9 +33,11 @@
 import Prelude --Xhiding (Monad(..), Applicative(..), MonadFail(..), Functor(..), (<$>), showString, showChar, showList)
 import Data.List
 import Data.Maybe
+import MicroHs.Ident
 --Ximport Compat
 --Ximport GHC.Stack
-import MicroHs.Ident
+--Ximport Control.DeepSeq
+--Yimport Primitives(NFData(..))
 
 type IdentModule = Ident
 
@@ -134,6 +136,8 @@
   | LPrim String
   | LForImp String
   --Xderiving (Show, Eq)
+--Xinstance NFData Lit where rnf (LInt i) = rnf i; rnf (LChar c) = rnf c; rnf (LStr s) = rnf s; rnf (LPrim s) = rnf s; rnf (LForImp s) = rnf s
+--Yinstance NFData Lit where rnf (LInt i) = rnf i; rnf (LChar c) = rnf c; rnf (LStr s) = rnf s; rnf (LPrim s) = rnf s; rnf (LForImp s) = rnf s
 
 eqLit :: Lit -> Lit -> Bool
 eqLit (LInt x)  (LInt  y) = x == y
@@ -142,13 +146,6 @@
 eqLit (LPrim x) (LPrim y) = eqString x y
 eqLit (LForImp x) (LForImp y) = eqString x y
 eqLit _         _         = False
-
-forceLit :: Lit -> ()
-forceLit (LInt i) = seq i ()
-forceLit (LChar c) = seq c ()
-forceLit (LStr s) = forceString s
-forceLit (LPrim s) = forceString s
-forceLit (LForImp s) = forceString s
 
 type ECaseArm = (EPat, EAlts)
 
--- a/src/MicroHs/Ident.hs
+++ b/src/MicroHs/Ident.hs
@@ -5,7 +5,6 @@
   Ident(..),
   mkIdent, mkIdentLoc, unIdent, eqIdent, leIdent, qualIdent, showIdent, getSLocIdent, setSLocIdent,
   mkIdentSLoc,
-  forceIdent,
   isLower_, isIdentChar, isOperChar, isConIdent,
   unQualString,
   SLoc(..), noSLoc, isNoSLoc,
@@ -13,6 +12,8 @@
   compareIdent,
   ) where
 import Prelude --Xhiding(showString)
+--Ximport Control.DeepSeq
+--Yimport Primitives(NFData(..))
 import Data.Char
 --Ximport Compat
 
@@ -25,6 +26,8 @@
 
 data Ident = Ident SLoc String
   --Xderiving (Show, Eq)
+--Xinstance NFData Ident where rnf (Ident _ s) = rnf s
+--Yinstance NFData Ident where rnf (Ident _ s) = rnf s
 
 noSLoc :: SLoc
 noSLoc = SLoc "" 0 0
@@ -90,10 +93,6 @@
 showSLoc (SLoc fn l c) =
   if null fn then "no location" else
   showString fn ++ ": " ++ "line " ++ showInt l ++ ", col " ++ showInt c
-
--- Does not force location
-forceIdent :: Ident -> ()
-forceIdent (Ident _ s) = forceString s
 
 compareIdent :: Ident -> Ident -> Ordering
 compareIdent (Ident _ s) (Ident _ t) = compareString s t
-- 
⑨