diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 1c6242de6..4372c9686 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -166,6 +166,9 @@ instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Identifier where eval (Identifier name) = pure (LvalLocal name) +instance Tokenize Identifier where + tokenize = yield . Fragment . formatName . Data.Syntax.name + instance FreeVariables1 Identifier where liftFreeVariables _ (Identifier x) = Set.singleton x @@ -198,6 +201,9 @@ instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty" instance Evaluatable Empty where eval _ = rvalBox unit +instance Tokenize Empty where + tokenize = ignore + -- | Syntax representing a parsing or assignment error. data Error a = Error { errorCallStack :: ErrorStack, errorExpected :: [String], errorActual :: Maybe String, errorChildren :: [a] } deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable) @@ -299,3 +305,6 @@ instance Show1 Context where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Context where eval Context{..} = subtermRef contextSubject + +instance Tokenize Context where + tokenize Context{..} = for_ contextTerms (\c -> c *> yield Separator) *> contextSubject diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index 338060d43..0d547983a 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -7,6 +7,7 @@ import Data.JSON.Fields import Diffing.Algorithm import Prologue import Proto3.Suite.Class +import Reprinting.Tokenize as Token -- | An unnested comment (line or block). newtype Comment a = Comment { commentContent :: Text } @@ -19,6 +20,9 @@ instance Show1 Comment where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Comment where eval _ = rvalBox unit +instance Tokenize Comment where + tokenize = yield . Fragment . commentContent + -- TODO: nested comment types -- TODO: documentation comment types -- TODO: literate programming comment types? alternatively, consider those as markup diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index 2920d6e8e..de3368f09 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -51,6 +51,9 @@ instance Evaluatable Data.Syntax.Literal.Integer where eval (Data.Syntax.Literal.Integer x) = rvalBox =<< (integer <$> either (const (throwEvalError (IntegerFormatError x))) pure (parseInteger x)) +instance Tokenize Data.Syntax.Literal.Integer where + tokenize = yield . Fragment . integerContent + -- | A literal float of unspecified width. newtype Float a = Float { floatContent :: Text } diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 166d8811f..11a0cddce 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -5,12 +5,14 @@ module Data.Syntax.Statement where import Data.Abstract.Evaluatable import Data.Aeson (ToJSON1 (..)) import Data.JSON.Fields +import Data.List (intersperse) import Data.Semigroup.App import Data.Semigroup.Foldable import Diffing.Algorithm import Prelude import Prologue import Proto3.Suite.Class +import Reprinting.Tokenize -- | Imperative sequence of statements/declarations s.t.: -- @@ -28,6 +30,9 @@ instance ToJSON1 Statements instance Evaluatable Statements where eval (Statements xs) = maybe (rvalBox unit) (runApp . foldMap1 (App . subtermRef)) (nonEmpty xs) +instance Tokenize Statements where + tokenize = imperative_ . sep + -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted. data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a } deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)