ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

build-system: Add tree-sitter-build-system.

Browse source 
* guix/build-system/tree-sitter.scm: New module.
* guix/build/tree-sitter-build-system.scm: Likewise.
* Makefile.am (MODULES): Add them.
* doc/guix.texi: Document it.

Signed-off-by: Andrew Tropin <andrew@trop.in>
This commit is contained in:
Pierre Langlois 2022-11-25 01:57:21 +00:00 committed by Andrew Tropin
parent 4a6f64ab2a
commit dbd4d2d070
No known key found for this signature in database
GPG key ID: 2208D20958C1DEB0
4 changed files with 370 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile.am
View file

@ -178,6 +178,7 @@ MODULES = \
guix/build-system/ruby.scm \ guix/build-system/ruby.scm \
guix/build-system/scons.scm \ guix/build-system/scons.scm \
guix/build-system/texlive.scm \ guix/build-system/texlive.scm \
guix/build-system/tree-sitter.scm \
guix/build-system/trivial.scm \ guix/build-system/trivial.scm \
guix/ftp-client.scm \ guix/ftp-client.scm \
guix/http-client.scm \ guix/http-client.scm \
@ -234,6 +235,7 @@ MODULES = \
guix/build/ruby-build-system.scm \ guix/build/ruby-build-system.scm \
guix/build/scons-build-system.scm \ guix/build/scons-build-system.scm \
guix/build/texlive-build-system.scm \ guix/build/texlive-build-system.scm \
guix/build/tree-sitter-build-system.scm \
guix/build/waf-build-system.scm \ guix/build/waf-build-system.scm \
guix/build/haskell-build-system.scm \ guix/build/haskell-build-system.scm \
guix/build/julia-build-system.scm \ guix/build/julia-build-system.scm \

21
doc/guix.texi
View file

