remove sexp-grammar

This commit is contained in:
2026-08-23 00:54:46 -06:00
parent 7c0642655f
commit 2ceefdb3df
8 changed files with 36 additions and 74 deletions
-3
View File
@@ -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
+8 -8
View File
@@ -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,15 +125,15 @@ 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)
when (rt_is #CPS) do when (rt_is #CPS) do
closedCps closedCps
& CPS.evalProgram & CPS.evalProgram
& fmap writeObj & fmap writeObj
& T.unwords & T.unwords
& hPutStrLn FS.stdout & hPutStrLn FS.stdout
dumpOrRun opts.inspectWasm (rt_is #Wasm) dumpOrRun opts.inspectWasm (rt_is #Wasm)
(lowerProgram cps) (lowerProgram cps)
-25
View File
@@ -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 = _
+1 -1
View File
@@ -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
View File
@@ -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
-1
View File
@@ -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)
-1
View File
@@ -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
-1
View File
@@ -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