From a5cba44a068da3084f04ce21f983124ce8778899 Mon Sep 17 00:00:00 2001
From: Jan Tojnar <jtojnar@gmail.com>
Date: Sat, 18 Dec 2021 00:28:33 +0100
Subject: [PATCH] semantic: Add semantic-c support

---
 README.md                          |  1 +
 semantic/BUILD.bazel               |  1 +
 semantic/semantic.cabal            |  1 +
 semantic/src/Parsing/Parser.hs     | 10 ++++++++--
 semantic/src/Semantic/Api/Terms.hs | 10 ++++++++++
 5 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/README.md b/README.md
index 14b3a16c9d..aa6656b68d 100644
--- a/README.md
+++ b/README.md
@@ -36,6 +36,7 @@ Available options:
 
 | Language       | Parse | AST Symbols† | Stack graphs |
 | :------------- | :---: | :---:        | :---:        |
+| C              | ✅    | ⬜️           | |
 | Ruby           | ✅    | ✅           | |
 | JavaScript     | ✅    | ✅           | |
 | TypeScript     | ✅    | ✅           | 🚧 |
diff --git a/semantic/BUILD.bazel b/semantic/BUILD.bazel
index f7b6528e75..7db026e0c2 100644
--- a/semantic/BUILD.bazel
+++ b/semantic/BUILD.bazel
@@ -56,6 +56,7 @@ haskell_library(
         "//:deepseq",
         "//:filepath",
         "//:template-haskell",
+        "//semantic-c",
         "//semantic-codeql",
         "//semantic-go",
         "//semantic-java",
diff --git a/semantic/semantic.cabal b/semantic/semantic.cabal
index 0e0938b321..35fd3acd51 100644
--- a/semantic/semantic.cabal
+++ b/semantic/semantic.cabal
@@ -125,6 +125,7 @@ library
     , proto-lens >= 0.5 && < 0.8
     , semantic-analysis ^>= 0
     , semantic-ast
+    , semantic-c ^>= 0
     , semantic-codeql ^>= 0
     , semantic-go ^>= 0
     , semantic-java ^>= 0
diff --git a/semantic/src/Parsing/Parser.hs b/semantic/src/Parsing/Parser.hs
index 83e5958eb1..f9d6324174 100644
--- a/semantic/src/Parsing/Parser.hs
+++ b/semantic/src/Parsing/Parser.hs
@@ -30,6 +30,7 @@ import           AST.Unmarshal
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Foreign.Ptr
+import qualified Language.C as CPrecise
 import qualified Language.CodeQL as CodeQLPrecise
 import qualified Language.Go as GoPrecise
 import qualified Language.Java as Java
@@ -80,6 +81,9 @@ data Parser term where
 data SomeParser c a where
   SomeParser :: c t => Parser (t a) -> SomeParser c a
 
+cParser :: c CPrecise.Term => (Language, SomeParser c Loc)
+cParser = (C, SomeParser (UnmarshalParser @CPrecise.Term CPrecise.tree_sitter_c))
+
 goParser :: c GoPrecise.Term => (Language, SomeParser c Loc)
 goParser = (Go, SomeParser (UnmarshalParser @GoPrecise.Term GoPrecise.tree_sitter_go))
 
@@ -115,7 +119,8 @@ typescriptParser = (TypeScript, SomeParser (UnmarshalParser @TypeScriptPrecise.T
 
 -- | The canonical set of parsers producing precise terms.
 preciseParsers
-  :: ( c Java.Term
+  :: ( c CPrecise.Term
+     , c Java.Term
      , c JSON.Term
      , c PythonPrecise.Term
      , c CodeQLPrecise.Term
@@ -127,7 +132,8 @@ preciseParsers
      )
   => Map Language (SomeParser c Loc)
 preciseParsers = Map.fromList
-  [ goParser
+  [ cParser
+  , goParser
   , javascriptParser
   , jsonParser
   , jsxParser
diff --git a/semantic/src/Semantic/Api/Terms.hs b/semantic/src/Semantic/Api/Terms.hs
index d16c20fb11..facade59f3 100644
--- a/semantic/src/Semantic/Api/Terms.hs
+++ b/semantic/src/Semantic/Api/Terms.hs
@@ -24,6 +24,7 @@ import           Data.ByteString.Builder
 import           Data.Either
 import           Data.Foldable (fold)
 import           Data.Map.Strict (Map)
+import qualified Language.C as C
 import qualified Language.CodeQL as CodeQL
 import qualified Language.Go as Go
 import qualified Language.Java as Java
@@ -74,6 +75,9 @@ showTermParsers = preciseParsers
 class ShowTerm term where
   showTerm :: (Has (Reader Config) sig m) => term Loc -> m Builder
 
+instance ShowTerm C.Term where
+  showTerm = serialize Show . void . C.getTerm
+
 instance ShowTerm Go.Term where
   showTerm = serialize Show . void . Go.getTerm
 
@@ -107,6 +111,9 @@ jsonTermParsers = preciseParsers
 class JSONTerm term where
   jsonTerm :: (Has (Reader Config) sig m) => term Loc -> m Builder
 
+instance JSONTerm C.Term where
+  jsonTerm = serialize Marshal . C.getTerm
+
 instance JSONTerm Go.Term where
   jsonTerm = serialize Marshal . Go.getTerm
 
@@ -140,6 +147,9 @@ sexprTermParsers = preciseParsers
 class SExprTerm term where
   sexprTerm :: term Loc -> Builder
 
+instance SExprTerm C.Term where
+  sexprTerm = SExpr.Precise.serializeSExpression . C.getTerm
+
 instance SExprTerm Go.Term where
   sexprTerm = SExpr.Precise.serializeSExpression . Go.getTerm