Commit fd9cb067 authored by Juergen Nickelsen's avatar Juergen Nickelsen

subseq, substr, sublist + test 034; doseq with start & end

parent 8fa1f30c
......@@ -152,24 +152,49 @@
(eval resultform)))
(defspecial doseq (formargs &rest body)
"(doseq (loopvar seq resultform) . body)"
(let ((var (car formargs))
(seq (eval (cadr formargs)))
resultform)
(let ((list (if (stringp seq)
(split-string "" seq)
seq)))
(when (consp (cddr formargs))
(setq resultform (caddr formargs)))
(while (consp list)
(set var (pop list))
"(doseq (loopvar seq [resultform [start [end]]]) . body)"
(let* ((var (car formargs))
(start (or (cadddr formargs) 0))
(end (car (cddddr formargs)))
(seq (eval (subseq (cadr formargs) start )))
((resultform (caddr formargs)))
((doseq-list (if (stringp seq)
(split-string "" seq)
seq))))
(while (consp doseq-list)
(set var (pop doseq-list))
(eval-list body))
(eval resultform))))
(eval resultform)))
(defun sequencep (object)
"return t if OBJECT is a sequence (list or string), nil else"
(or (listp object) (stringp object)))
(defun sublist (l start &optional end)
"return a sublist of L bounded by START end END"
;; (format t "(sublist %s %s %s)\n" l start end)
(if (null l)
nil
(if (null end)
(if (<= start 0)
l
(sublist (cdr l) (1- start)))
(if (<= end 0)
nil
(if (<= start 0)
(cons (car l)
(sublist (cdr l) 0 (1- end)))
(sublist (cdr l) (1- start) (1- end)))))))
(defun substr (str start &optional end)
"return a substring of STR bounded by START end END"
(apply #'string (sublist (split-string str "") start end)))
(defun subseq (seq start &optional end)
"return a copy of the subsequence of SEQ bounded by START and END"
(cond ((listp seq) (sublist seq start end))
((stringp seq) (substr seq start end))
(t (error "subseq: not a sequence: %s" seq))))
(defun atom (ob)
"return true if OBJECT is an atom, i.e. not a pair"
......
(testcmp "substr 0" '(sublist '(m a d r i g a l) 0) '(m a d r i g a l))
(testcmp "sublist 2" '(sublist '(m a d r i g a l) 2) '(d r i g a l))
(testcmp "sublist 10" '(sublist '(m a d r i g a l) 10) ())
(testcmp "sublist 0 0" '(sublist '(m a d r i g a l) 0 0) ())
(testcmp "sublist 2 0" '(sublist '(m a d r i g a l) 2 0) ())
(testcmp "sublist 10 0" '(sublist '(m a d r i g a l) 10 0) ())
(testcmp "sublist 0 1" '(sublist '(m a d r i g a l) 0 1) '(m))
(testcmp "sublist 2 1" '(sublist '(m a d r i g a l) 2 1) ())
(testcmp "sublist 10 1" '(sublist '(m a d r i g a l) 10 1) ())
(testcmp "sublist 0 2" '(sublist '(m a d r i g a l) 0 2) '(m a))
(testcmp "sublist 2 2" '(sublist '(m a d r i g a l) 2 2) ())
(testcmp "sublist 10 2" '(sublist '(m a d r i g a l) 10 2) ())
(testcmp "sublist 0 5" '(sublist '(m a d r i g a l) 0 5) '(m a d r i))
(testcmp "sublist 2 5" '(sublist '(m a d r i g a l) 2 5) '(d r i))
(testcmp "sublist 10 5" '(sublist '(m a d r i g a l) 10 5) ())
(testcmp "sublist 0 15" '(sublist '(m a d r i g a l) 0 15) '(m a d r i g a l))
(testcmp "sublist 2 15" '(sublist '(m a d r i g a l) 2 15) '(d r i g a l))
(testcmp "sublist 10 15" '(sublist '(m a d r i g a l) 10 15) ())
(testcmp "substr 0" '(substr "madrigal" 0) "madrigal")
(testcmp "substr 2" '(substr "madrigal" 2) "drigal")
(testcmp "substr 10" '(substr "madrigal" 10) "")
(testcmp "substr 0 0" '(substr "madrigal" 0 0) "")
(testcmp "substr 2 0" '(substr "madrigal" 2 0) "")
(testcmp "substr 10 0" '(substr "madrigal" 10 0) "")
(testcmp "substr 0 1" '(substr "madrigal" 0 1) "m")
(testcmp "substr 2 1" '(substr "madrigal" 2 1) "")
(testcmp "substr 10 1" '(substr "madrigal" 10 1) "")
(testcmp "substr 0 2" '(substr "madrigal" 0 2) "ma")
(testcmp "substr 2 2" '(substr "madrigal" 2 2) "")
(testcmp "substr 10 2" '(substr "madrigal" 10 2) "")
(testcmp "substr 0 5" '(substr "madrigal" 0 5) "madri")
(testcmp "substr 2 5" '(substr "madrigal" 2 5) "dri")
(testcmp "substr 10 5" '(substr "madrigal" 10 5) "")
(testcmp "substr 0 15" '(substr "madrigal" 0 15) "madrigal")
(testcmp "substr 2 15" '(substr "madrigal" 2 15) "drigal")
(testcmp "substr 10 15" '(substr "madrigal" 10 15) "")
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment