r7rs datum ast

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

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 = _

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"

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)
 

src/Gyehoek/Sexp.hs

@@ -26,6 +26,7 @@ module Gyehoek.Sexp
   , encodePrettyWith
   , encodePretty
   , SpliceSexp(..)
+  , Position(..)
   , parseSexpsWithPos
   , parseSexpWithPos
   , parseSexp

src/Gyehoek/Sexp/Grammar.hs

@@ -0,0 +1,4 @@
+module Gyehoek.Sexp.Grammar
+  (
+  ) where
+

src/Gyehoek/Sexp/Print.hs

@@ -0,0 +1,4 @@
+module Gyehoek.Sexp.Print
+  (
+  ) where
+

src/Gyehoek/Sexp/Read.hs

@@ -0,0 +1,4 @@
+module Gyehoek.Sexp.Read
+  (
+  ) where
+

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
+  | SimpleString
+  | SimpleSymbol
+  | 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)