balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Rename debounced -> unsafeDebounce

Browse Source
This commit is contained in:
Kirill Andreev 2020-08-14 15:49:42 +04:00
parent fe929fbe70
commit 26d11eea19
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
2 changed files with 64 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
tools/lsp/squirrel/src/Debouncer.hs
View File

@ -1,5 +1,5 @@
module Debouncer (debounced) where
module Debouncer (unsafeDebounce) where
import Control.Monad.Catch
import Control.Monad
@ -9,14 +9,14 @@ import System.IO.Unsafe
-- | Ensure the function is run in single thread, w/o overlapping.
--
-- If called concurently, everyone will get results of the winner.
-- If called concurently, everyone will get result of the winner.
--
-- If called, waits for next result to arrive.
--
-- If function throws an error, will rethrow it in caller thread.
--
debounced :: forall s r. (s -> IO r) -> (s -> IO r)
debounced act = unsafePerformIO do
unsafeDebounce :: forall s r. (s -> IO r) -> (s -> IO r)
unsafeDebounce act = unsafePerformIO do
i <- newEmptyMVar
o <- newEmptyMVar
@ -34,7 +34,7 @@ debounced act = unsafePerformIO do
readMVar o >>= either throwM return
_test :: [Int] -> IO Int
_test = debounced \s -> do
_test = unsafeDebounce \s -> do
threadDelay 2000000
unless (odd (length s)) do
error "even"

120
tools/lsp/squirrel/src/ParseTree.hs
View File

@ -50,7 +50,7 @@ import Range
foreign import ccall unsafe tree_sitter_PascaLigo :: Ptr Language
foreign import ccall unsafe tree_sitter_ReasonLigo :: Ptr Language
foreign import ccall unsafe tree_sitter_CamlLigo :: Ptr Language
foreign import ccall unsafe tree_sitter_CameLigo :: Ptr Language
data Source
= Path { srcPath :: FilePath }
@ -105,70 +105,68 @@ instance Pretty1 ParseTree where
-- | Feed file contents into PascaLIGO grammar recogniser.
toParseTree :: Source -> IO RawTree
toParseTree = debounced inner
toParseTree = unsafeDebounce \fin -> do
language <- onExt ElimExt
{ eePascal = tree_sitter_PascaLigo
, eeCaml = tree_sitter_CameLigo
, eeReason = tree_sitter_ReasonLigo
} (srcPath fin)
parser <- ts_parser_new
-- True <- ts_parser_set_language parser tree_sitter_PascaLigo
True <- ts_parser_set_language parser language
src <- srcToBytestring fin
BS.useAsCStringLen src \(str, len) -> do
tree <- ts_parser_parse_string parser nullPtr str len
withRootNode tree (peek >=> go fin src)
where
inner fin = do
language <- onExt ElimExt
{ eePascal = tree_sitter_PascaLigo
, eeCaml = tree_sitter_CamlLigo
, eeReason = tree_sitter_ReasonLigo
} (srcPath fin)
go :: Source -> ByteString -> Node -> IO RawTree
go fin src node = do
let count = fromIntegral $ nodeChildCount node
allocaArray count $ \children -> do
alloca $ \tsNodePtr -> do
poke tsNodePtr $ nodeTSNode node
ts_node_copy_child_nodes tsNodePtr children
nodes <- for [0.. count - 1] $ \i -> do
peekElemOff children i
parser <- ts_parser_new
-- True <- ts_parser_set_language parser tree_sitter_PascaLigo
True <- ts_parser_set_language parser language
trees <- for nodes \node' -> do
(only -> (r :> _, tree :: ParseTree RawTree)) <- go fin src node'
field <-
if nodeFieldName node' == nullPtr
then return ""
else peekCString $ nodeFieldName node'
return $ make (r :> Text.pack field :> Nil, tree)
src <- srcToBytestring fin
ty <- peekCString $ nodeType node
BS.useAsCStringLen src \(str, len) -> do
tree <- ts_parser_parse_string parser nullPtr str len
withRootNode tree (peek >=> go src)
let
start2D = nodeStartPoint node
finish2D = nodeEndPoint node
i = fromIntegral
where
go :: ByteString -> Node -> IO RawTree
go src node = do
let count = fromIntegral $ nodeChildCount node
allocaArray count $ \children -> do
alloca $ \tsNodePtr -> do
poke tsNodePtr $ nodeTSNode node
ts_node_copy_child_nodes tsNodePtr children
nodes <- for [0.. count - 1] $ \i -> do
peekElemOff children i
let
range = Range
{ rStart =
( i $ pointRow start2D + 1
, i $ pointColumn start2D + 1
, i $ nodeStartByte node
)
trees <- for nodes \node' -> do
(only -> (r :> _, tree :: ParseTree RawTree)) <- go src node'
field <-
if nodeFieldName node' == nullPtr
then return ""
else peekCString $ nodeFieldName node'
return $ make (r :> Text.pack field :> Nil, tree)
, rFinish =
( i $ pointRow finish2D + 1
, i $ pointColumn finish2D + 1
, i $ nodeEndByte node
)
, rFile = takeFileName $ srcPath fin
}
ty <- peekCString $ nodeType node
let
start2D = nodeStartPoint node
finish2D = nodeEndPoint node
i = fromIntegral
let
range = Range
{ rStart =
( i $ pointRow start2D + 1
, i $ pointColumn start2D + 1
, i $ nodeStartByte node
)
, rFinish =
( i $ pointRow finish2D + 1
, i $ pointColumn finish2D + 1
, i $ nodeEndByte node
)
, rFile = takeFileName $ srcPath fin
}
return $ make (range :> "" :> Nil, ParseTree
{ ptName = Text.pack ty
-- , ptChildren = fromList . fmap (Comment,) $ trees -- TODO
, ptChildren = trees
, ptSource = cutOut range src
})
return $ make (range :> "" :> Nil, ParseTree
{ ptName = Text.pack ty
-- , ptChildren = fromList . fmap (Comment,) $ trees -- TODO
, ptChildren = trees
, ptSource = cutOut range src
})