ref: c84bc8caf669ced82e2d067a1373f7eedd839857
parent: e6dafb6d2e0a9bc2989932b571a4c1c8c1bc1073
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Mon Sep 18 16:07:53 EDT 2023
Get rid of junk
--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -50,13 +50,6 @@
cache :: Cache -> M.Map CModule
cache (Cache _ x) = x
-{--updCache :: M.Map Module -> Cache -> Cache
-updCache x c =
- case c of
- Cache w _ -> Cache w x
--}
-
-----------------
compile :: Flags -> IdentModule -> IO [LDef]
--- a/src/MicroHs/Desugar.hs
+++ b/src/MicroHs/Desugar.hs
@@ -5,7 +5,6 @@
desugar,
LDef, showLDefs
) where
---import Debug.Trace
import Prelude --Xhiding(showList)
import Data.Char
import Data.List
@@ -154,10 +153,8 @@
EApp f a -> App (dsExpr f) (dsExpr a)
ELam xs e -> dsLam xs e
ELit _ (LChar c) -> Lit (LInt (ord c))
--- ELit _ (LStr cs) -> dsExpr $ EListish $ LList $ map (ELit . LChar) cs
ELit _ l -> Lit l
ECase e as -> dsCase e as
--- For now, just sequential bindings; each recursive
ELet ads e -> dsBinds ads (dsExpr e)
ETuple es -> Lam (mkIdent "$f") $ foldl App (Var $ mkIdent "$f") $ map dsExpr es
EIf e1 e2 e3 ->
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -112,7 +112,6 @@
conArity (ConData cs i) = fromMaybe undefined $ lookupBy eqIdent i cs
conArity (ConNew _) = 1
conArity (ConLit _) = 0
---conArity (ConTup n) = n
eqCon :: Con -> Con -> Bool
eqCon (ConData _ i) (ConData _ j) = eqIdent i j
--- a/src/MicroHs/Graph.hs
+++ b/src/MicroHs/Graph.hs
@@ -26,12 +26,6 @@
type Forest a = [Tree a]
--------------------------------------------------------------------------
--- -
--- Strongly Connected Components
--- -
--------------------------------------------------------------------------
-
-- | Strongly connected component.
data SCC vertex = AcyclicSCC vertex -- ^ A single vertex that is not
-- in any cycle.
--- a/src/MicroHs/Lex.hs
+++ b/src/MicroHs/Lex.hs
@@ -6,7 +6,6 @@
import Data.Char
import Data.List
--Ximport Compat
---import Debug.Trace
import MicroHs.Ident
data Token
@@ -106,7 +105,7 @@
lex loc (d:_) = [TError loc $ "Unrecognized input: " ++ showChar d]
lex _ [] = []
--- Skip a { - - } style comment+-- Skip a {- -} style commentskipNest :: Loc -> Int -> String -> [Token]
skipNest loc 0 cs = lex loc cs
skipNest loc n ('{':'-':cs) = skipNest (addCol loc 2) (n + 1) cs@@ -197,4 +196,3 @@
layout ms (t : ts) = t : layout ms ts
layout (_ : ms) [] = TSpec (mkLoc 0 0) '}' : layout ms []
layout [] [] = []
---layout _ _ = TError (mkLoc 0 0) "layout error" : []
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -41,11 +41,10 @@
Var n -> findIdent n
App f a -> App (substv f) (substv a)
e -> e
- --def :: ((Ident, Exp), Int) -> String -> String
+ --Xdef :: ((Ident, Exp), Int) -> String -> String
def d r =
case d of
((_, e), i) -> "(($A :" ++ showInt i ++ " " ++ toStringP (substv e) ++ ") " ++ r ++ ")"
- -- App2 CT (Lbl i (subst e)) r
res = foldr def (toStringP emain) (zip ds (enumFrom 0))
numDefs = M.size defs
when (verbose flags > 0) $
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -3,14 +3,9 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-unused-do-bind #-}module MicroHs.Parse(pTop, parseDie) where
import Prelude --Xhiding (Monad(..), Applicative(..), MonadFail(..), Functor(..), (<$>), showString, showChar, showList)
---import Control.Monad
---import Control.Monad.State.Strict
---import Control.Applicative --hiding (many, some)
import Data.Char
import Data.List
import Text.ParserComb as P
---import Debug.Trace
---import MicroHs.Lex
import MicroHs.Lex
import MicroHs.Expr
import MicroHs.Ident
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -246,7 +246,6 @@
withTypeTable :: forall a . T a -> T a
withTypeTable ta = T.do
TC mn n fx tt st vt m <- get
---BBB put (TC mn n M.empty M.empty tt m)
put (TC mn n fx primKindTable M.empty tt m)
a <- ta
TC mnr nr _ _ _ ttr mr <- get
@@ -316,9 +315,6 @@
tCon :: Ident -> EType
tCon = EVar
---tVar :: Ident -> EType
---tVar = EVar
-
tVarK :: IdKind -> EType
tVarK (IdKind i _) = EVar i
@@ -410,14 +406,8 @@
unifyR :: --XHasCallStack =>
SLoc -> EType -> EType -> T ()
unifyR loc a b = T.do
--- venv <- gets valueTable
--- tenv <- gets typeTable
--- senv <- gets synTable
let
bad = tcError loc $ "Cannot unify " ++ showExpr a ++ " and " ++ showExpr b ++ "\n"
--- ++ show a ++ " - " ++ show b ++ "\n"
--- ++ show tenv ++ "\n"
--- ++ show senv
case a of
EVar ia ->
case b of
@@ -548,14 +538,8 @@
tcDefs :: [EDef] -> T [EDef]
tcDefs ds = T.do
T.mapM_ tcAddInfix ds
--- traceM ("tcDefs ds=" ++ show ds)dst <- tcDefsType ds
T.mapM_ addTypeSyn dst
--- traceM ("tcDefs dst=\n" ++ showEDefs dst)--- tenv <- gets typeTable
--- traceM ("tcDefs tenv=\n" ++ show tenv)--- venv <- gets valueTable
--- traceM ("tcDefs venv=\n" ++ show venv)tcDefsValue dst
tcAddInfix :: EDef -> T ()
@@ -567,7 +551,6 @@
tcDefsType :: [EDef] -> T [EDef]
tcDefsType ds = withTypeTable $ T.do
dsk <- T.mapM tcDefKind ds -- Check&rename kinds in all type definitions
--- traceM ("tcDefs dsk=\n" ++ showEDefs dsk)T.mapM_ addTypeKind dsk -- Add the kind of each type to the environment
T.mapM tcDefType dsk
@@ -925,38 +908,6 @@
getFixity :: FixTable -> Ident -> Fixity
getFixity fixs i = fromMaybe (AssocLeft, 9) $ M.lookup i fixs
-
-{--type FixTableS = [(String, Fixity)]
-
--- A hack until we do it right
-getFixity :: FixTableS -> Ident -> Fixity
-getFixity fixs i = fromMaybe (AssocLeft, 9) $ lookupBy eqString (unQualString (unIdent i)) fixs
-
-fixities :: FixTableS
-fixities = concat
- [infixr_ 9 ["."]
- ,infixl_ 9 ["?", "!!", "<?>"]
- ,infixr_ 8 ["^","^^","**"]
- ,infixl_ 7 ["*","quot","`rem`"]
- ,infixl_ 6 ["+","-"]
- ,infixr_ 5 [":","++"]
- ,infix_ 4 ["==","/=","<","<=",">=",">","elem","notElem"]
- ,infixl_ 4 ["<$>","<$","<*>","<*","*>"]
- ,infixr_ 3 ["&&"]
- ,infixl_ 3 ["<|>","<|<"]
- ,infixr_ 2 ["||"]
- ,infixl_ 1 [">>",">>="]
- ,infixr_ 1 ["=<<"]
- ,infixr_ 0 ["$","seq"]
- ,infixr_ 0 ["->"]
- ]
- where
- fixity a p = map (\ s -> (s, (a, p)))
- infixr_ = fixity AssocRight
- infixl_ = fixity AssocLeft
- infix_ = fixity AssocNone
--}
tcPats :: forall a . EType -> [EPat] -> (EType -> [Typed EPat] -> T a) -> T a
tcPats t [] ta = ta t []
--
⑨