Add documentation
This commit is contained in:
parent
95707100c2
commit
f3fbfb49a1
@ -30,6 +30,7 @@ import Range
|
|||||||
import AST hiding (def)
|
import AST hiding (def)
|
||||||
import HasErrors
|
import HasErrors
|
||||||
import Pretty
|
import Pretty
|
||||||
|
import Error
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
@ -1,12 +1,25 @@
|
|||||||
|
|
||||||
{-
|
{- | /The/ scope resolution system.
|
||||||
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.Scope where
|
module AST.Scope
|
||||||
|
( -- * Monad
|
||||||
|
ScopeM
|
||||||
|
, evalScopeM
|
||||||
|
|
||||||
|
-- * Scope
|
||||||
|
, Env(..)
|
||||||
|
, ScopedDecl(..)
|
||||||
|
, Kind(..)
|
||||||
|
|
||||||
|
-- * Methods
|
||||||
|
, enter
|
||||||
|
, leave
|
||||||
|
, define
|
||||||
|
, defType
|
||||||
|
, def
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Lens hiding (Const, List)
|
import Control.Lens hiding (Const, List)
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
@ -1,6 +1,7 @@
|
|||||||
|
|
||||||
{- |
|
{- | The AST and auxillary types along with their pretty-printers.
|
||||||
The AST and auxillary types along with their pretty-printers.
|
|
||||||
|
The comments for fields in types are the type before it was made untyped.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module AST.Types where
|
module AST.Types where
|
||||||
@ -32,7 +33,7 @@ type Pascal = Tree
|
|||||||
]
|
]
|
||||||
|
|
||||||
data Contract it
|
data Contract it
|
||||||
= Contract [it]
|
= Contract [it] -- ^ Declaration
|
||||||
deriving (Show) via PP (Contract it)
|
deriving (Show) via PP (Contract it)
|
||||||
deriving stock (Functor, Foldable, Traversable)
|
deriving stock (Functor, Foldable, Traversable)
|
||||||
|
|
||||||
@ -84,7 +85,7 @@ data TField it
|
|||||||
deriving (Show) via PP (TField it)
|
deriving (Show) via PP (TField it)
|
||||||
deriving stock (Functor, Foldable, Traversable)
|
deriving stock (Functor, Foldable, Traversable)
|
||||||
|
|
||||||
-- | TODO: break onto smaller types? Literals -> Constannt; mapOps; mmove Annots to Decls.
|
-- | TODO: break onto smaller types? Literals -> Constant; mapOps; mmove Annots to Decls.
|
||||||
data Expr it
|
data Expr it
|
||||||
= Let [it] it -- [Declaration] (Expr)
|
= Let [it] it -- [Declaration] (Expr)
|
||||||
| Apply it [it] -- (Expr) [Expr]
|
| Apply it [it] -- (Expr) [Expr]
|
||||||
|
@ -1,22 +1,30 @@
|
|||||||
|
|
||||||
{-# language StrictData #-}
|
{-# language StrictData #-}
|
||||||
|
|
||||||
|
{- | The input tree from TreeSitter. Doesn't have any pointers to any data
|
||||||
|
from actual tree the TS produced and therefore has no usage limitations.
|
||||||
|
|
||||||
|
All datatypes here are strict.
|
||||||
|
-}
|
||||||
|
|
||||||
module ParseTree
|
module ParseTree
|
||||||
( ParseTree(..)
|
( -- * Tree/Forest
|
||||||
|
ParseTree(..)
|
||||||
, ParseForest(..)
|
, ParseForest(..)
|
||||||
|
|
||||||
|
-- * Invoke the TreeSitter and get the tree it outputs
|
||||||
, toParseTree
|
, toParseTree
|
||||||
, cutOut
|
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Traversable (for)
|
import Data.Traversable (for)
|
||||||
import Data.Text.Encoding
|
import Data.Text.Encoding
|
||||||
import Data.Text.Foreign (withCStringLen)
|
import Data.Text.Foreign (withCStringLen)
|
||||||
import qualified Data.ByteString as BS
|
|
||||||
import Data.ByteString (ByteString)
|
|
||||||
|
|
||||||
import TreeSitter.Parser
|
import TreeSitter.Parser
|
||||||
import TreeSitter.Tree
|
import TreeSitter.Tree
|
||||||
@ -78,14 +86,6 @@ instance Pretty ParseForest where
|
|||||||
then nest 2 $ pp tree
|
then nest 2 $ pp tree
|
||||||
else hang (text (Text.unpack field) <> ": ") 2 (pp tree)
|
else hang (text (Text.unpack field) <> ": ") 2 (pp tree)
|
||||||
|
|
||||||
-- | Extract textual representation of given range.
|
|
||||||
cutOut :: Range -> ByteString -> Text
|
|
||||||
cutOut (Range (_, _, s) (_, _, f)) bs =
|
|
||||||
decodeUtf8
|
|
||||||
$ BS.take (f - s)
|
|
||||||
$ BS.drop s
|
|
||||||
bs
|
|
||||||
|
|
||||||
-- | Feed file contents into PascaLIGO grammar recogniser.
|
-- | Feed file contents into PascaLIGO grammar recogniser.
|
||||||
toParseTree :: FilePath -> IO ParseForest
|
toParseTree :: FilePath -> IO ParseForest
|
||||||
toParseTree fin = do
|
toParseTree fin = do
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
|
|
||||||
{- |
|
{- |
|
||||||
The thing that can untangle the mess that tree-sitter produced.
|
The thing that can untangle the mess that TreeSitter produces.
|
||||||
|
|
||||||
In presence of serious errors, it /will/ be a mess, anyway.
|
In presence of serious errors, it /will/ be a mess, anyway.
|
||||||
|
|
||||||
@ -33,24 +33,31 @@
|
|||||||
-}
|
-}
|
||||||
|
|
||||||
module Parser
|
module Parser
|
||||||
( Parser
|
( -- * Parser type
|
||||||
|
Parser
|
||||||
, runParser
|
, runParser
|
||||||
, debugParser
|
, debugParser
|
||||||
|
|
||||||
|
-- * Combinators
|
||||||
, subtree
|
, subtree
|
||||||
, anything
|
, anything
|
||||||
, token
|
, token
|
||||||
, ASTInfo(..)
|
, stubbed
|
||||||
, getInfo
|
, getInfo
|
||||||
, inside
|
, inside
|
||||||
|
|
||||||
|
-- * Replacement for `Alternative`, because reasons
|
||||||
, many
|
, many
|
||||||
, some
|
, some
|
||||||
, (<|>)
|
, (<|>)
|
||||||
, optional
|
, optional
|
||||||
, select
|
, select
|
||||||
|
|
||||||
|
-- * Debug
|
||||||
, dump
|
, dump
|
||||||
, stubbed
|
|
||||||
, Stubbed (..)
|
-- * Comments and ranges
|
||||||
, Error (..)
|
, ASTInfo(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Lens hiding (inside)
|
import Control.Lens hiding (inside)
|
||||||
|
@ -1,12 +1,19 @@
|
|||||||
{-
|
{-
|
||||||
Pretty printer, based on GHC one.
|
Pretty printer, a small extension of GHC `pretty` package.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Pretty
|
module Pretty
|
||||||
( ppToText
|
( -- * Output `Text`
|
||||||
|
ppToText
|
||||||
|
|
||||||
|
-- * `Show` instance generator
|
||||||
, PP(..)
|
, PP(..)
|
||||||
|
|
||||||
|
-- * Interfaces
|
||||||
, Pretty(..)
|
, Pretty(..)
|
||||||
, Pretty1(..)
|
, Pretty1(..)
|
||||||
|
|
||||||
|
-- * Helpers
|
||||||
, tuple
|
, tuple
|
||||||
, list
|
, list
|
||||||
, indent
|
, indent
|
||||||
@ -16,6 +23,8 @@ module Pretty
|
|||||||
, sepByDot
|
, sepByDot
|
||||||
, mb
|
, mb
|
||||||
, sparseBlock
|
, sparseBlock
|
||||||
|
|
||||||
|
-- * Full might of pretty printing
|
||||||
, module Text.PrettyPrint
|
, module Text.PrettyPrint
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -3,11 +3,17 @@ module Range
|
|||||||
( Range(..)
|
( Range(..)
|
||||||
, HasRange(..)
|
, HasRange(..)
|
||||||
, diffRange
|
, diffRange
|
||||||
|
, cutOut
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Text.Encoding
|
||||||
|
|
||||||
import Pretty
|
import Pretty
|
||||||
|
|
||||||
-- | A continious location in text.
|
-- | A continious location in text.
|
||||||
@ -29,3 +35,12 @@ instance Pretty Range where
|
|||||||
-- | Ability to get range out of something.
|
-- | Ability to get range out of something.
|
||||||
class HasRange a where
|
class HasRange a where
|
||||||
getRange :: a -> Range
|
getRange :: a -> Range
|
||||||
|
|
||||||
|
-- | Extract textual representation of given range.
|
||||||
|
cutOut :: Range -> ByteString -> Text
|
||||||
|
cutOut (Range (_, _, s) (_, _, f)) bs =
|
||||||
|
decodeUtf8
|
||||||
|
$ BS.take (f - s)
|
||||||
|
$ BS.drop s
|
||||||
|
bs
|
||||||
|
|
||||||
|
@ -1,4 +1,14 @@
|
|||||||
|
|
||||||
|
{- | The carrier type for AST.
|
||||||
|
|
||||||
|
"Untypedness" of the tree is a payoff to ablity to stop and navigate
|
||||||
|
anywhere, not just inside the expression context.
|
||||||
|
|
||||||
|
Is a `Functor` and `Foldable` over its @info@ parameter.
|
||||||
|
Is not `Traversable`, because this will definitely not preserve scope.
|
||||||
|
Use `updateTree` instead of `traverse`/`for`.
|
||||||
|
-}
|
||||||
|
|
||||||
module Tree
|
module Tree
|
||||||
( Tree
|
( Tree
|
||||||
, spineTo
|
, spineTo
|
||||||
@ -10,6 +20,7 @@ module Tree
|
|||||||
|
|
||||||
import Data.Fix
|
import Data.Fix
|
||||||
import Data.Functor.Compose
|
import Data.Functor.Compose
|
||||||
|
import Data.Foldable
|
||||||
|
|
||||||
import Union
|
import Union
|
||||||
import Update
|
import Update
|
||||||
@ -37,6 +48,12 @@ instance (Functor (Union layers)) => Functor (Tree layers) where
|
|||||||
go (Compose (Right (Compose (a, rest)))) =
|
go (Compose (Right (Compose (a, rest)))) =
|
||||||
Compose $ Right $ Compose (f a, rest)
|
Compose $ Right $ Compose (f a, rest)
|
||||||
|
|
||||||
|
instance (Functor (Union layers), Foldable (Union layers)) => Foldable (Tree layers) where
|
||||||
|
foldMap f (Tree fixpoint) = cata go fixpoint
|
||||||
|
where
|
||||||
|
go (Compose (Left err)) = mempty
|
||||||
|
go (Compose (Right (Compose (a, rest)))) = f a <> fold rest
|
||||||
|
|
||||||
instance
|
instance
|
||||||
( Functor (Union layers)
|
( Functor (Union layers)
|
||||||
, HasComments info
|
, HasComments info
|
||||||
@ -71,14 +88,13 @@ spineTo
|
|||||||
spineTo info = reverse . go . unTree
|
spineTo info = reverse . go . unTree
|
||||||
where
|
where
|
||||||
go tree@(Fix (Compose (Right (Compose (info', fres))))) =
|
go tree@(Fix (Compose (Right (Compose (info', fres))))) =
|
||||||
-- traceShow (info <? info', info, info') $
|
|
||||||
if info <? info'
|
if info <? info'
|
||||||
then Tree tree : foldMap go fres
|
then Tree tree : foldMap go fres
|
||||||
else []
|
else []
|
||||||
|
|
||||||
go _ = []
|
go _ = []
|
||||||
|
|
||||||
-- | Update the tree over some monad that exports its methods.
|
-- | Traverse the tree over some monad that exports its methods.
|
||||||
--
|
--
|
||||||
-- For each tree piece, will call `before` and `after` callbacks.
|
-- For each tree piece, will call `before` and `after` callbacks.
|
||||||
--
|
--
|
||||||
@ -86,8 +102,7 @@ updateTree
|
|||||||
:: ( UpdateOver m (Union fs) (Tree fs a)
|
:: ( UpdateOver m (Union fs) (Tree fs a)
|
||||||
, Traversable (Union fs)
|
, Traversable (Union fs)
|
||||||
)
|
)
|
||||||
=> (a -> m b)
|
=> (a -> m b) -> Tree fs a -> m (Tree fs b)
|
||||||
-> Tree fs a -> m (Tree fs b)
|
|
||||||
updateTree act = fmap Tree . go . unTree
|
updateTree act = fmap Tree . go . unTree
|
||||||
where
|
where
|
||||||
go (Fix (Compose (Right (Compose (a, union))))) = do
|
go (Fix (Compose (Right (Compose (a, union))))) = do
|
||||||
|
@ -1,7 +1,17 @@
|
|||||||
|
|
||||||
|
{- | The union of functors and utilities.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
module Union
|
module Union
|
||||||
( Union(..), eliminate
|
( -- * Union type
|
||||||
, Member, proj, inj
|
Union(..)
|
||||||
|
, eliminate
|
||||||
|
|
||||||
|
-- * Interface
|
||||||
|
, Member
|
||||||
|
, proj
|
||||||
|
, inj
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -1,7 +1,13 @@
|
|||||||
|
|
||||||
|
{- | Utils for updating the @Tree@ type.
|
||||||
|
-}
|
||||||
|
|
||||||
module Update
|
module Update
|
||||||
( HasMethods(..)
|
( -- * Interfaces
|
||||||
|
HasMethods(..)
|
||||||
, UpdateOver(..)
|
, UpdateOver(..)
|
||||||
|
|
||||||
|
-- * Default implementation
|
||||||
, skip
|
, skip
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
Loading…
Reference in New Issue
Block a user