github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +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
where
lines = actualLines input
root children = let cost = 1 + fromIntegral (length children) in
((Range 0 $ length input) .: Other "program" .: cost .: RNil) :< Indexed children
leaf charIndex line = ((Range charIndex $ charIndex + T.length line) .: Other "program" .: 1 .: RNil) :< Leaf line
root children = ((Range 0 $ length input) .: Other "program" .: RNil) :< Indexed children
leaf charIndex line = ((Range charIndex $ charIndex + T.length line) .: Other "program" .: RNil) :< Leaf line
annotateLeaves (accum, charIndex) line =
(accum <> [ leaf charIndex (toText line) ]
, charIndex + length line)
@ -92,12 +91,12 @@ diffFiles parser renderer sourceBlobs = do
let sources = source <$> sourceBlobs
terms <- sequence $ parser <$> sources
let replaceLeaves = breakDownLeavesByWord <$> sources
let preprocessed = breakDownLeavesByWord <$> sources <*> terms
let areNullOids = runJoin $ (== nullOid) . oid <$> sourceBlobs
let textDiff = case areNullOids of
(True, False) -> pure $ Insert (snd terms)
(False, True) -> pure $ Delete (fst terms)
(_, _) -> runBothWith (diffTerms construct shouldCompareTerms diffCostWithCachedTermCosts) $ replaceLeaves <*> terms
_ -> runBothWith (diffTerms construct shouldCompareTerms diffCostWithCachedTermCosts) preprocessed
pure $! renderer textDiff sourceBlobs
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.String
import Category
import Info
import Language
import Parser
import Range
@ -17,7 +16,7 @@ import Text.Parser.TreeSitter hiding (Language(..))
import qualified Text.Parser.TreeSitter as TS
-- | 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
document <- ts_document_make
ts_document_set_language document grammar
@ -51,7 +50,7 @@ defaultCategoryForNodeName name = case name of
_ -> Other name
-- | 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
ts_document_root_node_p document 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.
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) .: cost' .: RNil
let info = range .: (categoriesForLanguage language name) .: RNil
pure $! termConstructor contents info children
getChild node n out = do
_ <- ts_node_p_named_child node n out