Add some more documentation

This commit is contained in:
Kirill Andreev 2020-05-08 01:18:26 +04:00
parent eace901195
commit b62cd58add
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
5 changed files with 75 additions and 19 deletions

View File

@ -1,4 +1,12 @@
{-
Parser for a contract. The `example` is exported to run on current debug target.
TODO: prune some "path" and alike stuff from grammar, refactor common things.
TODO: break <*>/do ladders onto separate named parsers.
-}
module AST.Parser (example, contract) where
import Data.Text (Text)
@ -10,12 +18,6 @@ import Range
import Debug.Trace
name :: Parser (Name ASTInfo)
name = ctor Name <*> token "Name"
capitalName :: Parser (Name ASTInfo)
capitalName = ctor Name <*> token "Name_Capital"
contract :: Parser (Contract ASTInfo)
contract =
ctor Contract
@ -24,6 +26,12 @@ contract =
inside "declaration:" do
declaration
name :: Parser (Name ASTInfo)
name = ctor Name <*> token "Name"
capitalName :: Parser (Name ASTInfo)
capitalName = ctor Name <*> token "Name_Capital"
declaration :: Parser (Declaration ASTInfo)
declaration
= do ctor ValueDecl <*> binding
@ -83,7 +91,8 @@ recursive = do
expr :: Parser (Expr ASTInfo)
expr = stubbed "expr" do
select
[ ctor Ident <*> do
[ -- Wait, isn't it `qname`? TODO: replace.
ctor Ident <*> do
ctor QualifiedName
<*> name
<*> pure []
@ -265,13 +274,7 @@ pattern = do
core_pattern :: Parser (Pattern ASTInfo)
core_pattern
= -- int_pattern
-- <|> nat_pattern
-- <|> var_pattern
-- <|> list_pattern
-- <|> tuple_pattern
-- <|>
constr_pattern
= constr_pattern
<|> string_pattern
<|> int_pattern
<|> nat_pattern

View File

@ -1,5 +1,10 @@
{- TODO(kirill.andreev): add offsets to ranges, store verbatim in Wrong* -}
{-
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
@ -15,8 +20,6 @@ import Pretty
import Debug.Trace
type TODO = Text
data Contract info
= Contract info [Declaration info]
| WrongContract Error
@ -86,6 +89,7 @@ data TField info
instance Stubbed (TField info) where stub = WrongTField
-- | TODO: break onto smaller types? Literals -> Constannt; mapOps; mmove Annots to Decls.
data Expr info
= Let info [Declaration info] (Expr info)
| Apply info (Expr info) [Expr info]
@ -295,6 +299,7 @@ instance Pretty (Variant i) where
Variant _ ctor _ -> "|" <+> pp ctor
WrongVariant err -> pp err
-- My eyes.
instance Pretty (Expr i) where
pp = \case
Let _ decls body -> "block {" $$ (nest 2 $ vcat $ punctuate "\n" $ map pp decls) $$ "}" $$ "with" $$ nest 2 (pp body)
@ -396,5 +401,6 @@ instance Pretty (LHS i) where
LHS _ qn mi -> pp qn <> foldMap (brackets . pp) mi
WrongLHS err -> pp err
-- TODO: Use it, make more alike.
tuple :: Pretty p => [p] -> Doc
tuple xs = parens (fsep $ punctuate "," $ map pp xs)

View File

@ -1,4 +1,42 @@
{-
The thing that can untangle the mess that tree-sitter produced.
If there be errors, it /will/ be a mess.
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`.
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", ...)`
to each sub-rule, that has `$.` in front of it - in a rule, that doesn't
start with `_` in its name.
As a general rule of thumb, make each significant part a separate rule,
even if it is a keyword. Then, apply previous advice.
Only make rule start with `_` if it is a pure choice.
('block'
...
a: <a>
...
b: <b>
...)
->
block = do
subtree "block" do
ctor Block
<*> inside "a" a
<*> inside "b" b
-}
module Parser (module Parser, gets, pfGrove) where
import Control.Monad.State

View File

@ -1,3 +1,6 @@
{-
Pretty printer, based on GHC one.
-}
module Pretty
( module Pretty
@ -9,15 +12,19 @@ import Data.Text
import Text.PrettyPrint hiding ((<>))
-- | With this, one can `data X = ...; derive Show via PP X`
newtype PP a = PP { unPP :: a }
instance Pretty a => Show (PP a) where
show = show . pp . unPP
-- | Pretty-printable types.
class Pretty p where
pp :: p -> Doc
-- | Common instance.
instance Pretty Text where
pp = text . unpack
-- | TODO: tuple, not list; actually /use/ it.
wrap [l, r] a = hang (hang l 2 r) 0 r

View File

@ -3,12 +3,14 @@ module Range where
import Pretty
-- | A continuous location in text.
data Range = Range
{ rStart :: (Int, Int, Int)
, rFinish :: (Int, Int, Int)
{ rStart :: (Int, Int, Int) -- ^ [Start: line, col, byte-offset...
, rFinish :: (Int, Int, Int) -- ^ ... End: line, col, byte-offset).
}
deriving (Show) via PP Range
-- | TODO: Ugh. Purge it.
diffRange :: Range -> Range -> Range
diffRange (Range ws wf) (Range ps _) = Range (max ws ps) wf