me/guix
Archived
1
0
Fork 0
Code Activity

gexp: Store compilers in a hash table for O(1) lookup.

Browse source 
* guix/gexp.scm (<gexp-compiler>)[predicate]: Remove.
[type]: New field.
(%gexp-compilers): Turn into a hash table.
(register-compiler!, lookup-compiler, lookup-expander): Adjust
accordingly.
(define-gexp-compiler): Replace 'predicate' by 'record-type'.
(derivation-compiler, local-file-compiler, plain-file-compiler)
(computed-file-compiler, program-file-compiler, scheme-file-compiler)
(file-append-compiler): Adjust accordingly.
* guix/packages.scm (package-compiler, origin-compiler): Likewise.
This commit is contained in:
Ludovic Courtès 2016-09-10 11:57:37 +02:00
parent e71479747b
commit 1cdecf24f5
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 24 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
guix/gexp.scm
View file

@ -131,15 +131,15 @@
;; Compiler for a type of objects that may be introduced in a gexp. ;; Compiler for a type of objects that may be introduced in a gexp.
(define-record-type <gexp-compiler> (define-record-type <gexp-compiler>
(gexp-compiler predicate lower expand) (gexp-compiler type lower expand)
gexp-compiler? gexp-compiler?
(predicate gexp-compiler-predicate) (type gexp-compiler-type) ;record type descriptor
(lower gexp-compiler-lower) (lower gexp-compiler-lower)
(expand gexp-compiler-expand)) ;#f | DRV -> M sexp (expand gexp-compiler-expand)) ;#f | DRV -> sexp
(define %gexp-compilers (define %gexp-compilers
;; List of <gexp-compiler>. ;; 'eq?' mapping of record type descriptor to <gexp-compiler>.
'()) (make-hash-table 20))
(define (default-expander thing obj output) (define (default-expander thing obj output)
"This is the default expander for \"things\" that appear in gexps. It "This is the default expander for \"things\" that appear in gexps. It
@ -152,24 +152,20 @@ returns its output file name of OBJ's OUTPUT."
(define (register-compiler! compiler) (define (register-compiler! compiler)
"Register COMPILER as a gexp compiler." "Register COMPILER as a gexp compiler."
(set! %gexp-compilers (cons compiler %gexp-compilers))) (hashq-set! %gexp-compilers
(gexp-compiler-type compiler) compiler))
(define (lookup-compiler object) (define (lookup-compiler object)
"Search for a compiler for OBJECT. Upon success, return the three argument "Search for a compiler for OBJECT. Upon success, return the three argument
procedure to lower it; otherwise return #f." procedure to lower it; otherwise return #f."
(any (match-lambda (and=> (hashq-ref %gexp-compilers (struct-vtable object))
(($ <gexp-compiler> predicate lower) gexp-compiler-lower))
(and (predicate object) lower)))
%gexp-compilers))
(define (lookup-expander object) (define (lookup-expander object)
"Search for an expander for OBJECT. Upon success, return the three argument "Search for an expander for OBJECT. Upon success, return the three argument
procedure to expand it; otherwise return #f." procedure to expand it; otherwise return #f."
(or (any (match-lambda (and=> (hashq-ref %gexp-compilers (struct-vtable object))
(($ <gexp-compiler> predicate _ expand) gexp-compiler-expand))
(and (predicate object) expand)))
%gexp-compilers)
default-expander))
(define* (lower-object obj (define* (lower-object obj
#:optional (system (%current-system)) #:optional (system (%current-system))
@ -197,19 +193,19 @@ The more elaborate form allows you to specify an expander:
expander => (lambda (param drv output) ...)) expander => (lambda (param drv output) ...))
The expander specifies how an object is converted to its sexp representation." The expander specifies how an object is converted to its sexp representation."
((_ (name (param predicate) system target) body ...) ((_ (name (param record-type) system target) body ...)
(define-gexp-compiler name predicate (define-gexp-compiler name record-type
compiler => (lambda (param system target) body ...) compiler => (lambda (param system target) body ...)
expander => default-expander)) expander => default-expander))
((_ name predicate ((_ name record-type
compiler => compile compiler => compile
expander => expand) expander => expand)
(begin (begin
(define name (define name
(gexp-compiler predicate compile expand)) (gexp-compiler record-type compile expand))
(register-compiler! name))))) (register-compiler! name)))))
(define-gexp-compiler (derivation-compiler (drv derivation?) system target) (define-gexp-compiler (derivation-compiler (drv <derivation>) system target)
;; Derivations are the lowest-level representation, so this is the identity ;; Derivations are the lowest-level representation, so this is the identity
;; compiler. ;; compiler.
(with-monad %store-monad (with-monad %store-monad
@ -275,7 +271,7 @@ This is the declarative counterpart of the 'interned-file' monadic procedure."
'system-error' exception is raised if FILE could not be found." 'system-error' exception is raised if FILE could not be found."
(force (%local-file-absolute-file-name file))) (force (%local-file-absolute-file-name file)))
(define-gexp-compiler (local-file-compiler (file local-file?) system target) (define-gexp-compiler (local-file-compiler (file <local-file>) system target)
;; "Compile" FILE by adding it to the store. ;; "Compile" FILE by adding it to the store.
(match file (match file
(($ <local-file> file (= force absolute) name recursive? select?) (($ <local-file> file (= force absolute) name recursive? select?)
@ -302,7 +298,7 @@ This is the declarative counterpart of 'text-file'."
;; them in a declarative context. ;; them in a declarative context.
(%plain-file name content '())) (%plain-file name content '()))
(define-gexp-compiler (plain-file-compiler (file plain-file?) system target) (define-gexp-compiler (plain-file-compiler (file <plain-file>) system target)
;; "Compile" FILE by adding it to the store. ;; "Compile" FILE by adding it to the store.
(match file (match file
(($ <plain-file> name content references) (($ <plain-file> name content references)
@ -324,7 +320,7 @@ to 'gexp->derivation'.
This is the declarative counterpart of 'gexp->derivation'." This is the declarative counterpart of 'gexp->derivation'."
(%computed-file name gexp options)) (%computed-file name gexp options))
(define-gexp-compiler (computed-file-compiler (file computed-file?) (define-gexp-compiler (computed-file-compiler (file <computed-file>)
system target) system target)
;; Compile FILE by returning a derivation whose build expression is its ;; Compile FILE by returning a derivation whose build expression is its
;; gexp. ;; gexp.
@ -346,7 +342,7 @@ GEXP. GUILE is the Guile package used to execute that script.
This is the declarative counterpart of 'gexp->script'." This is the declarative counterpart of 'gexp->script'."
(%program-file name gexp guile)) (%program-file name gexp guile))
(define-gexp-compiler (program-file-compiler (file program-file?) (define-gexp-compiler (program-file-compiler (file <program-file>)
system target) system target)
;; Compile FILE by returning a derivation that builds the script. ;; Compile FILE by returning a derivation that builds the script.
(match file (match file
@ -366,7 +362,7 @@ This is the declarative counterpart of 'gexp->script'."
This is the declarative counterpart of 'gexp->file'." This is the declarative counterpart of 'gexp->file'."
(%scheme-file name gexp)) (%scheme-file name gexp))
(define-gexp-compiler (scheme-file-compiler (file scheme-file?) (define-gexp-compiler (scheme-file-compiler (file <scheme-file>)
system target) system target)
;; Compile FILE by returning a derivation that builds the file. ;; Compile FILE by returning a derivation that builds the file.
(match file (match file
@ -385,7 +381,7 @@ This is the declarative counterpart of 'gexp->file'."
SUFFIX." SUFFIX."
(%file-append base suffix)) (%file-append base suffix))
(define-gexp-compiler file-append-compiler file-append? (define-gexp-compiler file-append-compiler <file-append>
compiler => (lambda (obj system target) compiler => (lambda (obj system target)
(match obj (match obj
(($ <file-append> base _) (($ <file-append> base _)

4
guix/packages.scm
View file

@ -1179,7 +1179,7 @@ cross-compilation target triplet."
(define package->cross-derivation (define package->cross-derivation
(store-lift package-cross-derivation)) (store-lift package-cross-derivation))
(define-gexp-compiler (package-compiler (package package?) system target) (define-gexp-compiler (package-compiler (package <package>) system target)
;; Compile PACKAGE to a derivation for SYSTEM, optionally cross-compiled for ;; Compile PACKAGE to a derivation for SYSTEM, optionally cross-compiled for
;; TARGET. This is used when referring to a package from within a gexp. ;; TARGET. This is used when referring to a package from within a gexp.
(if target (if target
@ -1210,7 +1210,7 @@ cross-compilation target triplet."
#:modules modules #:modules modules
#:guile-for-build guile))))) #:guile-for-build guile)))))
(define-gexp-compiler (origin-compiler (origin origin?) system target) (define-gexp-compiler (origin-compiler (origin <origin>) system target)
;; Compile ORIGIN to a derivation for SYSTEM. This is used when referring ;; Compile ORIGIN to a derivation for SYSTEM. This is used when referring
;; to an origin from within a gexp. ;; to an origin from within a gexp.
(origin->derivation origin system)) (origin->derivation origin system))