github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +03:00
Code Issues Projects Releases Wiki Activity

🔥 the ad hoc computation of term costs.

Browse Source
This commit is contained in:
Rob Rix 2016-07-15 17:49:27 -04:00
parent 9d495a2936
commit 1127fd2672
2 changed files with 7 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Diffing.hs
View File

@ -40,9 +40,8 @@ lineByLineParser input = pure . cofree . root $ case foldl' annotateLeaves ([],
(leaves, _) -> cofree <$> leaves (leaves, _) -> cofree <$> leaves
where where
lines = actualLines input lines = actualLines input
root children = let cost = 1 + fromIntegral (length children) in root children = ((Range 0 $ length input) .: Other "program" .: RNil) :< Indexed children
((Range 0 $ length input) .: Other "program" .: cost .: RNil) :< Indexed children leaf charIndex line = ((Range charIndex $ charIndex + T.length line) .: Other "program" .: RNil) :< Leaf line
leaf charIndex line = ((Range charIndex $ charIndex + T.length line) .: Other "program" .: 1 .: RNil) :< Leaf line
annotateLeaves (accum, charIndex) line = annotateLeaves (accum, charIndex) line =
(accum <> [ leaf charIndex (toText line) ] (accum <> [ leaf charIndex (toText line) ]
, charIndex + length line) , charIndex + length line)
@ -92,12 +91,12 @@ diffFiles parser renderer sourceBlobs = do
let sources = source <$> sourceBlobs let sources = source <$> sourceBlobs
terms <- sequence $ parser <$> sources terms <- sequence $ parser <$> sources
let replaceLeaves = breakDownLeavesByWord <$> sources let preprocessed = breakDownLeavesByWord <$> sources <*> terms
let areNullOids = runJoin $ (== nullOid) . oid <$> sourceBlobs let areNullOids = runJoin $ (== nullOid) . oid <$> sourceBlobs
let textDiff = case areNullOids of let textDiff = case areNullOids of
(True, False) -> pure $ Insert (snd terms) (True, False) -> pure $ Insert (snd terms)
(False, True) -> pure $ Delete (fst terms) (False, True) -> pure $ Delete (fst terms)
(_, _) -> runBothWith (diffTerms construct shouldCompareTerms diffCostWithCachedTermCosts) $ replaceLeaves <*> terms _ -> runBothWith (diffTerms construct shouldCompareTerms diffCostWithCachedTermCosts) preprocessed
pure $! renderer textDiff sourceBlobs pure $! renderer textDiff sourceBlobs
where construct (info :< syntax) = free (Free ((setCost <$> info <*> sumCost syntax) :< syntax)) where construct (info :< syntax) = free (Free ((setCost <$> info <*> sumCost syntax) :< syntax))

8
src/TreeSitter.hs
View File

@ -5,7 +5,6 @@ import Prologue hiding (Constructor)
import Data.Record import Data.Record
import Data.String import Data.String
import Category import Category
import Info
import Language import Language
import Parser import Parser
import Range import Range
@ -17,7 +16,7 @@ import Text.Parser.TreeSitter hiding (Language(..))
import qualified Text.Parser.TreeSitter as TS import qualified Text.Parser.TreeSitter as TS
-- | Returns a TreeSitter parser for the given language and TreeSitter grammar. -- | Returns a TreeSitter parser for the given language and TreeSitter grammar.
treeSitterParser :: Language -> Ptr TS.Language -> Parser (Syntax Text) (Record '[Range, Category, Cost]) treeSitterParser :: Language -> Ptr TS.Language -> Parser (Syntax Text) (Record '[Range, Category])
treeSitterParser language grammar contents = do treeSitterParser language grammar contents = do
document <- ts_document_make document <- ts_document_make
ts_document_set_language document grammar ts_document_set_language document grammar
@ -51,7 +50,7 @@ defaultCategoryForNodeName name = case name of
_ -> Other name _ -> Other name
-- | Return a parser for a tree sitter language & document. -- | Return a parser for a tree sitter language & document.
documentToTerm :: Language -> Ptr Document -> Parser (Syntax Text) (Record '[Range, Category, Cost]) documentToTerm :: Language -> Ptr Document -> Parser (Syntax Text) (Record '[Range, Category])
documentToTerm language document contents = alloca $ \ root -> do documentToTerm language document contents = alloca $ \ root -> do
ts_document_root_node_p document root ts_document_root_node_p document root
toTerm root toTerm root
@ -63,8 +62,7 @@ documentToTerm language document contents = alloca $ \ root -> do
-- Note: The strict application here is semantically important. Without it, we may not evaluate the range until after we’ve exited the scope that `node` was allocated within, meaning `alloca` will free it & other stack data may overwrite it. -- Note: The strict application here is semantically important. Without it, we may not evaluate the range until after we’ve exited the scope that `node` was allocated within, meaning `alloca` will free it & other stack data may overwrite it.
range <- pure $! Range { start = fromIntegral $ ts_node_p_start_char node, end = fromIntegral $ ts_node_p_end_char node } range <- pure $! Range { start = fromIntegral $ ts_node_p_start_char node, end = fromIntegral $ ts_node_p_end_char node }
let cost' = 1 + sum (cost . extract <$> children) let info = range .: (categoriesForLanguage language name) .: RNil
let info = range .: (categoriesForLanguage language name) .: cost' .: RNil
pure $! termConstructor contents info children pure $! termConstructor contents info children
getChild node n out = do getChild node n out = do
_ <- ts_node_p_named_child node n out _ <- ts_node_p_named_child node n out