shithub: MicroHs

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

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

@@ -1,6 +1,9 @@

 -- Copyright 2023 Lennart Augustsson

 -- See LICENSE file for full license.

-module MicroHs.Compile(module MicroHs.Compile) where

+module MicroHs.Compile(

+  compile,

+  Flags(..), verbose, runIt, output

+  ) where

 import Prelude --Xhiding (Monad(..), mapM, showString)

 import qualified System.IO as IO

 --Ximport Compat

--- a/src/MicroHs/Desugar.hs

+++ b/src/MicroHs/Desugar.hs

@@ -2,8 +2,8 @@

 -- See LICENSE file for full license.

 {-# OPTIONS_GHC -Wno-type-defaults -Wno-incomplete-uni-patterns -Wno-unused-imports #-}

 module MicroHs.Desugar(

-  module MicroHs.Desugar

-  --desugar, LDef, showLDefs,

+  desugar,

+  LDef, showLDefs

   ) where

 --import Debug.Trace

 import Prelude

@@ -155,11 +155,6 @@

     xs = take (length ps) (newVars vs)

     ex = runS (vs ++ xs) (map Var xs) [(map dsPat ps, dsExpr e)]

   in foldr Lam ex xs

-spatVars :: SPat -> [Ident]

-spatVars ap =

-  case ap of

-    SPat _ is -> is

 mqual :: Maybe Ident -> Ident -> Ident

 mqual mqi i =

--- a/src/MicroHs/Exp.hs

+++ b/src/MicroHs/Exp.hs

@@ -1,6 +1,12 @@

 -- Copyright 2023 Lennart Augustsson

 -- See LICENSE file for full license.

-module MicroHs.Exp(module MicroHs.Exp) where

+module MicroHs.Exp(

+  compileOpt,

+  substExp,

+  Exp(..), showExp, toStringP,

+  PrimOp,

+  app2, cCons, cNil, cFlip

+  ) where

 import Prelude

 import Data.List

 import MicroHs.Parse --X(Ident, eqIdent)

@@ -70,6 +76,7 @@

 cFlip :: Exp

 cFlip = Prim "C"

+{-

 eqExp :: Exp -> Exp -> Bool

 eqExp ae1 ae2 =

   case ae1 of

@@ -93,6 +100,7 @@

       case ae2 of

         Prim p2 -> eqString p1 p2

         _ -> False

+-}

 toStringP :: Exp -> String

 toStringP ae =

--- a/src/MicroHs/Main.hs

+++ b/src/MicroHs/Main.hs

@@ -1,7 +1,7 @@

 -- Copyright 2023 Lennart Augustsson

 -- See LICENSE file for full license.

 {-# OPTIONS_GHC -Wno-unused-do-bind #-}

-module MicroHs.Main(module MicroHs.Main) where

+module MicroHs.Main(main) where

 import Prelude

 import qualified MicroHs.StringMapFast as M

 import Data.Maybe

--- a/src/MicroHs/Parse.hs

+++ b/src/MicroHs/Parse.hs

@@ -2,23 +2,29 @@

 -- See LICENSE file for full license.

 {-# OPTIONS_GHC -Wno-type-defaults -Wno-name-shadowing -Wno-unused-do-bind #-}

 module MicroHs.Parse(

-  module MicroHs.Parse

-{-

-  pTop,

-  parseDie,

-  Ident,

+  pTop, parseDie,

+  Ident, eqIdent, qual, showIdent,

   IdentModule,

-  qual,

-  EDef(..),

-  ImportSpec(..),

-  Expr(..),

-  EStmt(..),

-  EPat(..),

-  EBind(..),

   EModule(..),

   ExportSpec(..),

+  ImportSpec(..),

+  EDef(..), showEDefs,

+  Expr(..), showExpr,

+  EBind(..),

+  Eqn(..),

+  EStmt(..),

+  ECaseArm,

+  EType,

+  EPat, patVars, isPVar,

+  EKind,

   LHS,

--}

+  Constr,

+  ConTyInfo,

+  ETypeScheme(..),

+  Con(..), conIdent, conArity,

+  tupleConstr,

+  subst,

+  allVarsExpr, allVarsBind

   ) where

 import Prelude --Xhiding (Monad(..), Applicative(..), MonadFail(..), Functor(..), (<$>), showString, showChar, showList)

 --import Control.Monad

@@ -95,11 +101,12 @@

   case c of

     Con _ i -> i

+{-

 conTyInfo :: Con -> ConTyInfo

 conTyInfo c =

   case c of

     Con cs _ -> cs

+-}

 conArity :: Con -> Int

 conArity c =

   case c of

@@ -168,8 +175,10 @@

 eqIdent :: Ident -> Ident -> Bool

 eqIdent = eqString

+{-

 leIdent :: Ident -> Ident -> Bool

 leIdent = leString

+-}

 showIdent :: Ident -> String

 showIdent i = i

@@ -177,8 +186,10 @@

 tupleConstr :: Int -> Ident

 tupleConstr n = replicate (n-1) ','

+{-

 untupleConstr :: Ident -> Int

 untupleConstr s = length s + 1

+-}

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

@@ -763,6 +774,7 @@

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

+{-

 showEModule :: EModule -> String

 showEModule am =

   case am of

@@ -778,6 +790,7 @@

     ExpTypeCon i -> i ++ "(..)"

     ExpType i -> i

     ExpValue i -> i

+-}

 showEDef :: EDef -> String

 showEDef def =

@@ -880,10 +893,12 @@

   case eqn of

     Eqn ps e -> concatMap allVarsPat ps ++ allVarsExpr e

+{-

 allVarsLHS :: LHS -> [Ident]

 allVarsLHS iis =

   case iis of

     (i, is) -> i : is

+-}

 allVarsPat :: EPat -> [Ident]

 allVarsPat = allVarsExpr

--- a/src/MicroHs/StateIO.hs

+++ b/src/MicroHs/StateIO.hs

@@ -14,11 +14,13 @@

   case sa of

     S x -> x

+{-

 execStateIO :: forall s a . StateIO s a -> s -> IO s

 execStateIO sa s = IO.do

   as <- runStateIO sa s

   case as of

     (_, ss) -> IO.return ss

+-}

 (>>=) :: forall s a b . StateIO s a -> (a -> StateIO s b) -> StateIO s b

 (>>=) m k = S $ \ s -> IO.do

--- a/src/MicroHs/StringMap.hs

+++ b/src/MicroHs/StringMap.hs

@@ -1,7 +1,13 @@

 -- Copyright 2023 Lennart Augustsson

 -- See LICENSE file for full license.

-module MicroHs.StringMap(module MicroHs.StringMap) where

-import Prelude

+module MicroHs.StringMap(

+  Map,

+  size,

+  empty, insert, lookup,

+  fromList, fromListWith,

+  toList, elems

+  ) where

+import Prelude --Xhiding(lookup)

 --Ximport Compat

{-

@@ -16,7 +22,7 @@

 fromList = M.fromList

-union = M.union

+--union = M.union

 lookup k m =

   case M.lookup k m of

@@ -55,11 +61,13 @@

 fromList = Map

+{-

 union akvs1 akvs2 =

   case akvs1 of

     Map kvs1 ->

       case akvs2 of

         Map kvs2 -> Map (kvs1 ++ kvs2)

+-}

 lookup ak am =

   case am of

@@ -93,7 +101,7 @@

 insert = M.insertBy leString

 fromListWith = M.fromListByWith leString

 fromList = M.fromListBy leString

-union = M.unionBy leString

+--union = M.unionBy leString

 lookup = M.lookupBy leString

 empty = M.empty

 elems = M.elems

@@ -105,7 +113,7 @@

 insert :: forall v . String -> v -> Map v -> Map v

 fromListWith :: forall v . (v -> v -> v) -> [(String, v)] -> Map v

 fromList :: forall v . [(String, v)] -> Map v

-union :: forall v . Map v -> Map v -> Map v

+--union :: forall v . Map v -> Map v -> Map v

 lookup :: forall v . String -> Map v -> Maybe v

 empty :: forall v . Map v

 elems :: forall v . Map v -> [v]

--- a/src/MicroHs/TCMonad.hs

+++ b/src/MicroHs/TCMonad.hs

@@ -1,12 +1,11 @@

-{-# OPTIONS_GHC -Wno-orphans -Wno-dodgy-imports #-}

+{-# OPTIONS_GHC -Wno-orphans -Wno-dodgy-imports -Wno-unused-imports #-}

 module MicroHs.TCMonad(

---X  (<$>),

---X  module Control.Monad,

-  module MicroHs.TCMonad,

-  module Control.Monad.State.Strict

+  TC, runState,

+  fmap, (<$>),

+  (>>=), (>>), return, fail,

+  get, put, gets,

+  mapM, mapM_

{-

-  TC,

-  (>>=), (>>), return,

   runState,

   fmap,

   fail,

--- a/src/MicroHs/Translate.hs

+++ b/src/MicroHs/Translate.hs

@@ -1,6 +1,8 @@

 -- Copyright 2023 Lennart Augustsson

 -- See LICENSE file for full license.

-module MicroHs.Translate(module MicroHs.Translate) where

+module MicroHs.Translate(

+  translate

+  ) where

 import Prelude

 import Data.Maybe

 import qualified MicroHs.StringMap as M

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

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

@@ -1,11 +1,8 @@

 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

 module MicroHs.TypeCheck(

-  module MicroHs.TypeCheck

-{-

   typeCheck,

-  TModule(..),

-  showTModule,

--}

+  TModule(..), showTModule,

+  impossible

   ) where

 import Prelude

 import Data.List

@@ -162,6 +159,7 @@

       in M.fromListWith (unionBy eqEntry) $ concatMap types mdls

   in  (allTypes, allSyns, allValues)

+{-

 arityOf :: EType -> Int

 arityOf at =

   case getArrow at of

@@ -181,6 +179,7 @@

     TAbs k -> ETypeScheme [] k

     TConc k _ -> ETypeScheme [] k

     TSyn k _ -> ETypeScheme [] k

+-}

 eqEntry :: Entry -> Entry -> Bool

 eqEntry x y =

--

⑨