remove sexp-grammar
This commit is contained in:
@@ -61,7 +61,6 @@ library
|
|||||||
Gyehoek.Driver
|
Gyehoek.Driver
|
||||||
Gyehoek.GenSym
|
Gyehoek.GenSym
|
||||||
Gyehoek.Jalmot
|
Gyehoek.Jalmot
|
||||||
Gyehoek.Language
|
|
||||||
Gyehoek.Lift1
|
Gyehoek.Lift1
|
||||||
Gyehoek.Options
|
Gyehoek.Options
|
||||||
Gyehoek.Prelude
|
Gyehoek.Prelude
|
||||||
@@ -105,7 +104,6 @@ library
|
|||||||
, process
|
, process
|
||||||
, recursion-schemes
|
, recursion-schemes
|
||||||
, scientific
|
, scientific
|
||||||
, sexp-grammar
|
|
||||||
, string-interpolate
|
, string-interpolate
|
||||||
, template-haskell
|
, template-haskell
|
||||||
, text
|
, text
|
||||||
@@ -149,7 +147,6 @@ test-suite test
|
|||||||
, lens
|
, lens
|
||||||
, pretty-simple
|
, pretty-simple
|
||||||
, process-extras
|
, process-extras
|
||||||
, sexp-grammar
|
|
||||||
, tasty
|
, tasty
|
||||||
, tasty-expected-failure
|
, tasty-expected-failure
|
||||||
, tasty-hunit
|
, tasty-hunit
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
module Gyehoek.Driver
|
module Gyehoek.Driver
|
||||||
(main, lower_e2e, convert_e2e, parse_e2e, readScm, eval_e2e)
|
(main, lower_e2e, convert_e2e, parse_e2e, readScm, eval_e2e)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Gyehoek.Options
|
import Gyehoek.Options
|
||||||
import Prelude hiding (readFile)
|
import Prelude hiding (readFile)
|
||||||
import Options.Applicative
|
import Options.Applicative
|
||||||
@@ -35,14 +35,14 @@ import Control.Arrow ((>>>))
|
|||||||
import Gyehoek.Prelude
|
import Gyehoek.Prelude
|
||||||
import Gyehoek.Jalmot
|
import Gyehoek.Jalmot
|
||||||
import qualified Gyehoek.Sexp as S
|
import qualified Gyehoek.Sexp as S
|
||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
opts <- execParser $ info (helper <*> parser) fullDesc
|
opts <- execParser $ info (helper <*> parser) fullDesc
|
||||||
runJalmotIO . runFileSystem . runGenSym . driver $ opts
|
runJalmotIO . runFileSystem . runGenSym . driver $ opts
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- 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
|
||||||
@@ -125,7 +125,7 @@ driver opts = do
|
|||||||
let rt_is p = is (_Just . p) opts.runtime
|
let rt_is p = is (_Just . p) opts.runtime
|
||||||
dumpOrRun opts.dumpStackified (rt_is #Stackify)
|
dumpOrRun opts.dumpStackified (rt_is #Stackify)
|
||||||
(stackifyProgram closedCps)
|
(stackifyProgram closedCps)
|
||||||
(hPutStrLn FS.stdout . Stk.encodeProgram)
|
(hPutStrLn FS.stdout <=< S.encodeDataWith S.dataIso)
|
||||||
(eval >>> fmap writeObj
|
(eval >>> fmap writeObj
|
||||||
>>> T.unwords
|
>>> T.unwords
|
||||||
>>> hPutStrLn FS.stdout)
|
>>> hPutStrLn FS.stdout)
|
||||||
|
|||||||
@@ -1,25 +0,0 @@
|
|||||||
{-# LANGUAGE TypeFamilies #-}
|
|
||||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
|
||||||
module Gyehoek.Language
|
|
||||||
( Language(..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Kind (Type)
|
|
||||||
import Gyehoek.Prelude
|
|
||||||
import Language.SexpGrammar (Position, Grammar, (:-), Sexp)
|
|
||||||
|
|
||||||
|
|
||||||
class Language l where
|
|
||||||
type Program l :: Type
|
|
||||||
languageName :: Text
|
|
||||||
programGrammar :: forall t. Grammar Position (List Sexp :- t) (Program l :- t)
|
|
||||||
|
|
||||||
readProgramFile
|
|
||||||
:: forall l es. Language l
|
|
||||||
=> FilePath -> Eff es (Program l)
|
|
||||||
readProgramFile fp = _
|
|
||||||
|
|
||||||
readProgramStringPos
|
|
||||||
:: forall l. Language l
|
|
||||||
=> Position -> Text -> Either Text (Program l)
|
|
||||||
readProgramStringPos pos s = _
|
|
||||||
@@ -225,7 +225,7 @@ instance DataIso Program where
|
|||||||
-- utilities
|
-- utilities
|
||||||
|
|
||||||
scm :: QuasiQuoter
|
scm :: QuasiQuoter
|
||||||
scm = GS.makeSx [|| S.fromDatumUnsafe S.datumIso ||]
|
scm = GS.makeSx [|| S.fromDatumUnsafe @Exp S.datumIso ||]
|
||||||
|
|
||||||
freeWithBound' :: Foldable f => f Name -> Exp -> List Name
|
freeWithBound' :: Foldable f => f Name -> Exp -> List Name
|
||||||
freeWithBound' bound = filter (`elem` bound) . free'
|
freeWithBound' bound = filter (`elem` bound) . free'
|
||||||
|
|||||||
+27
-34
@@ -14,14 +14,10 @@ module Gyehoek.Stack.Syntax
|
|||||||
, Prim(..)
|
, Prim(..)
|
||||||
, Name
|
, Name
|
||||||
, pattern ValLabel
|
, pattern ValLabel
|
||||||
, encodeProgram
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Language.SexpGrammar (SexpIso, (>>>))
|
import qualified Gyehoek.Sexp as S
|
||||||
import Language.SexpGrammar qualified as S
|
|
||||||
import Language.SexpGrammar.Generic
|
|
||||||
import qualified Gyehoek.Sexp
|
|
||||||
import Gyehoek.Scheme.Syntax (Name(..), Lit(..), Prim(..))
|
import Gyehoek.Scheme.Syntax (Name(..), Lit(..), Prim(..))
|
||||||
import GHC.Exts (IsList(..))
|
import GHC.Exts (IsList(..))
|
||||||
import Data.List (intersperse)
|
import Data.List (intersperse)
|
||||||
@@ -77,43 +73,40 @@ pattern ValLabel x = ValImm (ImmLabel x)
|
|||||||
|
|
||||||
pure []
|
pure []
|
||||||
|
|
||||||
instance SexpIso Instr where
|
instance S.DatumIso Instr where
|
||||||
sexpIso = match
|
datumIso = S.match
|
||||||
$ With (Gyehoek.Sexp.headTagged1 "pop!" regName >>>)
|
$ S.With (S.headTagged1 "pop!" regName >>>)
|
||||||
$ With (Gyehoek.Sexp.headTagged1 "push!" S.sexpIso >>>)
|
$ S.With (S.headTagged1 "push!" S.datumIso >>>)
|
||||||
$ With (Gyehoek.Sexp.headTagged1 "pop-cont!" regName >>>)
|
$ S.With (S.headTagged1 "pop-cont!" regName >>>)
|
||||||
$ With (Gyehoek.Sexp.headTagged1 "push-cont!" S.sexpIso >>>)
|
$ S.With (S.headTagged1 "push-cont!" S.datumIso >>>)
|
||||||
$ With (Gyehoek.Sexp.headTagged2 "prim" regName S.sexpIso >>>)
|
$ S.With (S.headTagged2 "prim" regName S.datumIso >>>)
|
||||||
$ With (Gyehoek.Sexp.headTagged1' "call" S.sexpIso S.sexpIso >>>)
|
$ S.With (S.headTagged1' "call" S.datumIso S.datumIso >>>)
|
||||||
$ With (if_ >>>)
|
$ S.With (if_ >>>)
|
||||||
$ End
|
$ S.End
|
||||||
where
|
where
|
||||||
if_ = S.list $ S.el (S.sym "if")
|
if_ = S.list $ S.el (S.sym "if")
|
||||||
>>> S.el (S.sexpIso @Val)
|
>>> S.el (S.datumIso @Val)
|
||||||
>>> S.el (S.list $ S.el (S.sym "then") >>> S.rest (S.sexpIso @Instr))
|
>>> S.el (S.list $ S.el (S.sym "then") >>> S.rest (S.datumIso @Instr))
|
||||||
>>> S.el (S.list $ S.el (S.sym "else") >>> S.rest (S.sexpIso @Instr))
|
>>> S.el (S.list $ S.el (S.sym "else") >>> S.rest (S.datumIso @Instr))
|
||||||
|
|
||||||
instance SexpIso Val where
|
instance S.DatumIso Val where
|
||||||
sexpIso = match
|
datumIso = S.match
|
||||||
$ With (regName >>>)
|
$ S.With (regName >>>)
|
||||||
$ With (S.sexpIso >>>)
|
$ S.With (S.datumIso >>>)
|
||||||
$ End
|
$ S.End
|
||||||
|
|
||||||
instance SexpIso Block where
|
instance S.DatumIso Block where
|
||||||
sexpIso = with (block >>>)
|
datumIso = S.with (block >>>)
|
||||||
where
|
where
|
||||||
block = S.list $
|
block = S.list $
|
||||||
S.el (S.sym "define")
|
S.el (S.sym "define")
|
||||||
>>> S.el (S.list $ S.el labelName >>> S.rest regName)
|
>>> S.el (S.list $ S.el labelName >>> S.rest regName)
|
||||||
>>> S.rest (S.sexpIso @Instr)
|
>>> S.rest (S.datumIso @Instr)
|
||||||
|
|
||||||
encodeProgram :: Program -> Text
|
regName :: S.DatumGrammar Name
|
||||||
encodeProgram p = p.blocks
|
regName = S.datumIso @Name >>> S.prismIso
|
||||||
& fmap ((^?! _Right) . Gyehoek.Sexp.encodePretty)
|
|
||||||
& intersperse "\n\n"
|
|
||||||
& mconcat
|
|
||||||
|
|
||||||
regName :: S.SexpGrammar Name
|
|
||||||
regName = S.sexpIso @Name >>> Gyehoek.Sexp.prismIso
|
|
||||||
(S.expected "register")
|
(S.expected "register")
|
||||||
(prefixed @Name "%")
|
(prefixed @Name "%")
|
||||||
|
|
||||||
|
instance S.DataIso Program where
|
||||||
|
dataIso = S.dataIso @(List Block) >>> S.iso coerce coerce
|
||||||
|
|||||||
@@ -2,7 +2,6 @@ module Gyehoek.Test.CPS.Eval where
|
|||||||
|
|
||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit
|
||||||
import Language.SexpGrammar ()
|
|
||||||
import Gyehoek.CPS.Syntax (cps, Obj(..), Hob(..), Imm(..))
|
import Gyehoek.CPS.Syntax (cps, Obj(..), Hob(..), Imm(..))
|
||||||
import Gyehoek.CPS.Eval qualified as Sut
|
import Gyehoek.CPS.Eval qualified as Sut
|
||||||
import Data.List (List)
|
import Data.List (List)
|
||||||
|
|||||||
@@ -3,7 +3,6 @@ module Gyehoek.Test.CPS.Syntax where
|
|||||||
|
|
||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit
|
||||||
import Language.SexpGrammar ()
|
|
||||||
import Gyehoek.CPS.Syntax (cps)
|
import Gyehoek.CPS.Syntax (cps)
|
||||||
import Gyehoek.CPS.Syntax qualified as Sut
|
import Gyehoek.CPS.Syntax qualified as Sut
|
||||||
|
|
||||||
|
|||||||
@@ -2,7 +2,6 @@ module Gyehoek.Test.Scheme.Syntax where
|
|||||||
|
|
||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit
|
||||||
import Language.SexpGrammar ()
|
|
||||||
import Gyehoek.Scheme.Syntax (scm)
|
import Gyehoek.Scheme.Syntax (scm)
|
||||||
import Gyehoek.Scheme.Syntax qualified as Sut
|
import Gyehoek.Scheme.Syntax qualified as Sut
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user