This commit is contained in:
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
@@ -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)
|
||||||
|
|||||||
@@ -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
@@ -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_)
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user