# # Analyse a defined subset: condition statement must be bracketed # # Usage: where () # eg where (male and age>60) hwe {\$m} # macro where mac curp <- ple set ple -2 quiet eval (dowhere "%0") set ple %curp quiet ;;;; # # where (condition) # note that multiple run's push onto a stack so reverse ordering # eval (define (dowhere s) \ (let* ((eos (string-length s)) \ (lb (let loop ((i 1)) \ (cond ((> i eos) -1) \ ((equal? (substring s (- i 1) i) "(") i) \ ( else (loop (+ i 1)))))) \ (rb (let loop ((i (+ lb 1)) (nleft 1)) \ (cond ((> i eos) \ -1) \ ((equal? (substring s (- i 1) i) "(") \ (loop (+ i 1) (+ nleft 1))) \ ((equal? (substring s (- i 1) i) ")") \ (if (= 1 nleft) \ (- i 1) \ (loop (+ i 1) (- nleft 1)))) \ (else \ (loop (+ i 1) nleft)))))) \ (if (>= rb lb 0) \ (let ((cmd (string-split (substring s (+ rb 2) (string-length s)))) \ (wexpr (substring s lb rb))) \ (if (< (length cmd) 2) \ (run (string-append "echo ERROR: In \"" s "\", missing a trait to subset." )) \ (let ((trait (cadr cmd))) \ (if (loctyp trait) \ (let ((subset (string-append "subset" (loctyp trait)))) \ (if (not (string=? trait subset)) \ (begin \ (run (string-append "drop " subset)) \ (run (string-append "rename tmp_subset " trait)) \ (run (string-append "rename " trait " " subset)) \ (run "set ple -2 quiet") \ (run (paste cmd)) \ (run (string-append "set ple " curp " quiet")) \ (run (string-append "rename " subset " " trait)) \ (run (string-append "rename " trait " tmp_subset")) \ (run (string-append "if (" wexpr ") then " subset "=" trait)) \ (run (string-append "(" subset "=x)")) \ (if (not (loctyp subset)) \ (run (string-append "set loc " subset " " (loctyp trait) \ " . Work variable for subsetting")) \ (if (string=? (substring (loctyp subset) 0 1) "d") \ (run (string-append "undrop " subset)))) \ (dobanner (string-append "Subsetting \"" trait "\" on \"" wexpr "\""))))) \ (run (string-append "echo ERROR: \"" trait "\" is not recognized as a trait")))))) \ (run (string-append "echo ERROR: unable to recognize the condition in \"" s "\""))))) # # Write a banner # eval (define (dobanner s) \ (define (dline n) (run (string-append "echo " (make-string n "=")))) \ (let ((l (string-length s))) \ (begin (dline l) \ (run (string-append "echo " s)) \ (dline l)))) macro banner eval (dobanner "%0") ;;;; # # Convert list to string # eval (define (paste x) \ (if (atom? x) \ x \ (string-append (car x) \ (apply string-append \ (map (lambda (x) (string-append " " x)) (cdr x))))))