#
# Analyse a defined subset: condition statement must be bracketed
#
#  Usage: where (<logical expression>) <sib-pair command> <locus> <args>
#  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) <cmd> <target_trait> <rest of args>
# 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))))))