lisp/gnu/bash/variable.scm

   1 ;;; variable.scm ---
   2
   3 ;; Copyright (C) 2014 Dmitry Bogatov <Dmitry Bogatov <KAction@gnu.org>>
   4
   5 ;; Author: Dmitry Bogatov <Dmitry Bogatov <KAction@gnu.org>>
   6
   7 ;; This program is free software; you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License
   9 ;; as published by the Free Software Foundation; either version 3
  10 ;; of the License, or (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;;; Code:
  23 (define-module (gnu bash variable))
  24 (use-modules (system foreign))
  25 (use-modules (system ffi))
  26 (use-modules (srfi srfi-41))
  27 (use-modules (srfi srfi-26))
  28 (use-modules (srfi srfi-1))
  29 (use-modules (syntax implicit))
  30 (use-modules (syntax export))
  31 (use-modules (gnu bash eval))
  32
  33 (define-ffi c-free ((*: memory) -> void:) #:symbol "free")
  34 (define-ffi c-strdup ((*: str) -> *:) #:symbol "strdup")
  35
  36 (define (c-xstrdup ptr)
  37   (if (null-pointer? ptr)
  38       %null-pointer
  39     (strdup ptr)))
  40
  41 #!curly-infix
  42 (with-export!
  43  (define-ffi-object variable:)
  44  ;; Actually, it should modify variable by pointer, so it would be more
  45  ;; convenient to just work with pointers and do not fight type system.
  46  ;; (define-ffi-func func/var-value: ((#:const variable:) -> #:const variable:))
  47  (define-ffi-func func/var-value: (*: -> *:))
  48  (define-ffi-func func/var-assign:
  49    ((variable: var) (*: _?)
  50     (int64: arrind) (*: _??) -> variable:))
  51  (define-ffi-mask variable-flags:
  52    ((exported   #x0000001)      ; export to environment
  53     (readonly   #x0000002)      ; cannot change
  54     (array      #x0000004)      ; value is an array
  55     (function   #x0000008)      ; value is a function
  56     (integer    #x0000010)      ; internal representation is int
  57     (local      #x0000020)      ; variable is local to a function
  58     (assoc      #x0000040)      ; variable is an associative array
  59     (trace      #x0000080)      ; function is traced with DEBUG trap
  60     (uppercase  #x0000100)      ; word converted to uppercase on assignment
  61     (lowercase  #x0000200)      ; word converted to lowercase on assignment
  62     (capcase    #x0000400)      ; word capitalized on assignment
  63     (nameref    #x0000800)      ; word is a name reference
  64     (invisible  #x0001000)      ; cannot see
  65     (nounset    #x0002000)      ; cannot unset
  66     (noassign   #x0004000)      ; assignment not allowed
  67     (imported   #x0008000)      ; came from environment
  68     (special    #x0010000)      ; requires special handling
  69     (nofree     #x0020000)      ; do not free value on unset
  70     (tempvar    #x0100000)      ; variable came from the temp environment
  71     (propagate  #x0200000))))   ; propagate to previous scope
  72
  73 (with-export!
  74  (define-ffi-struct variable:
  75    ((string: name)
  76     (?string: value)
  77     (?string: exportstr)
  78     (?func/var-value: dynamic-value)
  79     (?func/var-assign: assign-func)
  80     (variable-flags: attributes)
  81     (int: context)))
  82  (define-ffi get-string-value ((#:const string: var-name) -> ?string:))
  83  (define-ffi find-variable ((#:const string: name) -> ?variable:))
  84  (define-ffi bind-variable
  85    ((#:const string: name) (#:const string: value) (variable-flags: flags)
  86     -> variable:))
  87  (define-ffi bind-global-variable
  88    ((#:const string: name) (#:const string: value) (variable-flags: flags)
  89     -> variable:)))
  90
  91 (define-extern (int: last-command-exit-value))
  92 (define-ffi quote-escapes ((#:const string: str) -> #:alloc string:))
  93 (define bash:array->alist (false-if-exception (@@ (guile-user) bash:array->alist)))
  94
  95 (define (show x)
  96   (format #f "~a" x))
  97 (define quote-show (compose quote-escapes show))
  98
  99 (define (bash:capture-output args)
 100   (let ((eval-str (string-join (map quote-show args) " ")))
 101     (bash-eval (format #f "SCM_OUTPUT=$(~a)" eval-str))
 102     ;; (unless (zero? (last-command-exit-value))
 103     ;;   (error 'bash-command-error eval-str (last-command-exit-value)))
 104     ($ 'SCM_OUTPUT)))
 105
 106 (define (bash:eval-command args)
 107   (bash-eval (string-join (map quote-show args) " ")))
 108
 109 (define-syntax-rule ($% arg arg* ...)
 110   (bash:eval-command `(arg arg* ...)))
 111 (export $%)
 112
 113
 114
 115 (define ($-ref x)
 116   (cond
 117    ((integer? x)  ((dollar-var x)))
 118    ((eq? x '?)    (last-command-exit-value))
 119    ((eq? x '@)    (map cdr (bash:array->alist 'SCM_ARGS)))
 120    ((vector? x)   (bash:capture-output (vector->list x)))
 121    (#t (get-string-value (show x)))))
 122
 123 (define ($-set x value)
 124   (cond
 125    ((integer? x)  (set! (dollar-vars x) (show value)))
 126    ((equal? x '?) (set! (last-command-exit-value) value))
 127    (#t            (bind-variable (show x) (show value) '()))))
 128
 129 (define-public $ (make-procedure-with-setter $-ref $-set))
 130 (define-syntax $? (identifier-syntax (last-command-exit-value)))
 131 (define-syntax $@ (identifier-syntax ($ '@)))
 132 (export! $? $@)