fix some warnings

2026-08-18 21:14:46 -06:00
parent 6949ff7fdf
commit 8bdbfafb9c
7 changed files with 20 additions and 75 deletions
@@ -42,6 +42,7 @@ import Gyehoek.Sexp qualified
 import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit(..), pattern Void, getName)
 import Data.List (List)
 import GHC.Generics (Generic)
+import Data.Generics.Labels ()
 import Language.SexpGrammar.Generic
 import Control.Category
 import Control.Lens hiding (op)
@@ -79,7 +80,10 @@ data Abs
  | AbsLambda Lambda
  deriving (Show, Generic, Data, Eq)

+pattern AbsKappa' :: [Name] -> Exp -> Abs
 pattern AbsKappa' xs e = AbsKappa (MkKappa xs e)
+
+pattern AbsLambda' :: [Name] -> Name -> Exp -> Abs
 pattern AbsLambda' xs e ktail = AbsLambda (MkLambda xs e ktail)

 data Exp
@@ -8,7 +8,6 @@ import Effectful.Dispatch.Dynamic
 import Effectful
 import Data.String (IsString(fromString))
 import Data.Text (Text)
-import qualified Data.Text.Short as ST


 class Gen a where
@@ -34,7 +34,6 @@ import Data.List (List)
 import Language.SexpGrammar
  ( SexpIso(..), list, el, rest, sym, symbol )
 import Language.SexpGrammar qualified as Sexp
-import Language.Sexp.Located qualified as S
 import Language.SexpGrammar.Generic
 import Effectful
 import GHC.Generics (Generic)
@@ -44,6 +43,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Gyehoek.Sexp qualified
 import Gyehoek.GenSym (Gen)
 import Control.Lens
+import Data.Generics.Labels ()
 import Data.String (IsString)
 import Data.Hashable (Hashable)
 import Data.Data (Data)
@@ -281,6 +281,5 @@ readProgram fp = runFileSystem $
    Gyehoek.Sexp.parseSexps @CommandOrDef (fileName fp) <$> hGetContents h
     >>= either error (pure . MkProgram)

