给Chez Scheme的process添加一个类似commands.getstatusoutput()的过程

By qzivli at 23 天前 • 0人收藏 • 102人看过
;; Chez Scheme的内建库中没有一个像Python或Gambit-C那样可以同时获取一个
;; 外部命令的退出状态和输出文本的过程。
;; "system" 只获取命令的退出状态,并不捕获其输出文本;
;; "process" 返回一个包含三个元素的列表:
;;   0 - input port (即系统的stdout)
;;   1 - output port (即系统的stdin)
;;   2 - pid
;; 我们可以从stdout获取命令的输入文本,通过C函数waitpid得到命令的退出状态。


(import (edu indiana match) ; Indiana大学的常用库match.ss,网上可以搜到
        (only (srfi :13) string-trim-right))
        
        
;; 加载动态链接库,在REPL或Top-Level Program中直接加载就行了
;; 但是在R6RS library里面需要包装到一个define里面
;; 因为这是一个"fake define",load-shared-object的值是void,我们并不关心其值
;; 依照Scheme社区的习惯,将其取名为dummy
(define dummy
  (case (machine-type)
    [(i3le ti3le a6le ta6le) (load-shared-object "libc.so.6")]
    [(i3osx ti3osx a6osx ta6osx) (load-shared-object "libc.dylib")]
    [else (load-shared-object "libc.so")]))
    
    
;; 错误检查

(define (check who x)
  (if (< x 0)
      (error who (c-error))
      x))
      
(define strerror
  (foreign-procedure "strerror" (int) string))
  
(define (errno)
  (foreign-ref 'int (foreign-entry "errno") 0))
  
(define (c-error)
  (strerror (errno)))
  
  
;; pid_t waitpid(pid_t pid, int *status, int options);
(define c-waitpid
  (foreign-procedure "waitpid" (int (* int) int) int))
  
;; 等待进程结束,获取其退出状态
(define (wait-pid pid)
  ;; 指向整数的指针
  (define status-ptr (make-ftype-pointer int (foreign-alloc (ftype-sizeof int))))
  (define options 0)
  ;; 调用外部函数,并检查其返回值
  (check 'wait-pid (c-waitpid pid status-ptr options))
  ;; 把值取出来
  (let ([status (ftype-ref int () status-ptr)])
    ;; 手动释放资源
    (foreign-free (ftype-pointer-address status-ptr))
    ;; 按约定,退出状态是0~255的整数
    (modulo status 255)))
    
    
(define (maybe-get-output in)
  (let ([output (get-string-some in)])
    (cond
     [(eof-object? output) ""]
     [else (string-trim-right output)]))) ; 去掉尾部的"\n"
     
(define (shell-command cmd)
  (match (process cmd)
    [(,in ,out ,pid)
     (cons (wait-pid pid)
           (maybe-get-output in))]
    [,other (error 'shell-command "run process failed")]))
    
    
;; test

(shell-command "true")
(shell-command "false")

(shell-command "date")
(shell-command "data") ; typo, should be an error: 127
2 个回复 | 最后更新于 20 天前
22 天前   #1

可否详细解释一下?

20 天前   #2

Chez Scheme 外部接口的文档https://cisco.github.io/ChezScheme/csug9.5/foreign.html


本帖是对Chez Scheme外部接口的一个简单应用,对于新手有一定价值,老手请直接略过。

登录后方可回帖

登 录
信息栏

Scheme中文社区

推荐实现 ChezScheme / r6rs / r7rs large
theschemer.org
Q群: 724577239

精华导览

社区项目

包管理器:Raven
HTTP服务器:Igropyr (希腊火)
官方插件:vscode-chez

社区目标:

完善足以使Scheme工程化和商业化的库,特别是开发极致速度的Web服务器和ANN模块。

一直以来Scheme缺少一个活跃的中文社区,同时中文资料的稀少,导致大多数因为黑客与画家和SICP而接触Scheme的朋友,在学完SICP后无事可做,不能将Scheme转换为实际的生产力。最后渐渐的放弃。
同时Chicken等实现,却因效率问题无法与其他语言竞争。本社区只有一个目的,传播Scheme的文明之火,在最快的编译器实现上,集众人之力发展出足够与其他语言竞争的社区和库。


友情链接:

Clojure 中文论坛
函数式·China


Loading...