fix some warnings

src/Gyehoek/CPS/Syntax.hs

@@ -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

src/Gyehoek/GenSym.hs

@@ -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

src/Gyehoek/Scheme/Syntax.hs

@@ -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 :: IOE :> es => FilePath -> Eff es Exp
-readExp fp = readProgram fp <&>
+readExp fp = readProgram fp <&> (^?! #commandsAndDefs . _head . #Command)
-  (^?! (#commandsAndDefs . _head . _Comm))

src/Gyehoek/Sexp.hs

@@ -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.Void (absurd)
-import Data.Coerce (coerce)
-import qualified Data.Map
 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)
-import Data.Functor.Foldable (cata, para, embed)
-import Data.Functor.Classes (Show1(..))
 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]))
 

test/Gyehoek/Test/CPS/Stackify.hs

@@ -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

test/Gyehoek/Test/CPS/Syntax.hs

@@ -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

test/Gyehoek/Test/Stack/VM.hs

@@ -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)] $
+      evalsTo [ObjImm (ImmInt 1)] $ fac 0
-        [ MkBlock "main" []
+      evalsTo [ObjImm (ImmInt 720)] $ fac 6
-          [ Call (ValLabel "fac") [ValImm (ImmInt 0)]
-          ]
-        ] ++ fac
-      evalsTo [ObjImm (ImmInt 720)] $
-        [ MkBlock "main" []
-          [ Call (ValLabel "fac") [ValImm (ImmInt 6)]
-          ]
-        ] ++ fac
   ]
 
 prims = testGroup "prims"