summaryrefslogtreecommitdiff
path: root/gmk-default.scm
blob: 37db2f7bcaf5977197f9c68d3847d3df31e436f1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
;; Contents of the (gnu make) Guile module
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; This file is part of GNU Make.
;;
;; GNU Make 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 Make 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 this program.  If not, see <http://www.gnu.org/licenses/>.

(define (to-string-maybe x)
  (cond
   ;; In GNU make, "false" is the empty string
   ((or (not x)
        (unspecified? x)
        (null? x)
        (and (string? x) (string-null? x)))
    #f)
   ;; We want something not false... not sure about this
   ((eq? x #t) "#t")
   ;; Basics
   ((or (symbol? x) (number? x))
    (object->string x))
   ((char? x)
    (string x))
   ;; Printable string (no special characters)
   ((and (string? x)
         (eq? (string-length (string-delete x char-set:printing)) 0))
    x)
   ;; No idea: fail
   (else (error "Unknown object:" x))))

(define (obj-to-str x)
  (let ((acc '()))
    (define (walk x)
      (cond ((pair? x) (walk (car x)) (walk (cdr x)))
            ((to-string-maybe x) => (lambda (s) (set! acc (cons s acc))))))
    (walk x)
    (string-join (reverse! acc))))

;; eval (GNU make eval) the input string S
(define (gmk-eval s)
  (gmk-expand (format #f "$(eval ~a)" (obj-to-str s))))

;; Return the value of the GNU make variable V
(define (gmk-var v)
  (gmk-expand (format #f "$(~a)" (obj-to-str v))))

;; Export the public interfaces
(export gmk-expand gmk-eval gmk-var)