diff --git a/tools/lsp/squirrel/src/AST/Parser.hs b/tools/lsp/squirrel/src/AST/Parser.hs index e0e1d47c2..c92f07a8d 100644 --- a/tools/lsp/squirrel/src/AST/Parser.hs +++ b/tools/lsp/squirrel/src/AST/Parser.hs @@ -614,13 +614,13 @@ paramDecl :: Parser (VarDecl ASTInfo) paramDecl = do subtree "param_decl" do ctor Decl - <*> do inside ":access" do - select - [ ctor Mutable <* consumeOrDie "var" - , ctor Immutable <* consumeOrDie "const" - ] - <*> inside "name" name - <*> inside "type" type_ + <*> inside "access" do + ctor access' <*> anything + <*> inside "name" name + <*> inside "type" type_ + where + access' r "var" = Mutable r + access' r "const" = Immutable r newtype_ = select [ record_type @@ -716,8 +716,8 @@ typeTuple = do -- example = "../../../src/test/contracts/bytes_unpack.ligo" -- example = "../../../src/test/contracts/chain_id.ligo" -- example = "../../../src/test/contracts/coase.ligo" -example = "../../../src/test/contracts/failwith.ligo" --- example = "../../../src/test/contracts/application.ligo" +-- example = "../../../src/test/contracts/failwith.ligo" +example = "../../../src/test/contracts/loop.ligo" -- example = "../../../src/test/contracts/application.ligo" -- example = "../../../src/test/contracts/application.ligo" -- example = "../../../src/test/contracts/application.ligo" diff --git a/tools/lsp/squirrel/src/ParseTree.hs b/tools/lsp/squirrel/src/ParseTree.hs index 9e29cd250..00576b7a4 100644 --- a/tools/lsp/squirrel/src/ParseTree.hs +++ b/tools/lsp/squirrel/src/ParseTree.hs @@ -1,13 +1,16 @@ -{-# language Strict #-} +{-# language StrictData #-} module ParseTree where import Data.IORef import qualified Data.Text as Text +import Data.Text (Text) import Data.Traversable (for) +import Data.Text.Encoding import Data.Text.Foreign (withCStringLen) -import Data.Text.IO as IO +import qualified Data.ByteString as BS +import Data.ByteString (ByteString) import TreeSitter.Parser import TreeSitter.Tree @@ -42,22 +45,23 @@ getNodeTypesPath = getDataFileName "../pascaligo/src/node-types.json" -- | The tree tree-sitter produces. data ParseTree = ParseTree { ptID :: Int -- ^ Unique number, for fast comparison. - , ptName :: Text.Text -- ^ Name of the node. + , ptName :: Text -- ^ Name of the node. , ptRange :: Range -- ^ Range of the node. + , ptSource :: ~Text -- ^ Range of the node. , ptChildren :: ParseForest -- ^ Subtrees. } deriving (Show) via PP ParseTree -- ^ The forest we work with. data ParseForest = Forest - { pfID :: Int -- ^ Unique number for comparison. - , pfGrove :: [(Text.Text, ParseTree)] -- ^ Subtrees. - , pfRange :: Range -- ^ Full range of the forest. + { pfID :: Int -- ^ Unique number for comparison. + , pfGrove :: [(Text, ParseTree)] -- ^ Subtrees. + , pfRange :: Range -- ^ Full range of the forest. } deriving (Show) via PP ParseForest instance Pretty ParseTree where - pp (ParseTree _ n r forest) = + pp (ParseTree _ n r forest _) = parens ( hang (quotes (text (Text.unpack n)) <+> pp r) @@ -73,19 +77,27 @@ instance Pretty ParseForest where then nest 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. toParseTree :: FilePath -> IO ParseForest toParseTree fin = do parser <- ts_parser_new True <- ts_parser_set_language parser tree_sitter_PascaLigo - src <- IO.readFile fin + src <- BS.readFile fin idCounter <- newIORef 0 - withCStringLen src \(str, len) -> do + BS.useAsCStringLen src \(str, len) -> do tree <- ts_parser_parse_string parser nullPtr str len - finalTree <- withRootNode tree (peek >=> go idCounter) + finalTree <- withRootNode tree (peek >=> go src idCounter) return $ Forest 0 [("", finalTree)] (ptRange finalTree) where @@ -94,8 +106,8 @@ toParseTree fin = do modifyIORef' ref (+ 1) readIORef ref - go :: IORef Int -> Node -> IO ParseTree - go idCounter node = do + go :: ByteString -> IORef Int -> Node -> IO ParseTree + go src idCounter node = do let count = fromIntegral $ nodeChildCount node allocaArray count \children -> do alloca \tsNodePtr -> do @@ -105,7 +117,7 @@ toParseTree fin = do peekElemOff children i trees <- for nodes \node' -> do - tree <- go idCounter node' + tree <- go src idCounter node' field <- if nodeFieldName node' == nullPtr then return "" @@ -142,4 +154,5 @@ toParseTree fin = do , ptName = Text.pack ty , ptRange = range , ptChildren = Forest fID trees range + , ptSource = cutOut range src } \ No newline at end of file diff --git a/tools/lsp/squirrel/src/Parser.hs b/tools/lsp/squirrel/src/Parser.hs index dff4fb4f0..bbf67aa51 100644 --- a/tools/lsp/squirrel/src/Parser.hs +++ b/tools/lsp/squirrel/src/Parser.hs @@ -46,7 +46,7 @@ import Control.Monad.Except import Control.Monad.Identity import Data.Foldable -import Data.Text.Encoding +import Data.Functor import Data.Text (Text, pack, unpack) import qualified Data.Text as Text @@ -75,10 +75,9 @@ instance Pretty Error where newtype Parser a = Parser { unParser :: WriterT [Error] -- Early I though to report errors that way. - ( ReaderT ParserEnv -- Range/Something. ( StateT ParseForest -- Current forest to recognise. ( ExceptT Error -- Backtracking. Change `Error` to `()`? - ( Identity )))) -- I forgot why. `#include`? Debug via `print`? + ( Identity ))) -- I forgot why. `#include`? Debug via `print`? a } deriving newtype @@ -87,7 +86,6 @@ newtype Parser a = Parser , Monad , MonadState ParseForest , MonadWriter [Error] - , MonadReader ParserEnv , MonadError Error ) @@ -101,7 +99,9 @@ makeError msg = do makeError' :: Text -> Range -> Parser Error makeError' msg rng = do rng <- getRange - src <- cutOut rng + src <- gets pfGrove <&> \case + [] -> "" + (,) _ ParseTree { ptSource } : _ -> ptSource return Expected { eMsg = msg , eWhole = src @@ -148,11 +148,15 @@ field name parser = do , pfRange = ptRange } - parser <* put st + res <- parser + + put st { pfGrove = grove' , pfRange = if firstOne then diffRange rng ptRange else rng } + return res + -- | Variuos error reports. fallback :: Stubbed a => Text -> Parser a fallback' :: Stubbed a => Text -> Range -> Parser a @@ -215,19 +219,6 @@ some p = some' xs <- many' return (x : xs) --- | The source of file being parsed. BS, because tree-sitter has offsets --- in /bytes/. -data ParserEnv = ParserEnv - { peSource :: ByteString - } - --- | Debug print via IO. Obsolete. --- --- TODO: remove. Also, remove IO from Parser tf stack. --- -puts :: MonadIO m => Show a => a -> m () -puts = liftIO . print - -- | Run parser on given file. -- -- TODO: invent /proper/ 'ERROR'-node collector. @@ -235,13 +226,11 @@ puts = liftIO . print runParser :: Parser a -> FilePath -> IO (a, [Error]) runParser (Parser parser) fin = do pforest <- toParseTree fin - text <- ByteString.readFile fin let res = runIdentity $ runExceptT $ flip runStateT pforest - $ flip runReaderT (ParserEnv text) $ runWriterT $ parser @@ -260,39 +249,16 @@ debugParser parser fin = do -- | Consume next tree if it has give name. Or die. token :: Text -> Parser Text token node = do - tree@ParseTree {ptName, ptRange} <- takeNext node + tree@ParseTree {ptName, ptRange, ptSource} <- takeNext node if ptName == node - then do - cutOut ptRange - - else do - die' node ptRange + then return ptSource + else die' node ptRange -- | Consume next tree, return its textual representation. anything :: Parser Text anything = do tree <- takeNext "anything" - cutOut $ ptRange tree - --- | TODO: remove, b/c obsolete. -consume :: Text -> Parser () -consume node = do - ParseTree {ptName, ptRange} <- takeNext node - when (ptName /= node) do - complain node ptRange - --- | TODO: remove, its literally is `void . token`. -consumeOrDie :: Text -> Parser () -consumeOrDie node = do - ParseTree {ptName, ptRange} <- takeNext node - when (ptName /= node) do - die' node ptRange - --- | Extract textual representation of given range. -cutOut :: Range -> Parser Text -cutOut (Range (_, _, s) (_, _, f)) = do - bs <- asks peSource - return $ decodeUtf8 $ ByteString.take (f - s) (ByteString.drop s bs) + return $ ptSource tree -- | Get range of current tree or forest before the parser was run. range :: Parser a -> Parser (a, Range)