-readExp :: IOE :> es => FilePath -> Eff es Program
-readExp fp = readProgram fp <&>
-  (^?! (#commandsAndDefs . _head . _Comm))
+readExp :: IOE :> es => FilePath -> Eff es Exp
+readExp fp = readProgram fp <&> (^?! #commandsAndDefs . _head . #Command)
@@ -25,8 +25,6 @@ module Gyehoek.Sexp
  , lambdaKeyword
  , encodePrettyWith
  , encodePretty
-  , UglySexpIso(..)
-  , AsSexpIso(..)
  , SpliceSexp(..)
  , parseSexpsWithPos
  , parseSexpWithPos
@@ -56,41 +54,26 @@ import Data.Text (Text)
 import Language.SexpGrammar as Sexp hiding (toSexp, List, encode, decode, encodeWith, decodeWith, iso, encodePrettyWith, encodePretty, fromSexp)
 import Language.SexpGrammar qualified as Sexp
 import Language.Sexp qualified as S
-import Language.SexpGrammar.Generic
 import Data.InvertibleGrammar.Base qualified as IGB
 import Data.InvertibleGrammar qualified as IG
 import Data.InvertibleGrammar.Base ((:-)((:-)))
 import Data.List.NonEmpty (NonEmpty ((:|)))
-import Data.List.NonEmpty qualified as NE
 import Data.List (List, groupBy)
 import Data.Text.Encoding
-import Data.Either (either)
 import GHC.Generics (Generic)
 import Control.Lens hiding (para)
-import Data.Generics.Labels
-import System.Process
-import GHC.IO.Unsafe (unsafePerformIO)
-import qualified Data.Text.IO as TIO
 import Control.Monad (join)
 import qualified Language.Sexp.Located as SL
-import Data.Void (absurd, Void)
-import Data.Coerce (coerce)
-import qualified Data.Map
+import Data.Void (absurd)
 import Language.Haskell.TH.Quote
-import Language.Haskell.TH (Quote, location, Loc (..), ExpQ, varE, mkName, listE, Exp, appE, conE, Q, Code, unTypeCode)
+import Language.Haskell.TH (Quote, location, Loc (..), ExpQ, varE, mkName, listE, Exp, appE, Q, Code, unTypeCode)
 import qualified Data.Text as T
 import qualified Control.Category
 import Data.Data (Data (..), Typeable, cast)
 import Language.Haskell.TH.Syntax (lift, Lift, liftData)
-import GHC.IsList (fromList)
-import Data.Functor.Foldable (cata, para, embed)
-import Data.Functor.Classes (Show1(..))
+import Data.Functor.Foldable (cata)
 import Data.Vector (Vector)
 import Numeric.Natural (Natural)
-import Data.Maybe (fromMaybe)
-import Control.Applicative (Alternative((<|>)))
-import Debug.Pretty.Simple
-import qualified Data.Vector as V
 import qualified Data.Vector.Strict
 import Data.Function (on)
 import Data.String (IsString (fromString))
@@ -199,11 +182,6 @@ let_ kw name rhs e = list (el (sym kw) >>> el bindings >>> el e)
 data DotList a = MkDotList (NonEmpty a) a
  deriving (Show, Generic)

-dotlist :: (forall t. Grammar Position (Sexp :- t) (a :- t)) -> _
-dotlist x = list $ rest $ coproduct
-  [ x >>> _
-  ]
-
 -- | Define a sexp representation as either (⟨name⟩ ⟨e⟩) or '⟨e⟩.
 prefixSugar
  :: Text -> Prefix
@@ -217,7 +195,7 @@ prefixSugar name prefix e = coproduct
  ]

 todo :: Grammar p (Sexp :- t) t'
-todo = (IGB.Flip $ IGB.PartialIso absurd f) >>> IGB.PartialIso absurd g
+todo = IGB.Flip (IGB.PartialIso absurd f) >>> IGB.PartialIso absurd g
  where
    f _ = Left $ unexpected "todo"
    g _ = Left $ unexpected "todo"
@@ -280,31 +258,6 @@ headTagged2 s g1 g2 = list $ el (sym s) >>> el g1 >>> el g2



-class UglySexpIso a where
-  uglySexpIso :: SexpGrammar a
-
-newtype AsSexpIso a = AsSexpIso a
-newtype AsUglySexpIso a = AsUglySexpIso a
-
-asSexpIso :: Grammar p (a :- t) (AsSexpIso a :- t)
-asSexpIso = Sexp.iso AsSexpIso (\(AsSexpIso x) -> x)
-
-instance UglySexpIso a => SexpIso (AsUglySexpIso a) where
-  sexpIso = uglySexpIso @a >>> Sexp.iso coerce coerce
-
-instance SexpIso a => UglySexpIso (AsSexpIso a) where
-  uglySexpIso = sexpIso >>> Sexp.iso (\x -> AsSexpIso x) (\(AsSexpIso x) -> x)
-
-- why not work
-- deriving via AsSexpIso Text instance UglySexpIso Text
-
-instance UglySexpIso Text where uglySexpIso = sexpIso
-instance UglySexpIso Integer where uglySexpIso = sexpIso
-instance UglySexpIso Int where uglySexpIso = sexpIso
-instance UglySexpIso Bool where uglySexpIso = sexpIso
-instance UglySexpIso Double where uglySexpIso = sexpIso
-instance UglySexpIso () where uglySexpIso = sexpIso
-
 instance SexpIso Sexp where
  sexpIso = Control.Category.id

@@ -334,8 +287,11 @@ toSexp = either error id . Sexp.toSexp sexpIso
 toSexps :: (Foldable f, SexpIso a) => f a -> List Sexp
 toSexps = foldMap \x -> [toSexp x]

+pattern Unquote :: Text -> Sexp
 pattern Unquote x =
  SL.Modified Hash (SL.BraceList [SL.Symbol x])
+
+pattern UnquoteSplicing :: Text -> Sexp
 pattern UnquoteSplicing x =
  SL.Modified Hash (SL.Modified Hash (SL.BraceList [SL.Symbol x]))

@@ -8,7 +8,6 @@ import Data.List (List)
 import Gyehoek.CPS.Syntax (cps)
 import Gyehoek.GenSym (runGenSym)
 import Effectful
-import Test.Tasty.ExpectedFailure (expectFail)


 root :: IO TestTree
@@ -3,12 +3,9 @@ module Gyehoek.Test.CPS.Syntax (root) where

 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit
-import Language.Sexp.Located qualified as SL
 import Language.SexpGrammar ()
 import Gyehoek.CPS.Syntax (cps)
 import Gyehoek.CPS.Syntax qualified as Sut
-import Data.Function (on)
-import Gyehoek.Test.Sexp (equivto)


 root :: IO TestTree
@@ -5,8 +5,6 @@ import Test.Tasty.HUnit
 import Gyehoek.Stack.Syntax
 import Gyehoek.Stack.VM qualified as Sut
 import Data.List (List)
-import Control.Lens
-import Data.Generics.Labels


 root :: IO TestTree
@@ -31,8 +29,6 @@ lit_int = testCase "lit int" do
      ]
    ]

-vlb = ValImm . ImmLabel
-
 procedure = testGroup "procedure"
  [ testCase "return constant" do
      evalsTo [ObjImm (ImmInt 123)]
@@ -66,7 +62,7 @@ procedure = testGroup "procedure"
          ]
        ]
  , testCase "factorial" do
-      let fac =
+      let fac n =
            [ MkBlock "fac" ["n"]
              [ Prim "x0" $ PrimZeroP (ValReg "n")
              , If (ValReg "x0")
@@ -85,17 +81,12 @@ procedure = testGroup "procedure"
              , PopCont "ktail"
              , Call (ValReg "ktail") [ValReg "x3"]
              ]
+            , MkBlock "main" []
+              [ Call (ValLabel "fac") [ValImm (ImmInt n)]
+              ]
            ]
-      evalsTo [ObjImm (ImmInt 1)] $
-        [ MkBlock "main" []
-          [ Call (ValLabel "fac") [ValImm (ImmInt 0)]
-          ]
-        ] ++ fac
-      evalsTo [ObjImm (ImmInt 720)] $
-        [ MkBlock "main" []
-          [ Call (ValLabel "fac") [ValImm (ImmInt 6)]
-          ]
-        ] ++ fac
+      evalsTo [ObjImm (ImmInt 1)] $ fac 0
+      evalsTo [ObjImm (ImmInt 720)] $ fac 6
  ]

 prims = testGroup "prims"