From b62cd58add12c93461e8261073d21bfefec0f14c Mon Sep 17 00:00:00 2001 From: Kirill Andreev Date: Fri, 8 May 2020 01:18:26 +0400 Subject: [PATCH] Add some more documentation --- tools/lsp/squirrel/src/AST/Parser.hs | 31 +++++++++++++---------- tools/lsp/squirrel/src/AST/Types.hs | 12 ++++++--- tools/lsp/squirrel/src/Parser.hs | 38 ++++++++++++++++++++++++++++ tools/lsp/squirrel/src/Pretty.hs | 7 +++++ tools/lsp/squirrel/src/Range.hs | 6 +++-- 5 files changed, 75 insertions(+), 19 deletions(-) diff --git a/tools/lsp/squirrel/src/AST/Parser.hs b/tools/lsp/squirrel/src/AST/Parser.hs index 336280d58..8787f166d 100644 --- a/tools/lsp/squirrel/src/AST/Parser.hs +++ b/tools/lsp/squirrel/src/AST/Parser.hs @@ -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 diff --git a/tools/lsp/squirrel/src/AST/Types.hs b/tools/lsp/squirrel/src/AST/Types.hs index e28d35a47..5569831b8 100644 --- a/tools/lsp/squirrel/src/AST/Types.hs +++ b/tools/lsp/squirrel/src/AST/Types.hs @@ -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) \ No newline at end of file diff --git a/tools/lsp/squirrel/src/Parser.hs b/tools/lsp/squirrel/src/Parser.hs index 65c03f00f..638db73c7 100644 --- a/tools/lsp/squirrel/src/Parser.hs +++ b/tools/lsp/squirrel/src/Parser.hs @@ -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: + ... + 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 diff --git a/tools/lsp/squirrel/src/Pretty.hs b/tools/lsp/squirrel/src/Pretty.hs index 888980a5e..c48c27c13 100644 --- a/tools/lsp/squirrel/src/Pretty.hs +++ b/tools/lsp/squirrel/src/Pretty.hs @@ -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 \ No newline at end of file diff --git a/tools/lsp/squirrel/src/Range.hs b/tools/lsp/squirrel/src/Range.hs index 0301112cf..beadaf383 100644 --- a/tools/lsp/squirrel/src/Range.hs +++ b/tools/lsp/squirrel/src/Range.hs @@ -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