Changeset 35168 in project


Ignore:
Timestamp:
02/20/18 05:19:10 (10 months ago)
Author:
kon
Message:

complexify ( all must interpret the quasi ) , simplify by cascading abstractions

Location:
release/4/posix-utils/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/posix-utils/trunk/posix-utils.scm

    r35164 r35168  
    1010(;export
    1111  string-trim-eol software-eol-string
     12  qs* qs-item
    1213  environment-variables->environment-list
    1314  environment-variable-bound?
    1415  environment-variable-true?
    1516  register-environment-variable-feature!
     17  get-commandline-result
     18  get-command-result get-echo-result
    1619  get-shell-variable
    1720  shell-variable-bound?
     
    2225(use
    2326  (only (srfi 1) member)
    24   (only data-structures identity ->string)
     27  (only data-structures string-intersperse o identity ->string)
    2528  (only posix process process-wait)
    26   (only utils read-all)
     29  (only utils qs read-all)
    2730  (only (srfi 13) string-trim-both string-index string-take string-null? string-downcase)
    2831  (only (srfi 14) list->char-set)
    2932  (only check-errors check-string) )
     33
     34;;
     35
     36(define (qs-delimiter obj)
     37  (if (string? obj) obj (string obj)) )
    3038
    3139;;
     
    4250(: shell-value-true? ((or boolean string) (or boolean (list-of string)) -> boolean))
    4351(define (shell-value-true? varval truedat)
    44   (and-let* (
    45     (str varval) )
     52  (and-let* ((str varval))
    4653    (let* (
    4754      (truedat (or truedat *SHELL-TRUE-VALUES*))
     
    9198;;
    9299
     100(define-constant DOUBLE-QUOTE "\"" #;"\"")  ;editor unbalanced
     101(define-constant SINGLE-QUOTE "\'")
     102(define-constant BACK-QUOTE "`")
     103
     104(: qs* (string string #!optional (or string char) -> string))
     105(define (qs* str #!optional (delim DOUBLE-QUOTE))
     106  (let ((delim (qs-delimiter delim)))
     107    (string-append delim str delim) ) )
     108
     109(: qs-item (* #!optional boolean (or string char) -> string))
     110(define (qs-item item #!optional literal? (delim DOUBLE-QUOTE))
     111  (cond
     112    ;
     113    ;' item '
     114    ((and (not literal?) (pair? item) (eq? 'quote (car item)))
     115      (qs-item (cdr item) #t SINGLE-QUOTE) )
     116    ;
     117    ;` item ... ` : quasi-interpret qs-item
     118    ;   , - " item "
     119    ;   ,@ - " ->string(item) ... "
     120    ((and (not literal?) (pair? item) (eq? 'quasiquote (car item)))
     121      (qs-item (quasi-eval (cdr item)) #t BACK-QUOTE) )
     122    ;
     123    ;< item >
     124    ((string? item)
     125      (qs* item delim) )
     126    ;
     127    ;< string(item) >
     128    (else
     129      (qs* (->string item) delim)) ) )
     130
     131(define (quasi-eval item)
     132  (cond
     133    ;
     134    ;" item "
     135    ((and (pair? item) (eq? 'unquote (car item)))
     136      (let ((evaled (cdr item)))
     137        (qs-item evaled) ) )
     138    ;
     139    ;" item ... "
     140    ((and (pair? item) (eq? 'unquote-splicing (car item)))
     141      (let* (
     142        (evaled
     143          (cdr item) )
     144        (evaled
     145          (if (list? evaled)
     146            (string-intersperse (map ->string evaled) " ")
     147            (->string evaled) ) ) )
     148        (qs-item evaled) ) )
     149    ;
     150    ;' item '
     151    (else
     152      (qs-item item #t SINGLE-QUOTE) ) ) )
     153
     154;;
     155
    93156(define (environment-variables->environment-list al)
    94157  (map
     
    114177;;
    115178
    116 (: get-shell-variable (string -> (or boolean string)))
    117 (define (get-shell-variable nam)
     179(: get-commandline-result (string string -> string))
     180(define (get-commandline-result cmnd line)
    118181  (let ((in (void)) (out (void)) (pid (void)))
    119182    (dynamic-wind
    120183      (lambda ()
    121         (set!-values (in out pid)
    122           (process (string-append "echo \"$" nam  "\""))) )
     184        (set!-values (in out pid) (process (string-append (qs cmnd) " " line))) )
    123185      (lambda ()
    124         (and-let* (
    125           ;echo command result (w/ eol)
    126           (instr (read-all in))
    127           ;remove trailing eol from echo command
    128           (str (string-trim-eol instr)) )
    129           ;the shell variable value
    130           str ) )
     186        (read-all in) )
    131187      (lambda ()
    132188        (close-input-port in)
    133189        (close-output-port out) ) ) ) )
    134190
     191(: get-command-result (string #!rest -> string))
     192(define (get-command-result cmnd . args)
     193  (let ((line (string-intersperse (map qs-item args) " ")))
     194    (get-commandline-result cmnd line) ) )
     195
     196(: get-echo-result (#!rest -> string))
     197(define (get-echo-result . exps)
     198  (let ((res (apply get-command-result "echo" exps)))
     199    ;remove echo eol
     200    (string-trim-eol res) ) )
     201
     202;;
     203
     204(: get-shell-variable (string -> string))
     205(define (get-shell-variable name)
     206  (get-echo-result (string-append "$" name)) )
     207
    135208(: shell-variable-bound? (string -> (or boolean string)))
    136 (define (shell-variable-bound? nam)
    137   (shell-value-bound? (get-shell-variable nam)) )
     209(define (shell-variable-bound? name)
     210  (shell-value-bound? (get-shell-variable name)) )
    138211
    139212(: shell-variable-true? (string #!optional (or boolean (list-of string)) -> boolean))
    140 (define (shell-variable-true? nam #!optional truedat)
    141   (shell-value-true? (get-shell-variable nam) truedat) )
     213(define (shell-variable-true? name #!optional truedat)
     214  (shell-value-true? (get-shell-variable name) truedat) )
    142215
    143216(: register-shell-variable-feature! (string -> (or boolean symbol)))
    144 (define (register-shell-variable-feature! nam #!optional (filter identity))
    145   (register-shell-value-feature! (get-shell-variable nam) filter) )
     217(define (register-shell-variable-feature! name #!optional (filter identity))
     218  (register-shell-value-feature! (get-shell-variable name) filter) )
    146219
    147220;;;
  • release/4/posix-utils/trunk/posix-utils.setup

    r35149 r35168  
    55(verify-extension-name "posix-utils")
    66
    7 (setup-shared-extension-module 'posix-utils (extension-version "1.1.0")
     7(setup-shared-extension-module 'posix-utils (extension-version "1.1.1")
    88  #:compile-options '(
    99    -fixnum-arithmetic
Note: See TracChangeset for help on using the changeset viewer.