ref: 287a43bdd5d192e9f5764090ca3851f6453b9ede
parent: 9add7e7efeb7779e540fc7dc3cb0533d8ff8a611
author: Lennart Augustsson <lennart@augustsson.net>
date: Sun Nov 12 16:58:44 EST 2023
Do some cleanup.
--- a/Makefile
+++ b/Makefile
@@ -39,82 +39,6 @@
$(BIN)/$(MHS): src/*.hs src/*/*.hs $(TOOLS)/convertX.sh
$(GHCE) -ighc -isrc -Wall -Wno-unrecognised-warning-flags -Wno-x-partial -O src/MicroHs/Main.hs -main-is MicroHs.Main -o $(BIN)/$(MHS)
-###
-### Build the compiler with ghc, using MicroHs libraries (Prelude, Data.List, etc)
-###
-# Due to a ghc bug we need to list all the commands.
-# The bug is that OPTIONS_GHC does not accept the -package flag.
-$(BIN)/boot$(MHS): $(ALLSRC) $(TOOLS)/convertY.sh
- rm -rf $(BOOTDIR)
- $(GHCB) -c ghc/Primitives.hs
- $(GHCB) -c ghc/PrimFromInteger.hs
- $(GHCB) -c ghc/Data/Bool_Type.hs
- $(GHCB) -c ghc/Data/Char_Type.hs
- $(GHCB) -c ghc/Data/List_Type.hs
- $(GHCB) -c lib/Data/Maybe_Type.hs
- $(GHCB) -c ghc/Data/Ordering_Type.hs
- $(GHCB) -c ghc/Data/Double.hs
- $(GHCB) -c ghc/PrimTable.hs
- $(GHCC) -c lib/Control/Error.hs
- $(GHCC) -c lib/Data/Eq.hs
- $(GHCC) -c lib/Text/Show.hs
- $(GHCC) -c lib/Data/Bounded.hs
- $(GHCC) -c lib/Data/Ord.hs
- $(GHCC) -c lib/Data/Bool.hs
- $(GHCC) -c lib/Data/Function.hs
- $(GHCC) -c lib/Data/Tuple.hs
- $(GHCC) -c lib/Data/Functor.hs
- $(GHCC) -c lib/Control/Applicative.hs
- $(GHCC) -c lib/Control/Monad.hs
- $(GHCC) -c lib/Data/Integer_Type.hs
- $(GHCC) -c lib/Data/Num.hs
- $(GHCC) -c lib/Data/Integral.hs
- $(GHCC) -c lib/Data/Fractional.hs
- $(GHCC) -c lib/Data/Int.hs
- $(GHCC) -c lib/Data/Double.hs
- $(GHCC) -c lib/Data/Char.hs
- $(GHCC) -c lib/Data/Either.hs
- $(GHCC) -c lib/Data/Ord.hs
- $(GHCC) -c lib/Data/List.hs
- $(GHCC) -c lib/Data/Maybe.hs
- $(GHCC) -c lib/Control/Alternative.hs
- $(GHCC) -c lib/Text/String.hs
- $(GHCC) -c lib/Data/Word.hs
- $(GHCC) -c lib/System/IO.hs
- $(GHCC) -c lib/System/Environment.hs
- $(GHCC) -c lib/Data/Integer.hs
- $(GHCC) -c lib/Prelude.hs
- $(GHCC) -c lib/PreludeNoIO.hs
- $(GHCC) -c lib/Data/Map.hs
- $(GHCC) -c lib/Data/IntMap.hs
- $(GHCC) -c lib/Data/IntSet.hs
- $(GHCC) -c lib/Unsafe/Coerce.hs
- $(GHCC) -c lib/Data/Integer.hs
- $(GHCC) -c lib/Control/Monad/State/Strict.hs
- $(GHCC) -c lib/Control/DeepSeq.hs
-# $(GHCC) -c lib/Debug/Trace.hs
- $(GHCC) -c lib/Control/Exception.hs
- $(GHCC) -c lib/Text/PrettyPrint/HughesPJ.hs
- $(GHCC) -c src/System/Console/SimpleReadline.hs
- $(GHCC) -c src/Text/ParserComb.hs
- $(GHCC) -c src/MicroHs/Ident.hs
- $(GHCC) -c src/MicroHs/Expr.hs
- $(GHCC) -c src/MicroHs/Graph.hs
- $(GHCC) -c src/MicroHs/Lex.hs
- $(GHCC) -c src/MicroHs/Parse.hs
- $(GHCC) -c src/MicroHs/IdentMap.hs
- $(GHCC) -c src/MicroHs/Exp.hs
- $(GHCC) -c src/MicroHs/TCMonad.hs
- $(GHCC) -c src/MicroHs/TypeCheck.hs
- $(GHCC) -c src/MicroHs/Desugar.hs
- $(GHCC) -c src/MicroHs/StateIO.hs
- $(GHCC) -c src/MicroHs/Compile.hs
- $(GHCC) -c src/MicroHs/Translate.hs
- $(GHCC) -c src/MicroHs/Interactive.hs
- $(GHCC) -c -main-is MicroHs.Main src/MicroHs/Main.hs
- $(GHC) $(PROF) -hide-all-packages -package time -o $(BIN)/boot$(MHS) $(BOOTDIR)/*.o $(BOOTDIR)/*/*.o $(BOOTDIR)/*/*/*.o $(BOOTDIR)/*/*/*/*.o
-# $(GHC) $(PROF) -hide-all-packages -package containers -o $(BIN)/boot$(MHS) $(BOOTDIR)/*.o $(BOOTDIR)/*/*.o $(BOOTDIR)/*/*/*/*.o
-
# Self compile using comb/mhs.comb
$(COMB)$(MHS)-new.comb: $(EVAL)
$(EVAL) +RTS -r$(COMB)$(MHS).comb -RTS -ilib -isrc -o$(COMB)$(MHS)-new.comb MicroHs.Main
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
-v4.3
+v5.0
1567
((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _271) ((B _12) _1)) _456))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _455))) ((A :10 (((S' P) _2) (((C' _13) _1) _1294))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _268) _12) _259))) ((A :20 (((S' B) _14) (((C' _271) _12) _260))) ((A :21 _1366) ((A :22 ((B _1431) _21)) ((A :23 (((S' _1431) _21) I)) ((A :24 _1350) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1365) ((C _258) _26))) ((A :28 (((C' _27) ((_267 _1401) _170)) ((_258 (_34 _1403)) _169))) ((A :29 ((B ((S _1431) (_34 _1403))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _455)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _456)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1294)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1294))) ((A :46 ((C _43) _259)) ((A :47 ((B _261) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _261) _48)) ((A :50 T) ((A :51 ((_266 ((B (B (_256 _50))) ((B ((C' C) _54)) (B P)))) (_270 _51))) ((A :52 (((((_11 _51) ((B (_256 _50)) P)) (_38 _53)) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_256 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_258 _559)) _54)) ((A :56 ((B (_256 _50)) (B (P _1294)))) ((A :57 ((B (_256 _50)) (BK (P _1294)))) ((A :58 ((_256 _50) ((S P) I))) ((A :59 ((B (_256 _50)) ((C (S' P)) I))) ((A :60 ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B (B C))))))))))))) ((B (B (B (B (B (B (B (B (B (B (B (B C)))))))))))) ((B (B (B (B (B (B (B (B (B (B (B C))))))))))) ((B (B (B (B (B (B (B (B (B (B C)))))))))) ((B (B (B (B (B (B (B (B (B C))))))))) ((B (B (B (B (B (B (B (B C)))))))) ((B (B (B (B (B (B (B C))))))) ((B (B (B (B (B (B C)))))) ((B (B (B (B (B C))))) ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P))))))))))))))))))))) ((A :61 (T (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :62 (T (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :63 (T (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :64 (T (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :65 (T (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :66 (T (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK (BK K)))))))))))))))))))))) ((A :67 (T (K (K (K (K (K (K (BK (BK (BK (BK (BK (BK (BK (BK
\ No newline at end of file
--- a/lib/Control/DeepSeq.hs
+++ b/lib/Control/DeepSeq.hs
@@ -1,15 +1,12 @@
module Control.DeepSeq(module Control.DeepSeq) where
-import Primitives --Yhiding(rnf)
+import Primitives
import Prelude
-rnf :: forall a . --YNFData a =>
- a -> ()
+rnf :: forall a . a -> ()
rnf = primRnf
-deepseq :: forall a b . --YNFData a =>
- a -> b -> b
+deepseq :: forall a b . a -> b -> b
deepseq a b = rnf a `seq` b
-force :: forall a . --YNFData a =>
- a -> a
+force :: forall a . a -> a
force x = rnf x `seq` x
--- a/lib/Data/Integer_Type.hs
+++ b/lib/Data/Integer_Type.hs
@@ -3,7 +3,6 @@
module Data.Integer_Type(module Data.Integer_Type) where
import Primitives
import Data.Bool_Type
---Yimport PrimFromInteger
import Data.List_Type
data Integer = I Sign [Digit]
--- a/lib/Data/List.hs
+++ b/lib/Data/List.hs
@@ -20,8 +20,6 @@
import Data.Tuple
import Text.Show
---Yimport Data.Char
-
instance {-# OVERLAPPABLE #-} forall a . Eq a => Eq [a] where[] == [] = True
(x:xs) == (y:ys) = x == y && xs == ys
--- a/lib/Data/Tuple.hs
+++ b/lib/Data/Tuple.hs
@@ -2,12 +2,9 @@
-- See LICENSE file for full license.
module Data.Tuple(
module Data.Tuple,
---Y{-()(..)
---Y-}
) where
import Primitives -- for ()
---Yimport PrimFromInteger
import Data.Bool
import Data.Bounded
import Data.Eq
--- a/lib/Prelude.hs
+++ b/lib/Prelude.hs
@@ -29,9 +29,7 @@
module System.IO,
module Text.Show,
module Text.String,
- --Ymodule Primitives,
) where
---Yimport Primitives(ifThenElse)
import Control.Applicative
import Control.Error
import Control.Monad
@@ -60,11 +58,3 @@
import System.IO
import Text.Show
import Text.String
-
-{---- Called on pattern match failure.
-_noMatch :: forall a . [Char] -> Int -> Int -> a
-_noMatch fn l c = error $ "no match at " ++
- if null fn then "no location" else
- showString fn ++ ": " ++ "line " ++ showInt l ++ ", col " ++ showInt c
--}
--- a/lib/Text/Show.hs
+++ b/lib/Text/Show.hs
@@ -1,6 +1,5 @@
module Text.Show(module Text.Show) where
import Primitives
---Yimport PrimFromInteger
import Data.Bool_Type
import Data.Char_Type
import Data.List_Type
--- a/src/MicroHs/Exp.hs
+++ b/src/MicroHs/Exp.hs
@@ -21,7 +21,6 @@
import Text.PrettyPrint.HughesPJ
--Ximport Control.DeepSeq
--Ximport Compat
---Yimport Primitives(NFData(..))
import Debug.Trace
type PrimOp = String
@@ -53,10 +52,7 @@
| Lam Ident Exp
| Lit Lit
---pattern Let :: Ident -> Exp -> Exp -> Exp
---pattern Let i e b = App (Lam i b) e
-
---Winstance 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
+--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
instance Eq Exp where
(==) (Var i1) (Var i2) = i1 == i2
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -41,7 +41,6 @@
--Ximport Compat
--Ximport GHC.Stack
--Ximport Control.DeepSeq
---Yimport Primitives(NFData(..))
type IdentModule = Ident
@@ -152,7 +151,7 @@
| LPrim String
| LForImp String
--Xderiving (Show)
---Winstance NFData Lit where rnf (LInt i) = rnf i; rnf (LInteger i) = rnf i; rnf (LDouble d) = rnf d; rnf (LRat r) = rnf r; rnf (LChar c) = rnf c; rnf (LStr s) = rnf s; rnf (LPrim s) = rnf s; rnf (LForImp s) = rnf s
+--Xinstance NFData Lit where rnf (LInt i) = rnf i; rnf (LInteger i) = rnf i; rnf (LDouble d) = rnf d; rnf (LRat r) = rnf r; rnf (LChar c) = rnf c; rnf (LStr s) = rnf s; rnf (LPrim s) = rnf s; rnf (LForImp s) = rnf s
instance Eq Lit where
(==) (LInt x) (LInt y) = x == y
--- a/src/MicroHs/Ident.hs
+++ b/src/MicroHs/Ident.hs
@@ -21,7 +21,6 @@
import Data.Char
import Text.PrettyPrint.HughesPJ
--Ximport Control.DeepSeq
---Yimport Primitives(NFData(..))
--Ximport GHC.Stack
type Line = Int
@@ -33,7 +32,7 @@
data Ident = Ident !SLoc String
--deriving (Show)
---Winstance NFData Ident where rnf (Ident _ s) = rnf s
+--Xinstance NFData Ident where rnf (Ident _ s) = rnf s
instance Eq Ident where
Ident _ i == Ident _ j = i == j
--- a/src/MicroHs/Interactive.hs
+++ b/src/MicroHs/Interactive.hs
@@ -5,15 +5,13 @@
import Control.Exception
import MicroHs.StateIO
import MicroHs.Compile
-import MicroHs.Exp(Exp)
-import MicroHs.Ident(Ident, mkIdent)
+import MicroHs.Desugar(LDef)
+import MicroHs.Ident(mkIdent)
import MicroHs.Parse
import MicroHs.Translate
import Unsafe.Coerce
import System.Console.SimpleReadline
--Ximport Compat
-
-type LDef = (Ident, Exp) -- XXX why?
type IState = (String, Flags, Cache)
--- a/src/MicroHs/Translate.hs
+++ b/src/MicroHs/Translate.hs
@@ -7,18 +7,18 @@
import Data.Maybe
import qualified MicroHs.IdentMap as M
import System.Environment
---Ximport GHC.Types
import Unsafe.Coerce
+--Ximport GHC.Types
--Ximport Compat
---Wimport PrimTable
+--Ximport PrimTable
-import MicroHs.Desugar(encodeInteger)
+import MicroHs.Desugar(LDef, encodeInteger)
import MicroHs.Expr
import MicroHs.Exp
import MicroHs.Ident
---translateAndRun :: (Ident, [LDef]) -> IO ()
-translateAndRun :: (Ident, [(Ident, Exp)]) -> IO ()
+translateAndRun :: (Ident, [LDef]) -> IO ()
+--translateAndRun :: (Ident, [(Ident, Exp)]) -> IO ()
translateAndRun defs = do
-- Drop all argument up to '--'
args <- getArgs
@@ -26,8 +26,8 @@
withDropArgs (length (takeWhile (/= "--") args) + 1)
prog
---translate :: (Ident, [LDef]) -> Any
-translate :: (Ident, [(Ident, Exp)]) -> Any
+translate :: (Ident, [LDef]) -> Any
+--translate :: (Ident, [(Ident, Exp)]) -> Any
translate (mainName, ds) =
let
look m n = fromMaybe (error $ "translate: not found " ++ showIdent n) $ M.lookup n m
--
⑨