fix all haskell warnings (sigh)
build / build (push) Successful in 1m8s

This commit is contained in:
2026-07-19 03:26:36 -06:00
parent 33fb0f831c
commit 0ba49ed85c
7 changed files with 25 additions and 111 deletions
+5
View File
@@ -26,10 +26,15 @@ common ghcstuffs
BlockArguments BlockArguments
DeriveGeneric DeriveGeneric
OverloadedRecordDot OverloadedRecordDot
DuplicateRecordFields
NoFieldSelectors
OverloadedStrings OverloadedStrings
PartialTypeSignatures PartialTypeSignatures
PatternSynonyms PatternSynonyms
QuasiQuotes QuasiQuotes
DerivingVia
OverloadedLabels
OrPatterns
executable gyehoek executable gyehoek
import: ghcstuffs, ghcstuffs-dev import: ghcstuffs, ghcstuffs-dev
+3 -41
View File
@@ -11,35 +11,18 @@ module Gyehoek.CPS.Lower
(lower, lowerProgram) where (lower, lowerProgram) where
import Gyehoek.CPS.Syntax import Gyehoek.CPS.Syntax
import Data.Generics.Labels import Data.Generics.Labels ()
import Gyehoek.Scheme.Syntax qualified as Scm
import Gyehoek.GenSym
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List (List)
import Effectful import Effectful
import Control.Monad.Cont qualified as Cont
import Effectful.Writer.Static.Local
import Data.Text (Text) import Data.Text (Text)
import Data.Vector.Strict (Vector) import Data.Vector.Strict (Vector)
import Control.Lens import Control.Lens hiding (op)
import Data.Foldable
import Data.HashMap.Strict (HashMap)
import Numeric.Natural import Numeric.Natural
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gyehoek.Scheme.Syntax (Lit(..))
import Text.Printf
import qualified Data.Text as T
import qualified Data.Vector.Strict as V import qualified Data.Vector.Strict as V
import Data.IntMap.Strict (IntMap)
import Data.String.Interpolate
import Gyehoek.Wasm qualified as Wasm import Gyehoek.Wasm qualified as Wasm
import Gyehoek.Wasm hiding (Expr) import Gyehoek.Wasm hiding (Expr)
import Language.Sexp.Located qualified as SL import Language.Sexp.Located qualified as SL
import Debug.Pretty.Simple
import Control.Monad.Fix import Control.Monad.Fix
import Language.Sexp.Located (Sexp)
import Data.Functor.Foldable (cata)
import qualified Gyehoek.Sexp
data Env = MkEnv data Env = MkEnv
@@ -114,12 +97,10 @@ lower' g (Halt [v]) = pure [expr|
|] |]
where arg = pushArg 0 (lowerVal g v) where arg = pushArg 0 (lowerVal g v)
lower' g (ExpPrim p rs e) = lower' g (ExpPrim p [r] e) =
case p of case p of
PrimAdd x y -> lowerBinOp "i32.add" g x y r e PrimAdd x y -> lowerBinOp "i32.add" g x y r e
PrimMul x y -> lowerBinOp "i32.mul" g x y r e PrimMul x y -> lowerBinOp "i32.mul" g x y r e
where
r = head rs
lower' g (ExpIf c t f) = do lower' g (ExpIf c t f) = do
t' <- lower' g t t' <- lower' g t
@@ -165,25 +146,6 @@ lower' g (ExpContinue k [x]) = pure . mconcat $
lower' g e = error . show $ e lower' g e = error . show $ e
-- lower' g (ExpContinue k [x]) = pure . mconcat $
-- [ pushArg rt 0 (lowerVal g x)
-- , ins "i32.const" [sxp @Int 1] -- nargs
-- -- get the return continuation.
-- , ins "global.get" [sxp rt.contStack]
-- , ins "global.get" [sxp rt.contStackTop]
-- , ins "array.get" [sxp rt.contStackType]
-- , ins "ref.as_non_null" []
-- -- decrement contStackTop, completing the "pop."
-- , ins "global.get" [sxp rt.contStackTop]
-- , ins "i32.const" [sxp @Int (1 + l)]
-- , ins "i32.sub" []
-- , ins "global.set" [sxp rt.contStackTop]
-- , ins "return_call_ref" [sxp rt.contType]
-- ]
-- where
-- rt = g.runtime
-- l = V.elemIndex k g.kvars ^?! _Just
lowerLambda :: GenMod :> es => Env -> Lambda -> Eff es Idx lowerLambda :: GenMod :> es => Env -> Lambda -> Eff es Idx
lowerLambda g (MkLambda xs ktail m) = do lowerLambda g (MkLambda xs ktail m) = do
let g' = g & #vars .~ V.fromList xs let g' = g & #vars .~ V.fromList xs
+1 -7
View File
@@ -22,20 +22,14 @@ module Gyehoek.CPS.Syntax
import Language.SexpGrammar qualified as S import Language.SexpGrammar qualified as S
import Gyehoek.Sexp qualified import Gyehoek.Sexp qualified
import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit(..), pattern Void) import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit(..), pattern Void, getName)
import Data.Text (Text)
import Data.List (List) import Data.List (List)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Language.SexpGrammar.Generic import Language.SexpGrammar.Generic
import Control.Category import Control.Category
import Control.Lens import Control.Lens
import Data.Text qualified as T
import Data.Generics.Labels
import Prelude hiding ((.), id) import Prelude hiding ((.), id)
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty)
import Data.InvertibleGrammar.Base qualified as IGB
import Data.InvertibleGrammar.Base ((:-)((:-)))
import qualified Data.InvertibleGrammar as IG
-- Data types -- Data types
+6 -24
View File
@@ -1,44 +1,26 @@
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OrPatterns #-}
module Gyehoek.Driver module Gyehoek.Driver
(main, lower_e2e, convert_e2e, parse_e2e) (main, lower_e2e, convert_e2e, parse_e2e)
where where
import Gyehoek.Options import Gyehoek.Options
import qualified Data.Text.IO as TIO
import Data.Text (Text) import Data.Text (Text)
import Prelude hiding (readFile) import Prelude hiding (readFile)
import Options.Applicative import Options.Applicative
import Control.Lens import Control.Lens
import Data.Generics.Labels
import System.OsPath (OsPath)
import System.FilePath ((-<.>), dropExtension)
import Effectful.FileSystem import Effectful.FileSystem
import Effectful import Effectful
import Effectful.FileSystem.IO qualified as FS import Effectful.FileSystem.IO qualified as FS
import Effectful.FileSystem.IO.ByteString qualified as FB import Effectful.FileSystem.IO.ByteString qualified as FB
import Gyehoek.GenSym (runGenSym, GenSym, gensym, gensym') import Gyehoek.GenSym (runGenSym, GenSym)
import qualified Gyehoek.Sexp as Sexp import qualified Gyehoek.Sexp as Sexp
import Data.Text.Lens
import Data.List (List)
import qualified Gyehoek.Scheme.Syntax as Scm import qualified Gyehoek.Scheme.Syntax as Scm
import Effectful.Exception
import qualified Data.Text as T
import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding as T
import System.IO (Handle) import System.IO (Handle)
import Data.List.NonEmpty (NonEmpty)
import qualified Cradle as C
import Gyehoek.CPS.Convert import Gyehoek.CPS.Convert
import Gyehoek.CPS.Lower import Gyehoek.CPS.Lower
import Data.Foldable
import qualified Gyehoek.Scheme.Syntax
import Gyehoek.CPS.Syntax qualified as Cps import Gyehoek.CPS.Syntax qualified as Cps
import Data.Maybe (fromMaybe)
import Control.Monad import Control.Monad
import Text.Pretty.Simple (pShow, pShowNoColor) import Text.Pretty.Simple (pShowNoColor)
main :: IO () main :: IO ()
@@ -48,8 +30,8 @@ main = do
hPutStr :: FileSystem :> es => Handle -> Text -> Eff es () -- hPutStr :: FileSystem :> es => Handle -> Text -> Eff es ()
hPutStr h = FB.hPutStr h . T.encodeUtf8 -- hPutStr h = FB.hPutStr h . T.encodeUtf8
hPutStrLn :: FileSystem :> es => Handle -> Text -> Eff es () hPutStrLn :: FileSystem :> es => Handle -> Text -> Eff es ()
hPutStrLn h = FB.hPutStrLn h . T.encodeUtf8 hPutStrLn h = FB.hPutStrLn h . T.encodeUtf8
@@ -57,8 +39,8 @@ hPutStrLn h = FB.hPutStrLn h . T.encodeUtf8
hGetContents :: FileSystem :> es => Handle -> Eff es Text hGetContents :: FileSystem :> es => Handle -> Eff es Text
hGetContents h = T.decodeUtf8 <$> FB.hGetContents h hGetContents h = T.decodeUtf8 <$> FB.hGetContents h
readFile :: FileSystem :> es => FilePath -> Eff es Text -- readFile :: FileSystem :> es => FilePath -> Eff es Text
readFile f = FS.withFile f FS.ReadMode hGetContents -- readFile f = FS.withFile f FS.ReadMode hGetContents
withFile withFile
:: (FileSystem :> es) :: (FileSystem :> es)
+8 -12
View File
@@ -20,29 +20,27 @@ module Gyehoek.Scheme.Syntax
, primSexpIso , primSexpIso
, pattern Void , pattern Void
, free , free
, qexp
, qprog
, subst , subst
, getName
) )
where where
import Data.Text (Text) import Data.Text (Text)
import Data.List (List) import Data.List (List)
import Language.SexpGrammar import Language.SexpGrammar
( SexpIso(..), list, el, (>>>), rest, sym, symbol ) ( SexpIso(..), list, el, rest, sym, symbol )
import Language.SexpGrammar qualified as Sexp import Language.SexpGrammar qualified as Sexp
import Language.Sexp.Located qualified as S import Language.Sexp.Located qualified as S
import Language.SexpGrammar.Generic import Language.SexpGrammar.Generic
import GHC.Generics import GHC.Generics
import Prelude hiding ((.), id) import Prelude hiding ((.), id)
import Control.Category import Control.Category
import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty (NonEmpty)
import Gyehoek.Sexp qualified import Gyehoek.Sexp qualified
import Gyehoek.GenSym (Gen) import Gyehoek.GenSym (Gen)
import Control.Lens import Control.Lens
import Data.String (IsString) import Data.String (IsString)
import Data.Hashable (Hashable) import Data.Hashable (Hashable)
import Control.Lens.Unsound (prismSum)
import Data.Data (Data) import Data.Data (Data)
import Data.Functor.Foldable.TH (makeBaseFunctor) import Data.Functor.Foldable.TH (makeBaseFunctor)
import Data.Functor.Foldable hiding (fold) import Data.Functor.Foldable hiding (fold)
@@ -51,10 +49,13 @@ import qualified Data.HashSet as HS
import Data.Foldable (fold) import Data.Foldable (fold)
newtype Name = MkName { getName :: Text } newtype Name = MkName { inner :: Text }
deriving newtype (Show, Eq, IsString, Gen, Hashable) deriving newtype (Show, Eq, IsString, Gen, Hashable)
deriving stock (Generic, Data) deriving stock (Generic, Data)
getName :: Name -> Text
getName (MkName x) = x
data Prim e data Prim e
= PrimAdd e e = PrimAdd e e
| PrimSub e e | PrimSub e e
@@ -121,8 +122,6 @@ instance Each Program Program (Either Exp Def) (Either Exp Def) where
each = #commandsAndDefs . each . go each = #commandsAndDefs . each . go
where where
inj = either Command Definition inj = either Command Definition
toeither (Command e) = Left e
toeither (Definition d) = Right d
go :: Traversal' CommandOrDef (Either Exp Def) go :: Traversal' CommandOrDef (Either Exp Def)
go k (Command e) = inj <$> k (Left e) go k (Command e) = inj <$> k (Left e)
go k (Definition d) = inj <$> k (Right d) go k (Definition d) = inj <$> k (Right d)
@@ -184,7 +183,7 @@ instance SexpIso Lit where
instance SexpIso Sexp where instance SexpIso Sexp where
sexpIso = match sexpIso = match
$ With (\cons -> cons . Gyehoek.Sexp.todo) $ With (\conss -> conss . Gyehoek.Sexp.todo)
$ With (\s -> s . symbol) $ With (\s -> s . symbol)
$ With (\lit -> lit . sexpIso) $ With (\lit -> lit . sexpIso)
$ End $ End
@@ -229,9 +228,6 @@ instance SexpIso CommandOrDef where
-- utilities -- utilities
qexp = Gyehoek.Sexp.makeSx $ sexpIso @Exp
qprog = Gyehoek.Sexp.makeSxs (sexpIso @CommandOrDef) MkProgram
free :: Exp -> HashSet Name free :: Exp -> HashSet Name
free = cata \case free = cata \case
ExpVarF x -> HS.singleton x ExpVarF x -> HS.singleton x
+2 -26
View File
@@ -1,15 +1,6 @@
{- HLINT ignore "Use newtype instead of data" -} {- HLINT ignore "Use newtype instead of data" -}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeepSubsumption #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordPuns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE TemplateHaskellQuotes #-}
module Gyehoek.Wasm module Gyehoek.Wasm
( (
@@ -39,40 +30,25 @@ module Gyehoek.Wasm
where where
import Language.SexpGrammar import Language.SexpGrammar
( SexpIso(..), list, el, (>>>), rest, sym, symbol, (:-) ) ( SexpIso(..), (>>>) )
import Language.SexpGrammar qualified as Sexp import Language.SexpGrammar qualified as Sexp
import Language.SexpGrammar.Generic import Language.SexpGrammar.Generic
import Data.List (List) import Data.List (List)
import GHC.Generics (Generic, Generically(..)) import GHC.Generics (Generic)
import Data.Text (Text) import Data.Text (Text)
import Data.String (IsString (fromString))
import Text.Printf
import Effectful import Effectful
import Numeric.Natural (Natural) import Numeric.Natural (Natural)
import Effectful.Dispatch.Dynamic import Effectful.Dispatch.Dynamic
import Effectful.State.Dynamic import Effectful.State.Dynamic
import Control.Lens import Control.Lens
import Data.Generics.Labels
import Data.Vector.Strict (Vector) import Data.Vector.Strict (Vector)
import Data.String.Interpolate
import qualified Data.Vector.Strict as V import qualified Data.Vector.Strict as V
import qualified Data.Text as T
import Effectful.Writer.Dynamic
import Control.Applicative (Alternative((<|>)))
import Control.Category qualified as Cat
import Data.Vector.Lens
import Data.Either (fromLeft, fromRight)
import Language.Sexp.Located import Language.Sexp.Located
import qualified Gyehoek.Sexp import qualified Gyehoek.Sexp
import GHC.IsList (IsList(..)) import GHC.IsList (IsList(..))
import Data.Coerce (coerce)
import qualified Control.Category
import Data.Functor (void)
import Language.Haskell.TH.Quote (QuasiQuoter) import Language.Haskell.TH.Quote (QuasiQuoter)
import Data.Data (Data) import Data.Data (Data)
import Data.Functor.Foldable (cata)
import Gyehoek.Sexp (sx) import Gyehoek.Sexp (sx)
import qualified Language.Sexp as SL
import Data.Foldable (traverse_) import Data.Foldable (traverse_)
-1
View File
@@ -3,7 +3,6 @@ module Main (main) where
import Test.Tasty (TestTree, testGroup) import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Silver.Interactive (defaultMain) import Test.Tasty.Silver.Interactive (defaultMain)
import qualified Gyehoek.Test.Golden import qualified Gyehoek.Test.Golden
import Data.List (List)
import qualified Gyehoek.Test.Sexp import qualified Gyehoek.Test.Sexp