Add documentation
This commit is contained in:
parent
d380e46737
commit
923a5bb9fe
@ -1,10 +1,10 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.33.0.
|
||||
-- This file has been generated from package.yaml by hpack version 0.31.2.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: fc91e2bbafd609769dba91a90992c659e68f017fa28f156cd261cd553083a47d
|
||||
-- hash: 1c4275313cf3b683e190f5dc3ea95cd8cde978c09aa4f2269958de6128c73df3
|
||||
|
||||
name: squirrel
|
||||
version: 0.0.0
|
||||
@ -13,15 +13,18 @@ build-type: Simple
|
||||
library
|
||||
exposed-modules:
|
||||
AST
|
||||
AST.Errors
|
||||
AST.Parser
|
||||
AST.Scope
|
||||
AST.Types
|
||||
Error
|
||||
HasComments
|
||||
HasErrors
|
||||
Lattice
|
||||
Parser
|
||||
ParseTree
|
||||
Pretty
|
||||
Range
|
||||
Stubbed
|
||||
TH
|
||||
Tree
|
||||
Union
|
||||
|
@ -318,8 +318,8 @@ data Scope = Scope { unScope :: Text }
|
||||
instance HasComments Scope where
|
||||
getComments = pure . ("(* " <>) . (<> " *)") . unScope
|
||||
|
||||
runScopeM :: ScopeM a -> a
|
||||
runScopeM action = evalState action [Env []]
|
||||
evalScopeM :: ScopeM a -> a
|
||||
evalScopeM action = evalState action [Env []]
|
||||
|
||||
testUpdate :: Pascal ASTInfo -> ScopeM (Pascal Scope)
|
||||
testUpdate = updateTree \_ -> do
|
||||
|
@ -1,9 +1,6 @@
|
||||
|
||||
{-
|
||||
{- |
|
||||
The AST and auxillary types along with their pretty-printers.
|
||||
|
||||
TODO: Untangle pretty-printing mess into combinators.
|
||||
TODO: Store offending text verbatim in Wrong*.
|
||||
-}
|
||||
|
||||
module AST.Types where
|
||||
@ -24,29 +21,39 @@ import TH
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
-- | The AST for Pascali... wait. It is, em, universal one.
|
||||
--
|
||||
-- TODO: Rename; add stuff if CamlLIGO/ReasonLIGO needs something.
|
||||
--
|
||||
type Pascal = Tree
|
||||
[ Name, Path, QualifiedName, Pattern, Constant, FieldAssignment, Assignment
|
||||
, MapBinding, LHS, Alt, Expr, TField, Variant, Type, Mutable, VarDecl, Binding
|
||||
, Declaration, Contract
|
||||
]
|
||||
|
||||
data Contract it
|
||||
= Contract [it]
|
||||
deriving (Show) via PP (Contract it)
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
|
||||
data Declaration it
|
||||
= ValueDecl it -- Binding
|
||||
| TypeDecl it it -- Name Type
|
||||
| Action it -- Expr
|
||||
= ValueDecl it -- ^ Binding
|
||||
| TypeDecl it it -- ^ Name Type
|
||||
| Action it -- ^ Expr
|
||||
| Include Text
|
||||
deriving (Show) via PP (Declaration it)
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
|
||||
data Binding it
|
||||
= Irrefutable it it -- (Pattern) (Expr)
|
||||
| Function Bool it [it] it it -- (Name) [VarDecl] (Type) (Expr)
|
||||
| Var it it it -- (Name) (Type) (Expr)
|
||||
| Const it it it -- (Name) (Type) (Expr)
|
||||
= Irrefutable it it -- ^ (Pattern) (Expr)
|
||||
| Function Bool it [it] it it -- ^ (Name) [VarDecl] (Type) (Expr)
|
||||
| Var it it it -- ^ (Name) (Type) (Expr)
|
||||
| Const it it it -- ^ (Name) (Type) (Expr)
|
||||
deriving (Show) via PP (Binding it)
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
|
||||
data VarDecl it
|
||||
= Decl it it it -- (Mutable) (Name) (Type)
|
||||
= Decl it it it -- ^ (Mutable) (Name) (Type)
|
||||
deriving (Show) via PP (VarDecl it)
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
|
||||
@ -58,11 +65,11 @@ data Mutable it
|
||||
|
||||
|
||||
data Type it
|
||||
= TArrow it it -- (Type) (Type)
|
||||
| TRecord [it] -- [TField]
|
||||
| TVar it -- (Name)
|
||||
| TSum [it] -- [Variant]
|
||||
| TProduct [it] -- [Type]
|
||||
= TArrow it it -- ^ (Type) (Type)
|
||||
| TRecord [it] -- ^ [TField]
|
||||
| TVar it -- ^ (Name)
|
||||
| TSum [it] -- ^ [Variant]
|
||||
| TProduct [it] -- ^ [Type]
|
||||
| TApply it [it] -- (Name) [Type]
|
||||
deriving (Show) via PP (Type it)
|
||||
deriving stock (Functor, Foldable, Traversable)
|
||||
@ -320,9 +327,3 @@ instance Pretty1 TField where
|
||||
instance Pretty1 LHS where
|
||||
pp1 = \case
|
||||
LHS qn mi -> qn <> foldMap brackets mi
|
||||
|
||||
type Pascal = Tree
|
||||
[ Name, Path, QualifiedName, Pattern, Constant, FieldAssignment, Assignment
|
||||
, MapBinding, LHS, Alt, Expr, TField, Variant, Type, Mutable, VarDecl, Binding
|
||||
, Declaration, Contract
|
||||
]
|
||||
|
@ -1,5 +1,8 @@
|
||||
|
||||
module Error where
|
||||
module Error
|
||||
( Error(..)
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Text (Text)
|
||||
|
||||
|
@ -1,13 +1,19 @@
|
||||
|
||||
module HasComments where
|
||||
module HasComments
|
||||
( HasComments(..)
|
||||
, c
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import Pretty
|
||||
|
||||
-- | Ability to contain comments.
|
||||
class HasComments c where
|
||||
getComments :: c -> [Text.Text]
|
||||
|
||||
-- | Wrap some @Doc@ with a comment.
|
||||
c :: HasComments i => i -> Doc -> Doc
|
||||
c i d =
|
||||
case getComments i of
|
||||
@ -19,5 +25,6 @@ c i d =
|
||||
then Text.init txt
|
||||
else txt
|
||||
|
||||
-- | Narrator: /But there was none/.
|
||||
instance HasComments () where
|
||||
getComments () = []
|
@ -1,6 +1,10 @@
|
||||
module HasErrors where
|
||||
module HasErrors
|
||||
( HasErrors(..)
|
||||
)
|
||||
where
|
||||
|
||||
import Error
|
||||
|
||||
-- | Ability to contain `Error`s.
|
||||
class HasErrors h where
|
||||
errors :: h -> [Error]
|
||||
|
@ -1,6 +1,10 @@
|
||||
|
||||
module Lattice where
|
||||
module Lattice
|
||||
( Lattice(..)
|
||||
)
|
||||
where
|
||||
|
||||
-- | A range should have this property to be used for navigation.
|
||||
class Lattice l where
|
||||
(?>) :: l -> l -> Bool
|
||||
(<?) :: l -> l -> Bool
|
||||
|
@ -1,7 +1,13 @@
|
||||
|
||||
{-# language StrictData #-}
|
||||
|
||||
module ParseTree where
|
||||
module ParseTree
|
||||
( ParseTree(..)
|
||||
, ParseForest(..)
|
||||
, toParseTree
|
||||
, cutOut
|
||||
)
|
||||
where
|
||||
|
||||
import Data.IORef
|
||||
import qualified Data.Text as Text
|
||||
@ -35,13 +41,8 @@ import Paths_squirrel
|
||||
import Range
|
||||
import Pretty
|
||||
|
||||
-- import Debug.Trace
|
||||
|
||||
foreign import ccall unsafe tree_sitter_PascaLigo :: Ptr Language
|
||||
|
||||
getNodeTypesPath :: IO FilePath
|
||||
getNodeTypesPath = getDataFileName "../pascaligo/src/node-types.json"
|
||||
|
||||
-- | The tree tree-sitter produces.
|
||||
data ParseTree = ParseTree
|
||||
{ ptID :: Int -- ^ Unique number, for fast comparison.
|
||||
|
@ -1,18 +1,12 @@
|
||||
|
||||
{-
|
||||
{- |
|
||||
The thing that can untangle the mess that tree-sitter produced.
|
||||
|
||||
If there be errors, it /will/ be a mess.
|
||||
In presence of serious errors, it /will/ be a mess, anyway.
|
||||
|
||||
The AST you are building must:
|
||||
1) Have first field with type `ASTInfo` in each non-error constructor at each
|
||||
type.
|
||||
2) Have `Error`-only constructor to represent failure and implement `Stubbed`.
|
||||
The AST you are building must be the @Tree@ in each point.
|
||||
|
||||
I recommend parametrising your `AST` with some `info` typevar to be
|
||||
`ASTInfo` in the moment of parsing.
|
||||
|
||||
I also recomment, in your tree-sitter grammar, to add `field("foo", ...)`
|
||||
I recommend, in your tree-sitter grammar, to add `field("foo", ...)`
|
||||
to each sub-rule, that has `$.` in front of it - in a rule, that doesn't
|
||||
start with `_` in its name.
|
||||
|
||||
@ -21,20 +15,21 @@
|
||||
|
||||
Only make rule start with `_` if it is a pure choice.
|
||||
|
||||
('block'
|
||||
...
|
||||
a: <a>
|
||||
...
|
||||
b: <b>
|
||||
...)
|
||||
> ('block'
|
||||
> ...
|
||||
> a: <a>
|
||||
> ...
|
||||
> b: <b>
|
||||
> ...)
|
||||
|
||||
->
|
||||
|
||||
block = do
|
||||
subtree "block" do
|
||||
ctor Block
|
||||
<*> inside "a" a
|
||||
<*> inside "b" b
|
||||
> block = do
|
||||
> subtree "block" do
|
||||
> ranged do
|
||||
> pure Block
|
||||
> <*> inside "a" a
|
||||
> <*> inside "b" b
|
||||
-}
|
||||
|
||||
module Parser
|
||||
@ -220,6 +215,7 @@ die msg = throwError =<< makeError msg
|
||||
die' msg rng = throwError =<< makeError' msg rng
|
||||
complain msg rng = tell . pure =<< makeError' msg rng
|
||||
|
||||
-- | When tree-sitter found something it was unable to process.
|
||||
unexpected :: ParseTree -> Error
|
||||
unexpected ParseTree { ptSource, ptRange } =
|
||||
Expected "not that" ptSource ptRange
|
||||
@ -249,9 +245,11 @@ subtree msg parser = do
|
||||
(<|>) :: Parser a -> Parser a -> Parser a
|
||||
Parser l <|> Parser r = Parser (l `catchError` const r)
|
||||
|
||||
-- | Custom @foldl1 (<|>)@.
|
||||
select :: [Parser a] -> Parser a
|
||||
select = foldl1 (<|>)
|
||||
|
||||
-- | Custom @optionMaybe@.
|
||||
optional :: Parser a -> Parser (Maybe a)
|
||||
optional p = fmap Just p <|> return Nothing
|
||||
|
||||
@ -306,7 +304,7 @@ debugParser parser fin = do
|
||||
putStrLn "Errors:"
|
||||
for_ errs (print . nest 2 . pp)
|
||||
|
||||
-- | Consume next tree if it has give name. Or die.
|
||||
-- | Consume next tree if it has the given name. Or die.
|
||||
token :: Text -> Parser Text
|
||||
token node = do
|
||||
tree@ParseTree {ptName, ptRange, ptSource} <- takeNext node
|
||||
@ -320,7 +318,7 @@ anything = do
|
||||
tree <- takeNext "anything"
|
||||
return $ ptSource tree
|
||||
|
||||
-- | Get range of current tree or forest before the parser was run.
|
||||
-- | Get range of the current tree (or forest) before the parser was run.
|
||||
range :: Parser a -> Parser (a, Range)
|
||||
range parser =
|
||||
get >>= \case
|
||||
@ -381,9 +379,6 @@ notFollowedBy parser = do
|
||||
unless good do
|
||||
die "notFollowedBy"
|
||||
|
||||
stub :: Stubbed a => Error -> a
|
||||
stub = stubbing
|
||||
|
||||
-- | Universal accessor.
|
||||
--
|
||||
-- Usage:
|
||||
@ -428,6 +423,7 @@ instance HasRange ASTInfo where
|
||||
getInfo :: Parser ASTInfo
|
||||
getInfo = ASTInfo <$> currentRange <*> grabComments
|
||||
|
||||
-- | Take the accumulated comments, clean the accumulator.
|
||||
grabComments :: Parser [Text]
|
||||
grabComments = do
|
||||
(st, comms) <- get
|
||||
|
@ -3,7 +3,19 @@
|
||||
-}
|
||||
|
||||
module Pretty
|
||||
( module Pretty
|
||||
( ppToText
|
||||
, PP(..)
|
||||
, Pretty(..)
|
||||
, Pretty1(..)
|
||||
, tuple
|
||||
, list
|
||||
, indent
|
||||
, above
|
||||
, train
|
||||
, block
|
||||
, sepByDot
|
||||
, mb
|
||||
, sparseBlock
|
||||
, module Text.PrettyPrint
|
||||
)
|
||||
where
|
||||
@ -13,6 +25,7 @@ import Data.Text (Text, pack)
|
||||
|
||||
import Text.PrettyPrint hiding ((<>))
|
||||
|
||||
-- | Pretty-print to `Text`. Through `String`. Yep.
|
||||
ppToText :: Pretty a => a -> Text
|
||||
ppToText = pack . show . pp
|
||||
|
||||
@ -26,6 +39,7 @@ instance Pretty a => Show (PP a) where
|
||||
class Pretty p where
|
||||
pp :: p -> Doc
|
||||
|
||||
-- | Pretty-printable `Functors`.
|
||||
class Pretty1 p where
|
||||
pp1 :: p Doc -> Doc
|
||||
|
||||
@ -40,28 +54,40 @@ instance Pretty Text where
|
||||
instance Pretty Doc where
|
||||
pp = id
|
||||
|
||||
-- | Decorate list of stuff as a tuple.
|
||||
tuple :: Pretty p => [p] -> Doc
|
||||
tuple = parens . train ","
|
||||
|
||||
-- | Decorate list of stuff as a list.
|
||||
list :: Pretty p => [p] -> Doc
|
||||
list = brackets . train ";"
|
||||
|
||||
infixr 2 `indent`
|
||||
-- | First argument is a header to an indented second one.
|
||||
indent :: Doc -> Doc -> Doc
|
||||
indent a b = hang a 2 b
|
||||
|
||||
infixr 1 `above`
|
||||
-- | Horisontal composition.
|
||||
above :: Doc -> Doc -> Doc
|
||||
above a b = hang a 0 b
|
||||
|
||||
-- | Pretty print as a sequence with given separator.
|
||||
train :: Pretty p => Doc -> [p] -> Doc
|
||||
train sep = fsep . punctuate sep . map pp
|
||||
|
||||
-- | Pretty print as a vertical block.
|
||||
block :: Pretty p => [p] -> Doc
|
||||
block = vcat . map pp
|
||||
|
||||
-- | For pretty-printing qualified names.
|
||||
sepByDot :: Pretty p => [p] -> Doc
|
||||
sepByDot = cat . map (("." <>) . pp)
|
||||
|
||||
-- | For pretty-printing `Maybe`s.
|
||||
mb :: Pretty a => (Doc -> Doc) -> Maybe a -> Doc
|
||||
mb f = maybe empty (f . pp)
|
||||
|
||||
-- | Pretty print as a vertical with elements separated by newline.
|
||||
sparseBlock :: Pretty a => [a] -> Doc
|
||||
sparseBlock = vcat . punctuate "\n" . map (($$ empty) . pp)
|
@ -1,11 +1,16 @@
|
||||
|
||||
module Range where
|
||||
module Range
|
||||
( Range(..)
|
||||
, HasRange(..)
|
||||
, diffRange
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens
|
||||
|
||||
import Pretty
|
||||
|
||||
-- | A continuous location in text.
|
||||
-- | A continious location in text.
|
||||
data Range = Range
|
||||
{ rStart :: (Int, Int, Int) -- ^ [Start: line, col, byte-offset...
|
||||
, rFinish :: (Int, Int, Int) -- ^ ... End: line, col, byte-offset).
|
||||
@ -21,5 +26,6 @@ instance Pretty Range where
|
||||
brackets do
|
||||
int ll <> ":" <> int lc <> "-" <> int rl <> ":" <> int rc
|
||||
|
||||
-- | Ability to get range out of something.
|
||||
class HasRange a where
|
||||
getRange :: a -> Range
|
@ -1,5 +1,8 @@
|
||||
|
||||
module Stubbed where
|
||||
module Stubbed
|
||||
( Stubbed (..)
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens
|
||||
|
||||
@ -9,20 +12,22 @@ import Error
|
||||
|
||||
-- | For types that have a default replacer with an `Error`.
|
||||
class Stubbed a where
|
||||
stubbing :: Error -> a
|
||||
stub :: Error -> a
|
||||
|
||||
instance Stubbed Text where
|
||||
stubbing = pack . show
|
||||
stub = pack . show
|
||||
|
||||
-- | This is bad, but I had to.
|
||||
--
|
||||
-- TODO: Find a way to remove this instance.
|
||||
-- I probably need a wrapper around '[]'.
|
||||
--
|
||||
-- Or I need a @fields@ parser combinator.
|
||||
--
|
||||
instance Stubbed [a] where
|
||||
stubbing = const []
|
||||
stub = const []
|
||||
|
||||
-- | `Nothing` would be bad default replacer.
|
||||
-- | Is `Just` `.` @stubbing@.
|
||||
instance Stubbed a => Stubbed (Maybe a) where
|
||||
stubbing = Just . stubbing
|
||||
stub = Just . stub
|
||||
|
||||
|
@ -5,9 +5,6 @@ import Control.Applicative
|
||||
|
||||
import Language.Haskell.TH.Syntax (Q)
|
||||
|
||||
instance Semigroup a => Semigroup (Q a) where
|
||||
(<>) = liftA2 (<>)
|
||||
|
||||
instance Monoid a => Monoid (Q a) where
|
||||
mempty = pure mempty
|
||||
instance Semigroup a => Semigroup (Q a) where (<>) = liftA2 (<>)
|
||||
instance Monoid a => Monoid (Q a) where mempty = pure mempty
|
||||
|
||||
|
@ -1,5 +1,12 @@
|
||||
|
||||
module Tree where
|
||||
module Tree
|
||||
( Tree
|
||||
, spineTo
|
||||
, updateTree
|
||||
, mk
|
||||
, infoOf
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Fix
|
||||
import Data.Functor.Compose
|
||||
@ -13,7 +20,12 @@ import Pretty
|
||||
import Error
|
||||
import Stubbed
|
||||
|
||||
-- | Tree is a fixpoint of `Union` @layers@, each equipped with an @info@.
|
||||
-- | A tree, where each layer is one of @layers@ `Functor`s.
|
||||
--
|
||||
-- Is equipped with @info@.
|
||||
--
|
||||
-- Can contain `Error` instead of all the above.
|
||||
--
|
||||
newtype Tree layers info = Tree
|
||||
{ unTree :: Fix (Either Error `Compose` (,) info `Compose` Union layers)
|
||||
}
|
||||
@ -48,7 +60,7 @@ instance {-# OVERLAPS #-}
|
||||
aux (Compose (Left err)) = pp err
|
||||
aux (Compose (Right (Compose (info, fTree)))) = c info $ pp fTree
|
||||
|
||||
-- Return all subtrees that cover the range, ascending in side.
|
||||
-- | Return all subtrees that cover the range, ascending in size.
|
||||
spineTo
|
||||
:: ( Lattice info
|
||||
, Foldable (Union fs)
|
||||
@ -66,7 +78,10 @@ spineTo info = reverse . go . unTree
|
||||
|
||||
go _ = []
|
||||
|
||||
-- | Update the tree in the monad that exports its methods.
|
||||
-- | Update the tree over some monad that exports its methods.
|
||||
--
|
||||
-- For each tree piece, will call `before` and `after` callbacks.
|
||||
--
|
||||
updateTree
|
||||
:: ( UpdateOver m (Union fs) (Tree fs a)
|
||||
, Traversable (Union fs)
|
||||
@ -89,6 +104,7 @@ updateTree act = fmap Tree . go . unTree
|
||||
mk :: (Functor f, Member f fs) => info -> f (Tree fs info) -> Tree fs info
|
||||
mk i fx = Tree $ Fix $ Compose $ Right $ Compose (i, inj $ fmap unTree fx)
|
||||
|
||||
-- | Get info from the tree.
|
||||
infoOf :: Tree fs info -> Maybe info
|
||||
infoOf (Tree (Fix (Compose it))) =
|
||||
either
|
||||
@ -96,7 +112,7 @@ infoOf (Tree (Fix (Compose it))) =
|
||||
(Just . fst . getCompose) it
|
||||
|
||||
instance Stubbed (Tree fs info) where
|
||||
stubbing = Tree . Fix . Compose . Left
|
||||
stub = Tree . Fix . Compose . Left
|
||||
|
||||
instance Foldable (Union fs) => HasErrors (Tree fs info) where
|
||||
errors = go . unTree
|
||||
|
@ -8,17 +8,15 @@ module Union
|
||||
import Update
|
||||
import Pretty
|
||||
|
||||
{-
|
||||
The "one of" datatype.
|
||||
Each `Union fs a` is a `f a`, where `f` is one of `fs`.
|
||||
-}
|
||||
-- | The "one of" datatype.
|
||||
--
|
||||
-- Each @Union fs a@ is a @f a@, where @f@ is one of @fs@`.
|
||||
data Union fs x where
|
||||
Here :: f x -> Union (f : fs) x
|
||||
There :: Union fs x -> Union (f : fs) x
|
||||
|
||||
instance Eq (Union '[] a) where (==) = error "Union.empty"
|
||||
instance Show (Union '[] a) where show = error "Union.empty"
|
||||
|
||||
instance Functor (Union '[]) where fmap = error "Union.empty"
|
||||
instance Foldable (Union '[]) where foldMap = error "Union.empty"
|
||||
instance Traversable (Union '[]) where traverse = error "Union.empty"
|
||||
@ -36,9 +34,7 @@ deriving stock instance (Functor f, Functor (Union fs)) => Functor (
|
||||
deriving stock instance (Foldable f, Foldable (Union fs)) => Foldable (Union (f : fs))
|
||||
deriving stock instance (Traversable f, Traversable (Union fs)) => Traversable (Union (f : fs))
|
||||
|
||||
{-
|
||||
A case over `Union`.
|
||||
-}
|
||||
-- | A case over `Union`.
|
||||
eliminate
|
||||
:: (f x -> a)
|
||||
-> (Union fs x -> a)
|
||||
@ -47,12 +43,10 @@ eliminate here there = \case
|
||||
Here fx -> here fx
|
||||
There rest -> there rest
|
||||
|
||||
{-
|
||||
The `f` functior is in the `fs` list.
|
||||
-}
|
||||
-- | The `f` functior is in the `fs` list.
|
||||
class Member f fs where
|
||||
inj :: f x -> Union fs x -- embed f into some Union
|
||||
proj :: Union fs x -> Maybe (f x) -- check if a Union is actually f
|
||||
inj :: f x -> Union fs x -- ^ embed @f@ into some `Union`
|
||||
proj :: Union fs x -> Maybe (f x) -- ^ check if a `Union` is actually @f@
|
||||
|
||||
instance {-# OVERLAPS #-} Member f (f : fs) where
|
||||
inj = Here
|
||||
|
@ -1,16 +1,17 @@
|
||||
|
||||
module Update where
|
||||
module Update
|
||||
( HasMethods(..)
|
||||
, UpdateOver(..)
|
||||
, skip
|
||||
)
|
||||
where
|
||||
|
||||
{-
|
||||
Abstraction over monad capabilities.
|
||||
-}
|
||||
-- | Abstraction over monad capabilities.
|
||||
class Monad m => HasMethods m where
|
||||
data Methods m :: *
|
||||
method :: Methods m
|
||||
|
||||
{-
|
||||
Given some AST structure, do some stuff before & after it is traversed.
|
||||
-}
|
||||
-- | Update callbacks for a @f a@ while working inside monad @m@.
|
||||
class HasMethods m => UpdateOver m f a where
|
||||
before :: f a -> m ()
|
||||
after :: f a -> m ()
|
||||
@ -18,5 +19,6 @@ class HasMethods m => UpdateOver m f a where
|
||||
before _ = skip
|
||||
after _ = skip
|
||||
|
||||
-- | Do nothing.
|
||||
skip :: Monad m => m ()
|
||||
skip = return ()
|
@ -1,132 +0,0 @@
|
||||
('contract' [1:1 - 4:1]
|
||||
('declaration' [1:1 - 3:25]
|
||||
('fun_decl' [1:1 - 3:25]
|
||||
('open_fun_decl' [1:1 - 3:25]
|
||||
('function' [1:1 - 1:9])
|
||||
('fun_name' [1:10 - 1:14]
|
||||
('ident' [1:10 - 1:14] ('Name' [1:10 - 1:14])))
|
||||
('parameters' [1:15 - 1:35]
|
||||
('(' [1:15 - 1:16])
|
||||
('param_decl' [1:16 - 1:34]
|
||||
('access' [1:16 - 1:21] ('const' [1:16 - 1:21]))
|
||||
('var' [1:22 - 1:23]
|
||||
('ident' [1:22 - 1:23] ('Name' [1:22 - 1:23])))
|
||||
(':' [1:24 - 1:25])
|
||||
('param_type' [1:26 - 1:34]
|
||||
('fun_type' [1:26 - 1:34]
|
||||
('cartesian' [1:26 - 1:34]
|
||||
('core_type' [1:26 - 1:34]
|
||||
('type_name' [1:26 - 1:34]
|
||||
('ident' [1:26 - 1:34] ('Name' [1:26 - 1:34]))))))))
|
||||
(')' [1:34 - 1:35]))
|
||||
(':' [1:36 - 1:37])
|
||||
('type_expr' [1:38 - 1:45]
|
||||
('fun_type' [1:38 - 1:45]
|
||||
('cartesian' [1:38 - 1:45]
|
||||
('core_type' [1:38 - 1:45]
|
||||
('type_name' [1:38 - 1:45]
|
||||
('ident' [1:38 - 1:45] ('Name' [1:38 - 1:45])))))))
|
||||
('is' [1:46 - 1:48])
|
||||
('block' [1:49 - 3:2]
|
||||
('block' [1:49 - 1:54])
|
||||
('{' [1:55 - 1:56])
|
||||
('statement' [2:3 - 2:57]
|
||||
('open_data_decl' [2:3 - 2:57]
|
||||
('open_const_decl' [2:3 - 2:57]
|
||||
('const' [2:3 - 2:8])
|
||||
('var' [2:9 - 2:10] ('ident' [2:9 - 2:10] ('Name' [2:9 - 2:10])))
|
||||
(':' [2:11 - 2:12])
|
||||
('type_expr' [2:13 - 2:28]
|
||||
('fun_type' [2:13 - 2:28]
|
||||
('cartesian' [2:13 - 2:28]
|
||||
('core_type' [2:13 - 2:28]
|
||||
('type_name' [2:13 - 2:21]
|
||||
('ident' [2:13 - 2:21] ('Name' [2:13 - 2:21])))
|
||||
('type_tuple' [2:22 - 2:28]
|
||||
('(' [2:22 - 2:23])
|
||||
('type_expr' [2:23 - 2:27]
|
||||
('fun_type' [2:23 - 2:27]
|
||||
('cartesian' [2:23 - 2:27]
|
||||
('core_type' [2:23 - 2:27]
|
||||
('type_name' [2:23 - 2:27]
|
||||
('ident' [2:23 - 2:27]
|
||||
('Name' [2:23 - 2:27])))))))
|
||||
(')' [2:27 - 2:28]))))))
|
||||
('=' [2:29 - 2:30])
|
||||
('expr' [2:31 - 2:57]
|
||||
('disj_expr' [2:31 - 2:57]
|
||||
('conj_expr' [2:31 - 2:57]
|
||||
('set_membership' [2:31 - 2:57]
|
||||
('comp_expr' [2:31 - 2:57]
|
||||
('cat_expr' [2:31 - 2:57]
|
||||
('cons_expr' [2:31 - 2:57]
|
||||
('add_expr' [2:31 - 2:57]
|
||||
('mult_expr' [2:31 - 2:57]
|
||||
('unary_expr' [2:31 - 2:57]
|
||||
('core_expr' [2:31 - 2:57]
|
||||
('fun_call_or_par_or_projection' [2:31 - 2:57]
|
||||
('fun_call' [2:31 - 2:57]
|
||||
('module_field' [2:31 - 2:53]
|
||||
('module_name' [2:31 - 2:36]
|
||||
('Name_Capital' [2:31 - 2:36]))
|
||||
('.' [2:36 - 2:37])
|
||||
('module_fun' [2:37 - 2:53]
|
||||
('field_name' [2:37 - 2:53]
|
||||
('ident' [2:37 - 2:53]
|
||||
('Name' [2:37 - 2:53])))))
|
||||
('arguments' [2:54 - 2:57]
|
||||
('(' [2:54 - 2:55])
|
||||
('expr' [2:55 - 2:56]
|
||||
('disj_expr' [2:55 - 2:56]
|
||||
('conj_expr' [2:55 - 2:56]
|
||||
('set_membership' [2:55 - 2:56]
|
||||
('comp_expr' [2:55 - 2:56]
|
||||
('cat_expr' [2:55 - 2:56]
|
||||
('cons_expr' [2:55 - 2:56]
|
||||
('add_expr' [2:55 - 2:56]
|
||||
('mult_expr' [2:55 - 2:56]
|
||||
('unary_expr' [2:55 - 2:56]
|
||||
('core_expr' [2:55 - 2:56]
|
||||
('ident' [2:55 - 2:56]
|
||||
('Name' [2:55 - 2:56])))))))))))))
|
||||
(')' [2:56 - 2:57]))))))))))))))))))
|
||||
(';' [2:57 - 2:58])
|
||||
('}' [3:1 - 3:2]))
|
||||
('with' [3:3 - 3:7])
|
||||
('expr' [3:8 - 3:25]
|
||||
('disj_expr' [3:8 - 3:25]
|
||||
('conj_expr' [3:8 - 3:25]
|
||||
('set_membership' [3:8 - 3:25]
|
||||
('comp_expr' [3:8 - 3:25]
|
||||
('cat_expr' [3:8 - 3:25]
|
||||
('cons_expr' [3:8 - 3:25]
|
||||
('add_expr' [3:8 - 3:25]
|
||||
('mult_expr' [3:8 - 3:25]
|
||||
('unary_expr' [3:8 - 3:25]
|
||||
('core_expr' [3:8 - 3:25]
|
||||
('fun_call_or_par_or_projection' [3:8 - 3:25]
|
||||
('fun_call' [3:8 - 3:25]
|
||||
('module_field' [3:8 - 3:21]
|
||||
('module_name' [3:8 - 3:13]
|
||||
('Name_Capital' [3:8 - 3:13]))
|
||||
('.' [3:13 - 3:14])
|
||||
('module_fun' [3:14 - 3:21]
|
||||
('field_name' [3:14 - 3:21]
|
||||
('ident' [3:14 - 3:21]
|
||||
('Name' [3:14 - 3:21])))))
|
||||
('arguments' [3:22 - 3:25]
|
||||
('(' [3:22 - 3:23])
|
||||
('expr' [3:23 - 3:24]
|
||||
('disj_expr' [3:23 - 3:24]
|
||||
('conj_expr' [3:23 - 3:24]
|
||||
('set_membership' [3:23 - 3:24]
|
||||
('comp_expr' [3:23 - 3:24]
|
||||
('cat_expr' [3:23 - 3:24]
|
||||
('cons_expr' [3:23 - 3:24]
|
||||
('add_expr' [3:23 - 3:24]
|
||||
('mult_expr' [3:23 - 3:24]
|
||||
('unary_expr' [3:23 - 3:24]
|
||||
('core_expr' [3:23 - 3:24]
|
||||
('ident' [3:23 - 3:24]
|
||||
('Name' [3:23 - 3:24])))))))))))))
|
||||
(')' [3:24 - 3:25])))))))))))))))))))
|
Loading…
Reference in New Issue
Block a user