From f9ed1274d9c1b2610321e8f278f84ea5a04dbef5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Thu, 20 Aug 2026 21:52:55 -0600 Subject: [PATCH] r7rs datum ast --- gyehoek.cabal | 6 ++++ src/Gyehoek/Language.hs | 25 ++++++++++++++++ src/Gyehoek/Options.hs | 35 ++++++++++++++++++++-- src/Gyehoek/Prelude.hs | 4 +++ src/Gyehoek/Sexp.hs | 1 + src/Gyehoek/Sexp/Grammar.hs | 4 +++ src/Gyehoek/Sexp/Print.hs | 4 +++ src/Gyehoek/Sexp/Read.hs | 4 +++ src/Gyehoek/Sexp/Syntax.hs | 58 +++++++++++++++++++++++++++++++++++++ 9 files changed, 138 insertions(+), 3 deletions(-) create mode 100644 src/Gyehoek/Language.hs create mode 100644 src/Gyehoek/Sexp/Grammar.hs create mode 100644 src/Gyehoek/Sexp/Print.hs create mode 100644 src/Gyehoek/Sexp/Read.hs create mode 100644 src/Gyehoek/Sexp/Syntax.hs diff --git a/gyehoek.cabal b/gyehoek.cabal index 2af765d..e1ec645 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -60,10 +60,15 @@ library Gyehoek.CPS.Syntax Gyehoek.Driver Gyehoek.GenSym + Gyehoek.Language Gyehoek.Options Gyehoek.Prelude Gyehoek.Scheme.Syntax Gyehoek.Sexp + Gyehoek.Sexp.Grammar + Gyehoek.Sexp.Print + Gyehoek.Sexp.Read + Gyehoek.Sexp.Syntax Gyehoek.Stack.Syntax Gyehoek.Stack.VM Gyehoek.Wasm @@ -90,6 +95,7 @@ library , prettyprinter , process , recursion-schemes + , scientific , sexp-grammar , string-interpolate , template-haskell diff --git a/src/Gyehoek/Language.hs b/src/Gyehoek/Language.hs new file mode 100644 index 0000000..f3bdd84 --- /dev/null +++ b/src/Gyehoek/Language.hs @@ -0,0 +1,25 @@ +{-# 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/Options.hs b/src/Gyehoek/Options.hs index 064ef15..b074753 100644 --- a/src/Gyehoek/Options.hs +++ b/src/Gyehoek/Options.hs @@ -2,8 +2,9 @@ {-# LANGUAGE RecordWildCards #-} module Gyehoek.Options ( Options(..) - , Runtime(..) , parser + , Runtime(..) + , Language(..) ) where @@ -13,7 +14,15 @@ import Gyehoek.Prelude hiding (argument) data Runtime = Stackify | Wasm | CPS - deriving (Show, Generic) + deriving (Show, Generic, Eq) + +data Language + = LanguageScheme + | LanguageCPS + | LanguageClosed + | LanguageStackified + | LanguageWasm + deriving (Show, Generic, Eq) data Options = MkOptions { dumpClosed :: Bool @@ -24,9 +33,20 @@ data Options = MkOptions , inspectWasm :: Bool , output :: FilePath , sourceFile :: FilePath + , sourceLanguage :: Language } deriving (Show, Generic) +languageValues = ["scheme","cps","closed","stackified","wasm"] +languageReader = maybeReader \case + "scheme" -> Just LanguageScheme + "cps" -> Just LanguageCPS + "closed" -> Just LanguageClosed + "stackified" -> Just LanguageStackified + "wasm" -> Just LanguageWasm + _ -> Nothing + +runtimeValues = ["stackify","wasm","cps","none"] runtimeReader = maybeReader \case "stackify" -> Just (Just Stackify) "wasm" -> Just (Just Wasm) @@ -45,8 +65,17 @@ parser = do [ long "runtime" , short 'R' , value (Just Stackify) - , completeWith ["stackify","wasm","cps","none"] + , completeWith runtimeValues , showDefaultWith $ const "stackify" + , metavar "RUNTIME" + ] + sourceLanguage <- option languageReader . fold $ + [ long "source" + , short 'S' + , value LanguageScheme + , completeWith languageValues + , showDefaultWith $ const "scheme" + , metavar "LANGUAGE" ] output <- strOption . fold $ [ long "output" diff --git a/src/Gyehoek/Prelude.hs b/src/Gyehoek/Prelude.hs index 9c863e6..10e66a8 100644 --- a/src/Gyehoek/Prelude.hs +++ b/src/Gyehoek/Prelude.hs @@ -14,6 +14,8 @@ module Gyehoek.Prelude , IsList(fromList) , HasCallStack , Hashable + , NonEmpty((:|)) + , Natural ) where import Control.Lens @@ -31,4 +33,6 @@ import Data.Generics.Labels () import Data.String.Interpolate import GHC.Stack (HasCallStack) import Data.Hashable (Hashable) +import Data.List.NonEmpty (NonEmpty((:|))) +import Numeric.Natural (Natural) diff --git a/src/Gyehoek/Sexp.hs b/src/Gyehoek/Sexp.hs index 7b04e83..dcf2590 100644 --- a/src/Gyehoek/Sexp.hs +++ b/src/Gyehoek/Sexp.hs @@ -26,6 +26,7 @@ module Gyehoek.Sexp , encodePrettyWith , encodePretty , SpliceSexp(..) + , Position(..) , parseSexpsWithPos , parseSexpWithPos , parseSexp diff --git a/src/Gyehoek/Sexp/Grammar.hs b/src/Gyehoek/Sexp/Grammar.hs new file mode 100644 index 0000000..1d908f3 --- /dev/null +++ b/src/Gyehoek/Sexp/Grammar.hs @@ -0,0 +1,4 @@ +module Gyehoek.Sexp.Grammar + ( + ) where + diff --git a/src/Gyehoek/Sexp/Print.hs b/src/Gyehoek/Sexp/Print.hs new file mode 100644 index 0000000..66064c7 --- /dev/null +++ b/src/Gyehoek/Sexp/Print.hs @@ -0,0 +1,4 @@ +module Gyehoek.Sexp.Print + ( + ) where + diff --git a/src/Gyehoek/Sexp/Read.hs b/src/Gyehoek/Sexp/Read.hs new file mode 100644 index 0000000..12a0530 --- /dev/null +++ b/src/Gyehoek/Sexp/Read.hs @@ -0,0 +1,4 @@ +module Gyehoek.Sexp.Read + ( + ) where + diff --git a/src/Gyehoek/Sexp/Syntax.hs b/src/Gyehoek/Sexp/Syntax.hs new file mode 100644 index 0000000..8afba00 --- /dev/null +++ b/src/Gyehoek/Sexp/Syntax.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE DeriveAnyClass #-} +module Gyehoek.Sexp.Syntax + ( DatumF(..) + , Simple(..) + , CompoundF(..) + , Prefix(..) + , Delimiter(..) + , Label(..) + ) where + +import Language.Haskell.TH.Syntax (Lift) +import Data.Scientific (Scientific) +import Data.ByteString (ByteString) +import Gyehoek.Prelude hiding (Simple) + + +data DatumF a + = SimpleF Simple + | CompoundF (CompoundF a) + | LabeledF Label a + | LabelRefF Label + deriving stock (Show, Eq, Data, Generic, Lift) + deriving anyclass (NFData) + +data Simple + = SimpleBool Bool + | SimpleNumber Scientific + | SimpleChar Char + | SimpleString Text + | SimpleSymbol Text + | SimpleBytevector ByteString + deriving stock (Show, Eq, Data, Generic, Lift) + deriving anyclass (NFData) + +data CompoundF a + = ListF (List a) + | DotListF (NonEmpty a) a + | VectorF (List a) + | AbbrevF Prefix a + deriving stock (Show, Eq, Data, Generic, Lift) + deriving anyclass (NFData) + +data Prefix + = Quote | Backtick | Comma | CommaAt + deriving stock (Show, Eq, Data, Generic, Lift) + deriving anyclass (NFData) + +data Delimiter + = Paren + | Square + | Curly + deriving stock (Show, Eq, Data, Generic, Lift) + deriving anyclass (NFData) + +newtype Label = MkLabel Natural + deriving stock (Data, Generic, Lift) + deriving newtype (Eq, Ord, Show) + deriving anyclass (NFData)