Link camligo grammar, get rid of personal loaders
This commit is contained in:
parent
ba66f6e8e4
commit
fe929fbe70
@ -63,6 +63,7 @@ library:
|
|||||||
c-sources:
|
c-sources:
|
||||||
- vendor/pascaligo/parser.c
|
- vendor/pascaligo/parser.c
|
||||||
- vendor/reasonligo/parser.c
|
- vendor/reasonligo/parser.c
|
||||||
|
- vendor/camligo/parser.c
|
||||||
|
|
||||||
executables:
|
executables:
|
||||||
squirrel:
|
squirrel:
|
||||||
|
16
tools/lsp/squirrel/src/AST/Camligo/Parser.hs
Normal file
16
tools/lsp/squirrel/src/AST/Camligo/Parser.hs
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
|
||||||
|
module AST.Camligo.Parser where
|
||||||
|
|
||||||
|
import Data.Maybe (isJust)
|
||||||
|
|
||||||
|
import AST.Skeleton
|
||||||
|
|
||||||
|
import Duplo.Error
|
||||||
|
import Duplo.Tree
|
||||||
|
import Duplo.Pretty
|
||||||
|
|
||||||
|
import Product
|
||||||
|
import Parser
|
||||||
|
import ParseTree
|
||||||
|
|
||||||
|
-- import Debug.Trace
|
@ -4,24 +4,19 @@ module AST.Parser
|
|||||||
, parse
|
, parse
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Catch
|
|
||||||
|
|
||||||
import System.FilePath
|
|
||||||
|
|
||||||
import qualified AST.Pascaligo.Parser as Pascal
|
import qualified AST.Pascaligo.Parser as Pascal
|
||||||
import qualified AST.Reasonligo.Parser as Reason
|
import qualified AST.Reasonligo.Parser as Reason
|
||||||
import AST.Skeleton
|
import AST.Skeleton
|
||||||
|
|
||||||
import ParseTree
|
import ParseTree
|
||||||
import Parser
|
import Parser
|
||||||
|
import Extension
|
||||||
data UnsupportedExtension = UnsupportedExtension String
|
|
||||||
deriving stock Show
|
|
||||||
deriving anyclass Exception
|
|
||||||
|
|
||||||
parse :: Source -> IO (LIGO Info, [Msg])
|
parse :: Source -> IO (LIGO Info, [Msg])
|
||||||
parse src = do
|
parse src = do
|
||||||
case takeExtension $ srcPath src of
|
recogniser <- onExt ElimExt
|
||||||
"religo" -> mkRawTreeReason src >>= runParserM . Reason.recognise
|
{ eePascal = Pascal.recognise
|
||||||
"ligo" -> mkRawTreePascal src >>= runParserM . Pascal.recognise
|
, eeCaml = error "TODO: caml recogniser"
|
||||||
ext -> throwM $ UnsupportedExtension ext
|
, eeReason = Reason.recognise
|
||||||
|
} (srcPath src)
|
||||||
|
toParseTree src >>= runParserM . recogniser
|
||||||
|
@ -40,24 +40,24 @@ example = "../../../src/test/contracts/coase.ligo"
|
|||||||
|
|
||||||
sample' :: FilePath -> IO (LIGO Info)
|
sample' :: FilePath -> IO (LIGO Info)
|
||||||
sample' f
|
sample' f
|
||||||
= mkRawTreePascal (Path f)
|
= toParseTree (Path f)
|
||||||
>>= runParserM . recognise
|
>>= runParserM . recognise
|
||||||
>>= return . fst
|
>>= return . fst
|
||||||
|
|
||||||
source' :: FilePath -> IO ()
|
source' :: FilePath -> IO ()
|
||||||
source' f
|
source' f
|
||||||
= mkRawTreePascal (Path f)
|
= toParseTree (Path f)
|
||||||
>>= print . pp
|
>>= print . pp
|
||||||
|
|
||||||
sample :: IO ()
|
sample :: IO ()
|
||||||
sample
|
sample
|
||||||
= mkRawTreePascal (Path example)
|
= toParseTree (Path example)
|
||||||
>>= runParserM . recognise
|
>>= runParserM . recognise
|
||||||
>>= print . pp . fst
|
>>= print . pp . fst
|
||||||
|
|
||||||
source :: IO ()
|
source :: IO ()
|
||||||
source
|
source
|
||||||
= mkRawTreePascal (Path example)
|
= toParseTree (Path example)
|
||||||
>>= print . pp
|
>>= print . pp
|
||||||
|
|
||||||
recognise :: RawTree -> ParserM (LIGO Info)
|
recognise :: RawTree -> ParserM (LIGO Info)
|
||||||
|
@ -35,13 +35,13 @@ example = "./contracts/multisig.religo"
|
|||||||
-- example = "./contracts/letin.religo"
|
-- example = "./contracts/letin.religo"
|
||||||
|
|
||||||
raw :: IO ()
|
raw :: IO ()
|
||||||
raw = mkRawTreeReason (Path example)
|
raw = toParseTree (Path example)
|
||||||
>>= print . pp
|
>>= print . pp
|
||||||
|
|
||||||
sample :: IO ()
|
sample :: IO ()
|
||||||
sample = mkRawTreeReason (Path example)
|
sample = toParseTree (Path example)
|
||||||
>>= runParserM . recognise
|
>>= runParserM . recognise
|
||||||
>>= print . pp . fst
|
>>= print . pp . fst
|
||||||
|
|
||||||
recognise :: RawTree -> ParserM (LIGO Info)
|
recognise :: RawTree -> ParserM (LIGO Info)
|
||||||
recognise = descent (\_ -> error . show . pp) $ map usingScope
|
recognise = descent (\_ -> error . show . pp) $ map usingScope
|
||||||
|
@ -5,6 +5,8 @@ import Control.Monad.Catch
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
|
||||||
|
import System.IO.Unsafe
|
||||||
|
|
||||||
-- | Ensure the function is run in single thread, w/o overlapping.
|
-- | 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 results of the winner.
|
||||||
@ -13,8 +15,8 @@ import Control.Concurrent
|
|||||||
--
|
--
|
||||||
-- If function throws an error, will rethrow it in caller thread.
|
-- If function throws an error, will rethrow it in caller thread.
|
||||||
--
|
--
|
||||||
debounced :: forall s r. (s -> IO r) -> IO (s -> IO r)
|
debounced :: forall s r. (s -> IO r) -> (s -> IO r)
|
||||||
debounced act = do
|
debounced act = unsafePerformIO do
|
||||||
i <- newEmptyMVar
|
i <- newEmptyMVar
|
||||||
o <- newEmptyMVar
|
o <- newEmptyMVar
|
||||||
|
|
||||||
@ -31,7 +33,7 @@ debounced act = do
|
|||||||
putMVar i i'
|
putMVar i i'
|
||||||
readMVar o >>= either throwM return
|
readMVar o >>= either throwM return
|
||||||
|
|
||||||
_test :: IO ([Int] -> IO Int)
|
_test :: [Int] -> IO Int
|
||||||
_test = debounced \s -> do
|
_test = debounced \s -> do
|
||||||
threadDelay 2000000
|
threadDelay 2000000
|
||||||
unless (odd (length s)) do
|
unless (odd (length s)) do
|
||||||
|
36
tools/lsp/squirrel/src/Extension.hs
Normal file
36
tools/lsp/squirrel/src/Extension.hs
Normal file
@ -0,0 +1,36 @@
|
|||||||
|
|
||||||
|
module Extension where
|
||||||
|
|
||||||
|
import Control.Monad.Catch
|
||||||
|
|
||||||
|
import System.FilePath
|
||||||
|
|
||||||
|
data Ext
|
||||||
|
= Pascal
|
||||||
|
| Caml
|
||||||
|
| Reason
|
||||||
|
|
||||||
|
data ElimExt a = ElimExt
|
||||||
|
{ eePascal :: a
|
||||||
|
, eeCaml :: a
|
||||||
|
, eeReason :: a
|
||||||
|
}
|
||||||
|
|
||||||
|
data UnsupportedExtension = UnsupportedExtension String
|
||||||
|
deriving stock Show
|
||||||
|
deriving anyclass Exception
|
||||||
|
|
||||||
|
getExt :: MonadThrow m => FilePath -> m Ext
|
||||||
|
getExt path = do
|
||||||
|
case takeExtension path of
|
||||||
|
"religo" -> return Reason
|
||||||
|
"ligo" -> return Pascal
|
||||||
|
"mligo" -> return Caml
|
||||||
|
ext -> throwM $ UnsupportedExtension ext
|
||||||
|
|
||||||
|
onExt :: ElimExt a -> FilePath -> IO a
|
||||||
|
onExt ee path = do
|
||||||
|
getExt path >>= return . \case
|
||||||
|
Pascal -> eePascal ee
|
||||||
|
Caml -> eeCaml ee
|
||||||
|
Reason -> eeReason ee
|
@ -16,8 +16,6 @@ module ParseTree
|
|||||||
|
|
||||||
-- * Invoke the TreeSitter and get the tree it outputs
|
-- * Invoke the TreeSitter and get the tree it outputs
|
||||||
, toParseTree
|
, toParseTree
|
||||||
, mkRawTreePascal
|
|
||||||
, mkRawTreeReason
|
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -42,17 +40,17 @@ import TreeSitter.Tree hiding (Tree)
|
|||||||
|
|
||||||
import System.FilePath (takeFileName)
|
import System.FilePath (takeFileName)
|
||||||
|
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
|
||||||
|
|
||||||
import Duplo.Pretty as PP
|
import Duplo.Pretty as PP
|
||||||
import Duplo.Tree
|
import Duplo.Tree
|
||||||
|
|
||||||
|
import Extension
|
||||||
import Debouncer
|
import Debouncer
|
||||||
import Product
|
import Product
|
||||||
import Range
|
import Range
|
||||||
|
|
||||||
foreign import ccall unsafe tree_sitter_PascaLigo :: Ptr Language
|
foreign import ccall unsafe tree_sitter_PascaLigo :: Ptr Language
|
||||||
foreign import ccall unsafe tree_sitter_ReasonLigo :: Ptr Language
|
foreign import ccall unsafe tree_sitter_ReasonLigo :: Ptr Language
|
||||||
|
foreign import ccall unsafe tree_sitter_CamlLigo :: Ptr Language
|
||||||
|
|
||||||
data Source
|
data Source
|
||||||
= Path { srcPath :: FilePath }
|
= Path { srcPath :: FilePath }
|
||||||
@ -105,17 +103,17 @@ instance Pretty1 ParseTree where
|
|||||||
(pp forest)
|
(pp forest)
|
||||||
)
|
)
|
||||||
|
|
||||||
mkRawTreePascal :: Source -> IO RawTree
|
|
||||||
mkRawTreePascal = toParseTree tree_sitter_PascaLigo
|
|
||||||
|
|
||||||
mkRawTreeReason :: Source -> IO RawTree
|
|
||||||
mkRawTreeReason = toParseTree tree_sitter_ReasonLigo
|
|
||||||
|
|
||||||
-- | Feed file contents into PascaLIGO grammar recogniser.
|
-- | Feed file contents into PascaLIGO grammar recogniser.
|
||||||
toParseTree :: Ptr Language -> Source -> IO RawTree
|
toParseTree :: Source -> IO RawTree
|
||||||
toParseTree language = unsafePerformIO $ debounced inner
|
toParseTree = debounced inner
|
||||||
where
|
where
|
||||||
inner fin = do
|
inner fin = do
|
||||||
|
language <- onExt ElimExt
|
||||||
|
{ eePascal = tree_sitter_PascaLigo
|
||||||
|
, eeCaml = tree_sitter_CamlLigo
|
||||||
|
, eeReason = tree_sitter_ReasonLigo
|
||||||
|
} (srcPath fin)
|
||||||
|
|
||||||
parser <- ts_parser_new
|
parser <- ts_parser_new
|
||||||
-- True <- ts_parser_set_language parser tree_sitter_PascaLigo
|
-- True <- ts_parser_set_language parser tree_sitter_PascaLigo
|
||||||
True <- ts_parser_set_language parser language
|
True <- ts_parser_set_language parser language
|
||||||
|
Loading…
Reference in New Issue
Block a user