@ -79,7 +79,7 @@ Copyright @copyright{} 2020 Jack Hill@*
Copyright @copyright{} 2020 Naga Malleswari@* Copyright @copyright{} 2020 Naga Malleswari@*
Copyright @copyright{} 2020, 2021 Brice Waegeneire@* Copyright @copyright{} 2020, 2021 Brice Waegeneire@*
Copyright @copyright{} 2020 R Veera Kumar@* Copyright @copyright{} 2020 R Veera Kumar@*
Copyright @copyright{} 2020, 2021 Pierre Langlois@* Copyright @copyright{} 2020, 2021, 2022 Pierre Langlois@*
Copyright @copyright{} 2020 pinoaffe@* Copyright @copyright{} 2020 pinoaffe@*
Copyright @copyright{} 2020 André Batista@* Copyright @copyright{} 2020 André Batista@*
Copyright @copyright{} 2020, 2021 Alexandru-Sergiu Marton@* Copyright @copyright{} 2020, 2021 Alexandru-Sergiu Marton@*
@ -9756,6 +9756,25 @@ be specified with the @code{#:node} parameter which defaults to
@code{node}. @code{node}.
@end defvar @end defvar
@defvr {Scheme Variable} tree-sitter-build-system
This variable is exported by @code{(guix build-system tree-sitter)}. It
implements procedures to compile grammars for the
@url{https://tree-sitter.github.io/tree-sitter/, Tree-sitter} parsing
library. It essentially runs @code{tree-sitter generate} to translate
@code{grammar.js} grammars to JSON and then to C. Which it then
compiles to native code.
Tree-sitter packages may support multiple grammars, so this build system
supports a @code{#:grammar-directories} keyword to specify a list of
locations where a @code{grammar.js} file may be found.
Grammars sometimes depend on each other, such as C++ depending on C and
TypeScript depending on JavaScript. You may use inputs to declare such
dependencies.
@end defvr
Lastly, for packages that do not need anything as sophisticated, a Lastly, for packages that do not need anything as sophisticated, a
``trivial'' build system is provided. It is trivial in the sense that ``trivial'' build system is provided. It is trivial in the sense that
it provides basically no support: it does not pull any implicit inputs, it provides basically no support: it does not pull any implicit inputs,

195
guix/build-system/tree-sitter.scm Normal file
View file

@ -0,0 +1,195 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Pierre Langlois <pierre.langlois@gmx.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system tree-sitter)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix search-paths)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (guix build-system node)
#:use-module (ice-9 match)
#:export (%tree-sitter-build-system-modules
tree-sitter-build
tree-sitter-build-system))
(define %tree-sitter-build-system-modules
;; Build-side modules imported by default.
`((guix build tree-sitter-build-system)
,@%node-build-system-modules))
(define* (lower name
#:key source inputs native-inputs outputs system target
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME from the given arguments."
(define private-keywords
`(#:inputs #:native-inputs #:outputs ,@(if target
'()
'(#:target))))
(define node
(module-ref (resolve-interface '(gnu packages node))
'node-lts))
(define tree-sitter
(module-ref (resolve-interface '(gnu packages tree-sitter))
'tree-sitter))
(define tree-sitter-cli
(module-ref (resolve-interface '(gnu packages tree-sitter))
'tree-sitter-cli))
;; Grammars depend on each other via JS modules, which we package into a
;; dedicated js output.
(define grammar-inputs
(map (match-lambda
((name package)
`(,name ,package "js")))
inputs))
(bag
(name name)
(system system) (target target)
(build-inputs `(,@(if source
`(("source" ,source))
'())
("node" ,node)
("tree-sitter-cli" ,tree-sitter-cli)
,@native-inputs
,@(if target '() grammar-inputs)
;; Keep the standard inputs of 'gnu-build-system'.
,@(if target
(standard-cross-packages target 'host)
'())
,@(standard-packages)))
(host-inputs `(("tree-sitter" ,tree-sitter)
,@(if target grammar-inputs '())))
;; Keep the standard inputs of 'gnu-buid-system'.
(target-inputs (if target
(standard-cross-packages target 'target)
'()))
;; XXX: this is a hack to get around issue #41569.
(outputs (match outputs
(("out") (cons "js" outputs))
(_ outputs)))
(build (if target tree-sitter-cross-build tree-sitter-build))
(arguments (strip-keyword-arguments private-keywords arguments))))
(define* (tree-sitter-build name inputs
#:key
source
(phases '%standard-phases)
(grammar-directories '("."))
(tests? #t)
(outputs '("out" "js"))
(search-paths '())
(system (%current-system))
(guile #f)
(imported-modules %tree-sitter-build-system-modules)
(modules '((guix build utils)
(guix build tree-sitter-build-system))))
(define builder
(with-imported-modules imported-modules
#~(begin
(use-modules #$@(sexp->gexp modules))
(tree-sitter-build #:name #$name
#:source #+source
#:system #$system
#:phases #$phases
#:tests? #$tests?
#:grammar-directories '#$grammar-directories
#:outputs #$(outputs->gexp outputs)
#:search-paths
'#$(sexp->gexp
(map search-path-specification->sexp
search-paths))
#:inputs #$(input-tuples->gexp inputs)))))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:guile-for-build guile)))
(define* (tree-sitter-cross-build name
#:key
target
build-inputs target-inputs host-inputs
guile source
(phases '%standard-phases)
(grammar-directories '("."))
(tests? #t)
(outputs '("out" "js"))
(search-paths '())
(native-search-paths '())
(system (%current-system))
(build (nix-system->gnu-triplet system))
(imported-modules
%tree-sitter-build-system-modules)
(modules
'((guix build utils)
(guix build tree-sitter-build-system))))
(define builder
(with-imported-modules imported-modules
#~(begin
(use-modules #$@(sexp->gexp modules))
(define %build-host-inputs
#+(input-tuples->gexp build-inputs))
(define %build-target-inputs
(append #$(input-tuples->gexp host-inputs)
#+(input-tuples->gexp target-inputs)))
(define %build-inputs
(append %build-host-inputs %build-target-inputs))
(tree-sitter-build #:name #$name
#:source #+source
#:system #$system
#:build #$build
#:target #$target
#:phases #$phases
#:tests? #$tests?
#:grammar-directories '#$grammar-directories
#:outputs #$(outputs->gexp outputs)
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths '
#$(sexp->gexp
(map search-path-specification->sexp
search-paths))
#:native-search-paths
'#$(sexp->gexp
(map
search-path-specification->sexp
native-search-paths))))))
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
(gexp->derivation name builder
#:system system
#:target target
#:guile-for-build guile)))
(define tree-sitter-build-system
(build-system
(name 'tree-sitter)
(description "The Tree-sitter grammar build system")
(lower lower)))
;;; tree-sitter.scm ends here

153
guix/build/tree-sitter-build-system.scm Normal file
View file

@ -0,0 +1,153 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Pierre Langlois <pierre.langlois@gmx.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build tree-sitter-build-system)
#:use-module ((guix build node-build-system) #:prefix node:)
#:use-module (guix build json)
#:use-module (guix build utils)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:export (%standard-phases
tree-sitter-build))
;; Commentary:
;;
;; Build procedures for tree-sitter grammar packages. This is the
;; builder-side code, which builds on top of the node build-system.
;;
;; Tree-sitter grammars are written in JavaScript and compiled to a native
;; shared object. The `tree-sitter generate' command invokes `node' in order
;; to evaluate the grammar.js into a grammar.json file, which is then
;; translated into C code. We then compile the C code ourselves. Packages
;; also sometimes add extra manually written C/C++ code.
;;
;; In order to support grammars depending on each other, such as C and C++,
;; JavaScript and TypeScript, this build-system installs the source of the
;; node module in a dedicated "js" output.
;;
;; Code:
(define* (patch-dependencies #:key inputs #:allow-other-keys)
"Rewrite dependencies in 'package.json'. We remove all runtime dependencies
and replace development dependencies with tree-sitter grammar node modules."
(define (rewrite package.json)
(map (match-lambda
(("dependencies" @ . _)
'("dependencies" @))
(("devDependencies" @ . _)
`("devDependencies" @
,@(filter-map (match-lambda
((key . directory)
(let ((node-module
(string-append directory
"/lib/node_modules/"
key)))
(and (directory-exists? node-module)
`(,key . ,node-module)))))
(alist-delete "node" inputs))))
(other other))
package.json))
(node:with-atomic-json-file-replacement "package.json"
(match-lambda
(('@ . package.json)
(cons '@ (rewrite package.json))))))
;; FIXME: The node build-system's configure phase does not support
;; cross-compiling so we re-define it.
(define* (configure #:key native-inputs inputs #:allow-other-keys)
(invoke (search-input-file (or native-inputs inputs) "/bin/npm")
"--offline" "--ignore-scripts" "install"))
(define* (build #:key grammar-directories #:allow-other-keys)
(for-each (lambda (dir)
(with-directory-excursion dir
;; Avoid generating binding code for other languages, we do
;; not support this use-case yet and it relies on running
;; `node-gyp' to build native addons.
(invoke "tree-sitter" "generate" "--no-bindings")))
grammar-directories))
(define* (check #:key grammar-directories tests? #:allow-other-keys)
(when tests?
(for-each (lambda (dir)
(with-directory-excursion dir
(invoke "tree-sitter" "test")))
grammar-directories)))
(define* (install #:key target grammar-directories outputs #:allow-other-keys)
(let ((lib (string-append (assoc-ref outputs "out")
"/lib/tree-sitter")))
(mkdir-p lib)
(define (compile-language dir)
(with-directory-excursion dir
(let ((lang (assoc-ref (call-with-input-file "src/grammar.json"
read-json)
"name"))
(source-file (lambda (path)
(if (file-exists? path)
path
#f))))
(apply invoke
`(,(if target
(string-append target "-g++")
"g++")
"-shared"
"-fPIC"
"-fno-exceptions"
"-O2"
"-g"
"-o" ,(string-append lib "/libtree-sitter-" lang ".so")
;; An additional `scanner.{c,cc}' file is sometimes
;; provided.
,@(cond
((source-file "src/scanner.c")
=> (lambda (file) (list "-xc" "-std=c99" file)))
((source-file "src/scanner.cc")
=> (lambda (file) (list file)))
(else '()))
"-xc" "src/parser.c")))))
(for-each compile-language grammar-directories)))
(define* (install-js #:key native-inputs inputs outputs #:allow-other-keys)
(invoke (search-input-file (or native-inputs inputs) "/bin/npm")
"--prefix" (assoc-ref outputs "js")
"--global"
"--offline"
"--loglevel" "info"
"--production"
;; Skip scripts to prevent building bindings via GYP.
"--ignore-scripts"
"install" "../package.tgz"))
(define %standard-phases
(modify-phases node:%standard-phases
(replace 'patch-dependencies patch-dependencies)
(replace 'configure configure)
(replace 'build build)
(replace 'check check)
(replace 'install install)
(add-after 'install 'install-js install-js)))
(define* (tree-sitter-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
(apply node:node-build #:inputs inputs #:phases phases args))
;;; tree-sitter-build-system.scm ends here