From 2ceefdb3df286fe721439e662855cd2357376e28 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Sun, 23 Aug 2026 00:46:57 -0600 Subject: [PATCH] remove sexp-grammar --- gyehoek.cabal | 3 -- src/Gyehoek/Driver.hs | 16 ++++---- src/Gyehoek/Language.hs | 25 ------------ src/Gyehoek/Scheme/Syntax.hs | 2 +- src/Gyehoek/Stack/Syntax.hs | 61 +++++++++++++----------------- test/Gyehoek/Test/CPS/Eval.hs | 1 - test/Gyehoek/Test/CPS/Syntax.hs | 1 - test/Gyehoek/Test/Scheme/Syntax.hs | 1 - 8 files changed, 36 insertions(+), 74 deletions(-) delete mode 100644 src/Gyehoek/Language.hs diff --git a/gyehoek.cabal b/gyehoek.cabal index 133a4aa..f48e9fc 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -61,7 +61,6 @@ library Gyehoek.Driver Gyehoek.GenSym Gyehoek.Jalmot - Gyehoek.Language Gyehoek.Lift1 Gyehoek.Options Gyehoek.Prelude @@ -105,7 +104,6 @@ library , process , recursion-schemes , scientific - , sexp-grammar , string-interpolate , template-haskell , text @@ -149,7 +147,6 @@ test-suite test , lens , pretty-simple , process-extras - , sexp-grammar , tasty , tasty-expected-failure , tasty-hunit diff --git a/src/Gyehoek/Driver.hs b/src/Gyehoek/Driver.hs index d9c3ebe..33b98a0 100644 --- a/src/Gyehoek/Driver.hs +++ b/src/Gyehoek/Driver.hs @@ -1,7 +1,7 @@ module Gyehoek.Driver (main, lower_e2e, convert_e2e, parse_e2e, readScm, eval_e2e) where - + import Gyehoek.Options import Prelude hiding (readFile) import Options.Applicative @@ -35,14 +35,14 @@ import Control.Arrow ((>>>)) import Gyehoek.Prelude import Gyehoek.Jalmot import qualified Gyehoek.Sexp as S - + main :: IO () main = do opts <- execParser $ info (helper <*> parser) fullDesc runJalmotIO . runFileSystem . runGenSym . driver $ opts - + -- hPutStr :: FileSystem :> es => Handle -> Text -> Eff es () -- hPutStr h = FB.hPutStr h . T.encodeUtf8 @@ -125,15 +125,15 @@ driver opts = do let rt_is p = is (_Just . p) opts.runtime dumpOrRun opts.dumpStackified (rt_is #Stackify) (stackifyProgram closedCps) - (hPutStrLn FS.stdout . Stk.encodeProgram) - (eval >>> fmap writeObj - >>> T.unwords + (hPutStrLn FS.stdout <=< S.encodeDataWith S.dataIso) + (eval >>> fmap writeObj + >>> T.unwords >>> hPutStrLn FS.stdout) when (rt_is #CPS) do closedCps & CPS.evalProgram - & fmap writeObj - & T.unwords + & fmap writeObj + & T.unwords & hPutStrLn FS.stdout dumpOrRun opts.inspectWasm (rt_is #Wasm) (lowerProgram cps) diff --git a/src/Gyehoek/Language.hs b/src/Gyehoek/Language.hs deleted file mode 100644 index f3bdd84..0000000 --- a/src/Gyehoek/Language.hs +++ /dev/null @@ -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 = _ diff --git a/src/Gyehoek/Scheme/Syntax.hs b/src/Gyehoek/Scheme/Syntax.hs index f63ec5c..8b85e8d 100644 --- a/src/Gyehoek/Scheme/Syntax.hs +++ b/src/Gyehoek/Scheme/Syntax.hs @@ -225,7 +225,7 @@ instance DataIso Program where -- utilities 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' bound = filter (`elem` bound) . free' diff --git a/src/Gyehoek/Stack/Syntax.hs b/src/Gyehoek/Stack/Syntax.hs index 1c5dddd..2141d31 100644 --- a/src/Gyehoek/Stack/Syntax.hs +++ b/src/Gyehoek/Stack/Syntax.hs @@ -14,14 +14,10 @@ module Gyehoek.Stack.Syntax , Prim(..) , Name , pattern ValLabel - , encodeProgram ) where import Control.Lens -import Language.SexpGrammar (SexpIso, (>>>)) -import Language.SexpGrammar qualified as S -import Language.SexpGrammar.Generic -import qualified Gyehoek.Sexp +import qualified Gyehoek.Sexp as S import Gyehoek.Scheme.Syntax (Name(..), Lit(..), Prim(..)) import GHC.Exts (IsList(..)) import Data.List (intersperse) @@ -77,43 +73,40 @@ pattern ValLabel x = ValImm (ImmLabel x) pure [] -instance SexpIso Instr where - sexpIso = match - $ With (Gyehoek.Sexp.headTagged1 "pop!" regName >>>) - $ With (Gyehoek.Sexp.headTagged1 "push!" S.sexpIso >>>) - $ With (Gyehoek.Sexp.headTagged1 "pop-cont!" regName >>>) - $ With (Gyehoek.Sexp.headTagged1 "push-cont!" S.sexpIso >>>) - $ With (Gyehoek.Sexp.headTagged2 "prim" regName S.sexpIso >>>) - $ With (Gyehoek.Sexp.headTagged1' "call" S.sexpIso S.sexpIso >>>) - $ With (if_ >>>) - $ End +instance S.DatumIso Instr where + datumIso = S.match + $ S.With (S.headTagged1 "pop!" regName >>>) + $ S.With (S.headTagged1 "push!" S.datumIso >>>) + $ S.With (S.headTagged1 "pop-cont!" regName >>>) + $ S.With (S.headTagged1 "push-cont!" S.datumIso >>>) + $ S.With (S.headTagged2 "prim" regName S.datumIso >>>) + $ S.With (S.headTagged1' "call" S.datumIso S.datumIso >>>) + $ S.With (if_ >>>) + $ S.End where if_ = S.list $ S.el (S.sym "if") - >>> S.el (S.sexpIso @Val) - >>> S.el (S.list $ S.el (S.sym "then") >>> S.rest (S.sexpIso @Instr)) - >>> S.el (S.list $ S.el (S.sym "else") >>> S.rest (S.sexpIso @Instr)) + >>> S.el (S.datumIso @Val) + >>> 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.datumIso @Instr)) -instance SexpIso Val where - sexpIso = match - $ With (regName >>>) - $ With (S.sexpIso >>>) - $ End +instance S.DatumIso Val where + datumIso = S.match + $ S.With (regName >>>) + $ S.With (S.datumIso >>>) + $ S.End -instance SexpIso Block where - sexpIso = with (block >>>) +instance S.DatumIso Block where + datumIso = S.with (block >>>) where block = S.list $ S.el (S.sym "define") >>> S.el (S.list $ S.el labelName >>> S.rest regName) - >>> S.rest (S.sexpIso @Instr) + >>> S.rest (S.datumIso @Instr) -encodeProgram :: Program -> Text -encodeProgram p = p.blocks - & fmap ((^?! _Right) . Gyehoek.Sexp.encodePretty) - & intersperse "\n\n" - & mconcat - -regName :: S.SexpGrammar Name -regName = S.sexpIso @Name >>> Gyehoek.Sexp.prismIso +regName :: S.DatumGrammar Name +regName = S.datumIso @Name >>> S.prismIso (S.expected "register") (prefixed @Name "%") + +instance S.DataIso Program where + dataIso = S.dataIso @(List Block) >>> S.iso coerce coerce diff --git a/test/Gyehoek/Test/CPS/Eval.hs b/test/Gyehoek/Test/CPS/Eval.hs index 8f28740..2b0c40f 100644 --- a/test/Gyehoek/Test/CPS/Eval.hs +++ b/test/Gyehoek/Test/CPS/Eval.hs @@ -2,7 +2,6 @@ module Gyehoek.Test.CPS.Eval where import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit -import Language.SexpGrammar () import Gyehoek.CPS.Syntax (cps, Obj(..), Hob(..), Imm(..)) import Gyehoek.CPS.Eval qualified as Sut import Data.List (List) diff --git a/test/Gyehoek/Test/CPS/Syntax.hs b/test/Gyehoek/Test/CPS/Syntax.hs index f32a04d..5ecd917 100644 --- a/test/Gyehoek/Test/CPS/Syntax.hs +++ b/test/Gyehoek/Test/CPS/Syntax.hs @@ -3,7 +3,6 @@ module Gyehoek.Test.CPS.Syntax where import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit -import Language.SexpGrammar () import Gyehoek.CPS.Syntax (cps) import Gyehoek.CPS.Syntax qualified as Sut diff --git a/test/Gyehoek/Test/Scheme/Syntax.hs b/test/Gyehoek/Test/Scheme/Syntax.hs index 50f9442..2f3c1e9 100644 --- a/test/Gyehoek/Test/Scheme/Syntax.hs +++ b/test/Gyehoek/Test/Scheme/Syntax.hs @@ -2,7 +2,6 @@ module Gyehoek.Test.Scheme.Syntax where import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit -import Language.SexpGrammar () import Gyehoek.Scheme.Syntax (scm) import Gyehoek.Scheme.Syntax qualified as Sut