Coverage report: /home/ellis/comp/core/ffi/tree-sitter/lang.lisp

Kind	Covered	All	%
expression	10	43	23.3
branch	0	0	nil

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; ffi/tree-sitter/lang.lisp --- Tree-sitter Languages

2

3

;; Tree-sitter language bindings.

4

5

;; in subdirs of *TREE-SITTER-LANGUAGE-DIRECTORY*, there are two json

6

;; files: node-types.json and grammar.json.

7

8

;; node-types: https://tree-sitter.github.io/tree-sitter/using-parsers#static-node-types

9

10

;; parsers: https://tree-sitter.github.io/tree-sitter/#available-parsers

11

12

;; ref: https://github.com/death/cl-tree-sitter

13

14

;;; Code:

15

(in-package :tree-sitter)

16

17

(defvar *ts-langs* (make-hash-table))

18

19

(defun language-module (name)

20

(funcall

21

(or (gethash (sb-int:keywordicate name) *ts-langs*) ;; symbol -> keyword, string must be UPCASE

22

(error "tree-sitter language module not found: ~s." name))))

23

24

(macrolet ((def-ts-lang-loader (lang)

25

(let ((name (symbolicate 'tree-sitter- lang)))

26

(let ((fname (symbolicate 'load- name)))

27

`(prog1

28

(defun ,fname (&optional save)

29

                         (prog1 (sb-alien:load-shared-object ,(format nil "/usr/local/lib/libtree-sitter-~(~a~).so" lang)

30

                                                             :dont-save (not save))

31

(pushnew ,(sb-int:keywordicate name) *features*)))

32

(defar ,name (* ts-language))

33

(setf (gethash ,(sb-int:keywordicate lang) *ts-langs*) ',name)

34

(export '(,fname ,name)))))))

35

(def-ts-lang-loader rust)

36

(def-ts-lang-loader json)

37

(def-ts-lang-loader c)

38

(def-ts-lang-loader bash)

39

(def-ts-lang-loader commonlisp)

40

(def-ts-lang-loader cpp)

41

(def-ts-lang-loader css)

42

(def-ts-lang-loader go)

43

(def-ts-lang-loader html)

44

(def-ts-lang-loader javascript)

45

(def-ts-lang-loader jsdoc)

46

(def-ts-lang-loader python)

47

(def-ts-lang-loader regex)

48

(def-ts-lang-loader typescript-tsx)

49

(def-ts-lang-loader typescript-typescript)

50

(def-ts-lang-loader yaml))

51

52

(defun list-ts-langs () (loop for name being each hash-key of *ts-langs* collect name))

53

54

(defvar *tree-sitter-language-directory* #P"/usr/local/share/tree-sitter/")

55

56

(defun tree-sitter-language-files ()

57

(let ((res))

58

(sb-ext:map-directory

59

(lambda (dir) (push (uiop:directory-files dir "*.json") res))

60

*tree-sitter-language-directory*)

61

(flatten res)))

62

63

;; (map 'list (lambda (x) (with-open-file (s x)

64

;; (dat/json:json-read s)))

65

;; (tree-sitter-language-files))))