From 4a3c8b751c1cfcdeb3211183c56c4a44d155e616 Mon Sep 17 00:00:00 2001 From: Dmitry Bogatov Date: Fri, 30 Jan 2015 07:40:20 +0300 Subject: [PATCH] Remove dead code --- lisp/gnu/bash/alias.scm | 68 ----------------------- lisp/gnu/bash/command.scm | 60 --------------------- lisp/gnu/bash/eval.scm | 42 --------------- lisp/gnu/bash/variable.scm | 132 --------------------------------------------- 4 files changed, 302 deletions(-) delete mode 100644 lisp/gnu/bash/alias.scm delete mode 100644 lisp/gnu/bash/command.scm delete mode 100644 lisp/gnu/bash/eval.scm delete mode 100644 lisp/gnu/bash/variable.scm diff --git a/lisp/gnu/bash/alias.scm b/lisp/gnu/bash/alias.scm deleted file mode 100644 index bd06e47..0000000 --- a/lisp/gnu/bash/alias.scm +++ /dev/null @@ -1,68 +0,0 @@ -;;; alias.scm --- - -;; Copyright (C) 2014 Dmitry Bogatov > - -;; Author: Dmitry Bogatov > - -;; This program 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. - -;; This program 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 . - -;;; Commentary: - -;;; Code: - -(define-module (gnu bash alias)) -(use-modules (system foreign)) -(use-modules (system ffi)) -(use-modules (srfi srfi-41)) -(use-modules (syntax implicit)) -(use-modules (syntax export)) -(define-ffi c-free ((*: ptr) -> void:) #:symbol "free") - -(define (pointer->argv argv) - (define (*++ ptr) - "Increment value of PTR by sizeof void*." - (make-pointer (+ (pointer-address ptr) - (sizeof '*)))) - (if (null-pointer? argv) - '() - (map pointer->alias - (stream->list - (stream-take-while - (compose not null-pointer?) - (stream-map dereference-pointer - (stream-iterate *++ argv))))))) - -(define-ffi-object argv: - #:decoder pointer->argv - #:free c-free) - -(with-export! - (define-ffi-mask alias-flags: - ((expand-next #x1) - (beeing-expanded #x2))) - (define-ffi-struct alias: - ((string: name) - (string: value) - (alias-flags: flags))) - (define-ffi add-alias - ((#:const string: name) (#:const string: value) -> void:)) - (define-ffi get-alias-value - ((#:const string: name) -> ?string:)) - (define-ffi remove-alias ((#:const *: name) -> int:)) - (define-ffi delete-all-aliases (-> void:)) - (define-ffi alias-expand - ((#:const string: name) -> #:alloc string:)) - (define-ffi alias-expand-word - ((#:const string: name) -> #:alloc string:)) - (define-ffi all-aliases (-> #:alloc argv:))) diff --git a/lisp/gnu/bash/command.scm b/lisp/gnu/bash/command.scm deleted file mode 100644 index 79f14c1..0000000 --- a/lisp/gnu/bash/command.scm +++ /dev/null @@ -1,60 +0,0 @@ -;;; command.scm --- - -;; Copyright (C) 2014 Dmitry Bogatov > - -;; Author: Dmitry Bogatov > - -;; This program 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. - -;; This program 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 . - -;;; Commentary: - -;;; Code: - -(define-module (gnu bash command)) -(use-modules (gnu bash eval)) -(use-modules (gnu bash variable)) - - -(define *scheme-functions* (make-hash-table)) -(define +functions+magic-variable+ 'SCM_FUNCTIONS_MAGIC_VARIABLE) - -(define bash:bind-magic-variable - (@@ (guile-user) bash:bind-magic-variable)) - -(bash:bind-magic-variable - +functions+magic-variable+ - (lambda () - (let* ((cur-func-symbol (string->symbol ($ 'FUNCNAME))) - (thunk (hashq-ref *scheme-functions* cur-func-symbol)) - (retval (thunk))) - (if (integer? retval) - (format #f "~a" retval) - "0")))) - - -;; Problem is that in magic variable handler I have no access to -;; dollar variables. Quick and dirty solution is just save -;; $@ into some other array. Yeah, global variables are evil, -;; but it saves load of code to maintain and debug. -(define-public (bind-scm-function symbol thunk) - (hashq-set! *scheme-functions* symbol thunk) - (bash-eval - (format #f - "function ~a { - SCM_ARGS=($@) ; - local retval=$~a ; - unset SCM_ARGS ; - return $retval ; - }" - symbol +functions+magic-variable+))) diff --git a/lisp/gnu/bash/eval.scm b/lisp/gnu/bash/eval.scm deleted file mode 100644 index 44ee01c..0000000 --- a/lisp/gnu/bash/eval.scm +++ /dev/null @@ -1,42 +0,0 @@ -;;; eval.scm --- - -;; Copyright (C) 2014 Dmitry Bogatov > - -;; Author: Dmitry Bogatov > - -;; This program 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. - -;; This program 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 . - -;;; Commentary: - -;;; Code: - -(define-module (gnu bash eval) - #:export (bash-eval)) -(use-modules (system foreign)) -(use-modules (system ffi)) -(use-modules (gnu bash variable)) - -(define-ffi-mask eval-flags: - ((nonint #x001) - (interact #x002) - (nohist #x004) - (nofree #x008) - (resetline #x010) - (parseonly #x020) - (nolongjmp #x040))) - -(define-ffi unsafe-evalstring (*: (#:const string: from) eval-flags: -> int:) - #:symbol "evalstring") -(define (bash-eval str) - (unsafe-evalstring (string->pointer str) "(gnu bash command)" '(nofree nohist))) diff --git a/lisp/gnu/bash/variable.scm b/lisp/gnu/bash/variable.scm deleted file mode 100644 index 5362909..0000000 --- a/lisp/gnu/bash/variable.scm +++ /dev/null @@ -1,132 +0,0 @@ -;;; variable.scm --- - -;; Copyright (C) 2014 Dmitry Bogatov > - -;; Author: Dmitry Bogatov > - -;; This program 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. - -;; This program 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 . - -;;; Commentary: - -;;; Code: -(define-module (gnu bash variable)) -(use-modules (system foreign)) -(use-modules (system ffi)) -(use-modules (srfi srfi-41)) -(use-modules (srfi srfi-26)) -(use-modules (srfi srfi-1)) -(use-modules (syntax implicit)) -(use-modules (syntax export)) -(use-modules (gnu bash eval)) - -(define-ffi c-free ((*: memory) -> void:) #:symbol "free") -(define-ffi c-strdup ((*: str) -> *:) #:symbol "strdup") - -(define (c-xstrdup ptr) - (if (null-pointer? ptr) - %null-pointer - (strdup ptr))) - -#!curly-infix -(with-export! - (define-ffi-object variable:) - ;; Actually, it should modify variable by pointer, so it would be more - ;; convenient to just work with pointers and do not fight type system. - ;; (define-ffi-func func/var-value: ((#:const variable:) -> #:const variable:)) - (define-ffi-func func/var-value: (*: -> *:)) - (define-ffi-func func/var-assign: - ((variable: var) (*: _?) - (int64: arrind) (*: _??) -> variable:)) - (define-ffi-mask variable-flags: - ((exported #x0000001) ; export to environment - (readonly #x0000002) ; cannot change - (array #x0000004) ; value is an array - (function #x0000008) ; value is a function - (integer #x0000010) ; internal representation is int - (local #x0000020) ; variable is local to a function - (assoc #x0000040) ; variable is an associative array - (trace #x0000080) ; function is traced with DEBUG trap - (uppercase #x0000100) ; word converted to uppercase on assignment - (lowercase #x0000200) ; word converted to lowercase on assignment - (capcase #x0000400) ; word capitalized on assignment - (nameref #x0000800) ; word is a name reference - (invisible #x0001000) ; cannot see - (nounset #x0002000) ; cannot unset - (noassign #x0004000) ; assignment not allowed - (imported #x0008000) ; came from environment - (special #x0010000) ; requires special handling - (nofree #x0020000) ; do not free value on unset - (tempvar #x0100000) ; variable came from the temp environment - (propagate #x0200000)))) ; propagate to previous scope - -(with-export! - (define-ffi-struct variable: - ((string: name) - (?string: value) - (?string: exportstr) - (?func/var-value: dynamic-value) - (?func/var-assign: assign-func) - (variable-flags: attributes) - (int: context))) - (define-ffi get-string-value ((#:const string: var-name) -> ?string:)) - (define-ffi find-variable ((#:const string: name) -> ?variable:)) - (define-ffi bind-variable - ((#:const string: name) (#:const string: value) (variable-flags: flags) - -> variable:)) - (define-ffi bind-global-variable - ((#:const string: name) (#:const string: value) (variable-flags: flags) - -> variable:))) - -(define-extern (int: last-command-exit-value)) -(define-ffi quote-escapes ((#:const string: str) -> #:alloc string:)) -(define bash:array->alist (false-if-exception (@@ (guile-user) bash:array->alist))) - -(define (show x) - (format #f "~a" x)) -(define quote-show (compose quote-escapes show)) - -(define (bash:capture-output args) - (let ((eval-str (string-join (map quote-show args) " "))) - (bash-eval (format #f "SCM_OUTPUT=$(~a)" eval-str)) - ;; (unless (zero? (last-command-exit-value)) - ;; (error 'bash-command-error eval-str (last-command-exit-value))) - ($ 'SCM_OUTPUT))) - -(define (bash:eval-command args) - (bash-eval (string-join (map quote-show args) " "))) - -(define-syntax-rule ($% arg arg* ...) - (bash:eval-command `(arg arg* ...))) -(export $%) - - - -(define ($-ref x) - (cond - ((integer? x) ((dollar-var x))) - ((eq? x '?) (last-command-exit-value)) - ((eq? x '@) (map cdr (bash:array->alist 'SCM_ARGS))) - ((vector? x) (bash:capture-output (vector->list x))) - (#t (get-string-value (show x))))) - -(define ($-set x value) - (cond - ((integer? x) (set! (dollar-vars x) (show value))) - ((equal? x '?) (set! (last-command-exit-value) value)) - (#t (bind-variable (show x) (show value) '())))) - -(define-public $ (make-procedure-with-setter $-ref $-set)) -(define-syntax $? (identifier-syntax (last-command-exit-value))) -(define-syntax $@ (identifier-syntax ($ '@))) -(export! $? $@) -- 2.11.4.GIT