Abstracts a new function |run_program|, rename OBEY to |run_shell_command| and use |run_program| to implement it.
Tested on Windows. Tested with jfricas. This change will not break it, because for SBCL, it uses *standard-output* instead of T for the :output keyword. Now the *OBEY-STDOUT* in webspad.lisp is no longer needed. (But can be kept for backwards compatibility.) - Qian -- You received this message because you are subscribed to the Google Groups "FriCAS - computer algebra system" group. To unsubscribe from this group and stop receiving emails from it, send an email to [email protected]. To view this discussion on the web visit https://groups.google.com/d/msgid/fricas-devel/150fd094-45ff-4513-9f1f-61e513abc66f%40gmail.com.
From 058751b0c769635c7796eec6601a5dbeee774f3f Mon Sep 17 00:00:00 2001 From: Qian Yun <[email protected]> Date: Wed, 17 Jan 2024 19:36:52 +0800 Subject: [PATCH] cleanup obey --- src/interp/as.boot | 2 +- src/interp/br-data.boot | 2 +- src/interp/br-search.boot | 2 +- src/interp/compat.boot | 4 +- src/interp/foam_l.lisp | 4 +- src/interp/i-syscmd.boot | 7 ++-- src/interp/nlib.lisp | 76 ++---------------------------------- src/interp/vmlisp.lisp | 50 ------------------------ src/lisp/fricas-lisp.lisp | 55 +++++++++++++++++++------- src/lisp/fricas-package.lisp | 2 +- 10 files changed, 55 insertions(+), 149 deletions(-) diff --git a/src/interp/as.boot b/src/interp/as.boot index 7685c085c..1ba5e7b5d 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -39,7 +39,7 @@ $asyPrint := false asList() == maybe_delete_file('"temp.text") - OBEY '"ls as/*.asy > temp.text" + run_shell_command '"ls as/*.asy > temp.text" instream := OPEN '"temp.text" lines := [read_line instream while not EOFP instream] CLOSE instream diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 3088b8ba5..fbe3dd300 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -82,7 +82,7 @@ buildLibdb(domainList) == --called by make-databases (daase.lisp) domainList => 'done --leave new database in temp.text -- FIXME: This is confusing: result is in olibdb.text, -- but this is expected by save_browser_data - OBEY '"sort temp.text -o olibdb.text" + run_shell_command '"sort temp.text -o olibdb.text" deleteFile '"temp.text" buildLibdbConEntry conname == diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 6354ebc7e..0a08df114 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -908,7 +908,7 @@ grepFile(pattern, key, option) == MEMQ('iv,options)=> '"-vi" '"-i" command := STRCONC('"grep ", casepart, '" '", pattern, '"' ", source) - OBEY STRCONC(command, '" > ",target) + run_shell_command STRCONC(command, '" > ",target) dbReadLines target -- deleteFile target dbUnpatchLines lines diff --git a/src/interp/compat.boot b/src/interp/compat.boot index ce9fe6c99..7541fb379 100644 --- a/src/interp/compat.boot +++ b/src/interp/compat.boot @@ -64,5 +64,5 @@ rwrite(key,val,stream) == editFile file == MEMQ(INTERN('"WIN32",FIND_-PACKAGE("KEYWORD")),_*FEATURES_*) => - OBEY STRCONC('"notepad ", file) - OBEY STRCONC('"$FRICAS/lib/SPADEDIT ", file) + run_program('"notepad", [file]) + run_program(CONCAT($spadroot, '"/lib/SPADEDIT"), [file]) diff --git a/src/interp/foam_l.lisp b/src/interp/foam_l.lisp index dc14bebd8..0f2831a6b 100644 --- a/src/interp/foam_l.lisp +++ b/src/interp/foam_l.lisp @@ -799,8 +799,8 @@ (if (null type) (setq path (make-pathname :directory dir :name name :type "as"))) (if opts - (OBEY (format nil "aldor ~A -Flsp ~A" opts (namestring path))) - (OBEY (format nil "aldor -Flsp ~A" (namestring path)))) + (|run_shell_command| (format nil "aldor ~A -Flsp ~A" opts (namestring path))) + (|run_shell_command| (format nil "aldor -Flsp ~A" (namestring path)))) (compile-file (namestring lpath)) (load (namestring cpath)))) diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 5bf9f1869..88967171d 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -520,7 +520,7 @@ compileAsharpCmd1 args == command := STRCONC(getEnv('"ALDOR_COMPILER"),_ '" ", asharpArgs, '" ", path) - rc := OBEY command + rc := run_shell_command command if (rc = 0) and doCompileLisp then lsp := fnameMake('".", pathnameName(path), '"lsp") @@ -572,8 +572,7 @@ compileAsharpArchiveCmd args == cd [ namestring dir ] - cmd := STRCONC( '"ar x ", path) - rc := OBEY cmd + rc := run_command('"ar", ['"x", path]) rc ~= 0 => cd [ namestring curDir ] throwKeyedMsg("S2IL0028",[namestring dir, path]) @@ -2948,7 +2947,7 @@ npsystem(unab, str) == null SEARCH(sysPart, STRING unab) => sayKeyedMsg("S2IZ0080", [sysPart]) command := SUBSEQ(str, spaceIndex+1) - OBEY command + run_shell_command command npsynonym(unab, str) == npProcessSynonym(str) diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp index 8c844fa75..c050db597 100644 --- a/src/interp/nlib.lisp +++ b/src/interp/nlib.lisp @@ -312,9 +312,9 @@ (defun |erase_lib0|(fn ft) (|erase_lib| (|make_filename0| fn ft))) -#+:GCL +#+(or :abcl :clisp :cmu :ecl :gcl :lispworks :poplog) (defun delete-directory (dirname) - (SI::system (concat "rm -r " dirname))) + (|run_program| "rm" (list "-r" dirname))) #+:sbcl (defun delete-directory (dirname) @@ -322,46 +322,18 @@ 0 1)) -#+:cmu -(defun delete-directory (dirname) - (ext::run-program "rm" (list "-r" dirname)) - ) - #+:openmcl (defun delete-directory (dirname) (if (ccl:delete-directory dirname) 0 1)) -#+:clisp -(defun delete-directory (dirname) - #-:win32 - (obey (concat "rm -r " dirname)) - #+:win32 - (obey (concat "rmdir /q /s " "\"" dirname "\""))) - -#+:ecl -(defun delete-directory (dirname) - (ext:system (concat "rm -r " dirname))) - -#+:poplog -(defun delete-directory (dirname) - (POP11:sysobey (concat "rm -r " dirname))) - -#+:abcl -(defun delete-directory (dirname) - (sys:run-program "rm" (list "-r" dirname))) - -#+:lispworks -(defun delete-directory (dirname) - (system:call-system (concatenate 'string "rm -r " dirname))) - (defun |replace_lib|(filespec2 filespec1) (|erase_lib| (setq filespec1 (|make_full_namestring| filespec1))) #-(or :clisp :openmcl :ecl) (rename-file (|make_full_namestring| filespec2) filespec1) #+(or :clisp :openmcl :ecl) - (obey (concat "mv " (|make_full_namestring| filespec2) " " filespec1)) + (|run_program| "mv" (list (|make_full_namestring| filespec2) filespec1)) ) @@ -371,48 +343,8 @@ (copy-lib-directory name1 name2) )) - -#+:GCL -(defun copy-lib-directory (name1 name2) - (makedir name2) - (SI::system (concat "sh -c 'cp " name1 "/* " name2 "'"))) - -#+:sbcl -(defun copy-lib-directory (name1 name2) - (makedir name2) - (sb-ext::run-program "/bin/sh" (list "-c" (concat "cp " name1 "/* " name2))) - ) - -#+:cmu -(defun copy-lib-directory (name1 name2) - (makedir name2) - (ext::run-program "sh" (list "-c" (concat "cp " name1 "/* " name2))) - ) - -#+:openmcl -(defun copy-lib-directory (name1 name2) - (makedir name2) - (ccl::run-program "sh" (list "-c" (concat "cp " name1 "/* " name2)))) - -#+(or :clisp :ecl) -(defun copy-lib-directory (name1 name2) - (makedir name2) - (OBEY (concat "sh -c 'cp " name1 "/* " name2 "'"))) - -#+:poplog -(defun copy-lib-directory (name1 name2) - (makedir name2) - (POP11:sysobey (concat "cp " name1 "/* " name2))) - -#+:abcl -(defun copy-lib-directory (name1 name2) - (makedir name2) - (sys:run-program "cp" (list "-r" (concat name1 "/*") name2))) - -#+:lispworks (defun copy-lib-directory (name1 name2) - (makedir name2) - (system:call-system (concat "cp " (concat name1 "/*") " " name2))) + (|run_program| "cp" (list "-r" name1 name2))) (defvar |$filetype_table| '( diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index 919781b46..95fefd555 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -707,56 +707,6 @@ func))) ((symbolp func) func))) -#+:cmu -(defun OBEY (S) - (ext::process-exit-code - (ext::run-program "sh" (list "-c" S) :input t :output t))) - -#+:GCL -(defun OBEY (S) (SI::SYSTEM S)) - -#+:allegro -(defun OBEY (S) (excl::run-shell-command s)) - -(defvar *OBEY-STDOUT* nil "if T use *standard output*") -#+:sbcl -(defun OBEY (S) - #-:win32 (if *OBEY-STDOUT* - (sb-ext::process-exit-code - (sb-ext::run-program "/bin/sh" (list "-c" S) :input t - :output *standard-output* :error *standard-output*)) - - (sb-ext::process-exit-code - (sb-ext::run-program "/bin/sh" - (list "-c" S) :input t :output t :error t))) - #+:win32 (sb-ext::process-exit-code - (sb-ext::run-program "sh" - (list "-c" S) :input t :output t :error t :search t))) - -#+:openmcl -(defun OBEY (S) - (ccl::run-program "sh" (list "-c" S) :input t :output t :error t)) - -#+(and :clisp (or :win32 :unix)) -(defun OBEY (S) - (ext:run-shell-command S)) - -#+:ecl -(defun OBEY (S) - (ext:system S)) - -#+:poplog -(defun OBEY (S) - (POP11:sysobey S)) - -#+:abcl -(defun OBEY (S) - (sys:run-program "sh" (list "-c" S) :input t :output t :error t)) - -#+:lispworks -(defun OBEY (S) - (system:call-system S)) - ;;; moved from hash.lisp ;17.0 Operations on Hashtables diff --git a/src/lisp/fricas-lisp.lisp b/src/lisp/fricas-lisp.lisp index cbd28479e..357aa063e 100644 --- a/src/lisp/fricas-lisp.lisp +++ b/src/lisp/fricas-lisp.lisp @@ -761,18 +761,14 @@ with this hack and will try to convince the GCL crowd to fix this. ;;; Make directory -#+:cmu +#+(or :abcl :cmu :lispworks :openmcl) (defun makedir (fname) - (ext::run-program "mkdir" (list fname))) + (|run_program| "mkdir" (list fname))) #+:sbcl (defun makedir (fname) (sb-unix:unix-mkdir fname #o777)) -#+:openmcl -(defun makedir (fname) - (ccl::run-program "mkdir" (list fname))) - #+:clisp (defun makedir (fname) ;; ext:make-dir was deprecated in clisp-2.44-2008-02-02 @@ -781,14 +777,6 @@ with this hack and will try to convince the GCL crowd to fix this. (find-symbol "MAKE-DIR" "EXT")))) (funcall sym (pad-directory-name (namestring fname))))) -#+:lispworks -(defun makedir (fname) - (system:call-system (concatenate 'string "mkdir " fname))) - -#+:abcl -(defun makedir (fname) - (sys:run-program "mkdir" (list fname))) - ;;; #+:sbcl @@ -891,7 +879,7 @@ with this hack and will try to convince the GCL crowd to fix this. #+:poplog (defun fricas_compile_file (f output-file) - (POP11::sysobey (concatenate 'string "cp " f " " output-file))) + (|run_program| "cp" (list f output-file))) #-(or :ecl :poplog) (defun fricas_compile_file (f output-file) @@ -904,6 +892,43 @@ with this hack and will try to convince the GCL crowd to fix this. (compile-file f :output-file (relative-to-absolute output-file)) ) +;;; |run_program| and |run_shell_command| + +(defun |run_program| (command arguments) + ;; Execute "command" with a list of "arguments" synchronously. + ;; Output to the standard output stream. + ;; The return value is the exit code of "command". + #+:abcl + (sys:process-exit-code (sys:run-program command arguments :output t)) + #+:clisp + (let ((exit-code (ext:run-program command :arguments arguments))) + (if exit-code exit-code 0)) + #+:cmu + (ext:process-exit-code (ext:run-program command arguments :output t)) + #+:ecl + (cadr (multiple-value-list (ext:run-program command arguments :output t))) + ;; #+:gcl ;; run-process is asynchronous + ;; (si:run-process command arguments) + #+:lispworks ;; call-system requires absolute path for "command" + (system:call-system-showing-output `("/usr/bin/env" ,command ,@arguments)) + #+:openmcl + (cadr (multiple-value-list (ccl:external-process-status + (ccl:run-program command arguments :output t)))) + #+:poplog + (pop11:sysobey "/usr/bin/env" (cons command arguments)) + #+:sbcl + (sb-ext:process-exit-code + (sb-ext:run-program command arguments :search t :output *standard-output*)) + #+:gcl + (si:system (format nil "~{~a~^ ~}" (cons command arguments))) +) + +(defun |run_shell_command| (s) + #+:gcl + (si:system s) + #-:gcl + (|run_program| "sh" (list "-c" s))) + (defmacro DEFCONST (name value) `(defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value))) diff --git a/src/lisp/fricas-package.lisp b/src/lisp/fricas-package.lisp index 4fdacb2ef..ca182cd81 100644 --- a/src/lisp/fricas-package.lisp +++ b/src/lisp/fricas-package.lisp @@ -44,7 +44,7 @@ (export '(quit chdir |getEnv| |getCLArgs| |load_quietly| get-current-directory trim-directory-name pad-directory-name file-kind makedir fricas_compile_file fricas_compile_fasl - |fricas_probe_file| + |fricas_probe_file| |run_program| |run_shell_command| DEFCONST |exit_with_status| MEMQ |quiet_load_alien| |handle_input_file| |handle_output_file| |maybe_delete_file| |remove_directory| |writeablep| |openServer| |sockGetInt|
