Add abs.
[mes.git] / module / mes / scm.mes
index 2ac9180e8357c76ea50afe979933e209a385b506..a9898c8ad95300cb3190f58cbef025b2f777d374 100644 (file)
 
 (define (list . rest) rest)
 
+(define (list-head x n)
+  (if (= 0 n) '()
+      (cons (car x) (list-head (cdr x) (- n 1)))))
+
+(define (list-tail x n)
+  (if (= 0 n) x
+      (list-tail (cdr x) (- n 1))))
+
+(define (string-prefix? prefix string)
+  (and
+   (>= (string-length string) (string-length prefix))
+   (equal? (substring string 0 (string-length prefix)) prefix)))
+
+(define (symbol-prefix? prefix symbol)
+  (string-prefix? (symbol->string prefix) (symbol->string symbol)))
+
+(define (symbol-append . rest)
+  (string->symbol (apply string-append (map symbol->string rest))))
+
 (define-macro (case val . args)
   (if (null? args) #f
       (let ((clause (car args)))
   `(if ,expr
        ((lambda () ,@body))))
 
+(define-macro (unless expr . body)
+  `(if (not ,expr)
+       ((lambda () ,@body))))
+
 (define-macro (do init test . body)
   `(let loop ((,(caar init) ,(cadar init)))
      (when (not ,@test)
       (if (= i n) '()
           (cons (string-ref s i) (loop (+ i 1)))))))
 
+(define (string->number s . radix)
+  (if (and (pair? radix) (not (= (car radix) 10))) '*STRING->NUMBER:RADIX-NOT-SUPPORTED
+      (let* ((lst (string->list s))
+             (sign (if (char=? (car lst) #\-) -1 1))
+             (lst (if (= sign -1) (cdr lst) lst)))
+        (let loop ((lst lst) (n 0))
+          (if (null? lst) (* sign n)
+              (loop (cdr lst) (+ (* n 10) (- (char->integer (car lst)) (char->integer #\0)))))))))
+
 (define (vector . rest) (list->vector rest))
 (define c:make-vector make-vector)
 (define (make-vector n . x)
           (member x (cdr lst)))))
 
 (define (for-each f l . r)
-  (if (null? l) '() ;; IF
-      (if (null? r) (begin (f (car l)) (for-each f (cdr l)))
-          (if (null? (cdr r))
-              (for-each f (cdr l) (cdar r))))))
+  (if (pair? l) (if (null? r) (begin (f (car l)) (for-each f (cdr l)))
+                    (if (null? (cdr r)) (begin (f (car l) (caar r)) (for-each f (cdr l) (cdar r)))))))
 
 (define (<= . rest)
   (or (apply < rest)
 (define (remainder x y)
   (- x (* (quotient x y) y)))
 
+(define (even? x)
+  (= 0 (remainder x 2)))
+
+(define (odd? x)
+  (= 1 (remainder x 2)))
+
+(define (negative? x)
+  (< x 0))
+
+(define (positive? x)
+  (> x 0))
+
+(define (zero? x)
+  (= x 0))
+
+(define (1+ x)
+  (+ x 1))
+
+(define (1- x)
+  (- x 1))
+
+(define (abs x)
+  (if (>= x 0) x (- x)))
+
 (define (expt x y)
   (let loop ((s 1) (count y))
     (if (= 0 count) s
     (if (= 0 k) (car lst)
         (loop (cdr lst) (- k 1)))))
 
+(define (iota n)
+  (if (<= n 0) '()
+      (append2 (iota (- n 1)) (list (- n 1)))))
+
 ;; srfi-1
 (define (last-pair lst)
   (let loop ((lst lst))
   (if (null? lst) '()
       (append (reverse (cdr lst)) (cons (car lst) '()))))
 
+(define (filter pred lst)
+  (let loop ((lst lst))
+    (if (null? lst) '()
+        (if (pred (car lst))
+            (cons (car lst) (loop (cdr lst)))
+            (loop (cdr lst))))))
+
+(define (delete x lst)
+  (filter (lambda (e) (not (equal? e x))) lst))
+
+(define (delq x lst)
+  (filter (lambda (e) (not (eq? e x))) lst))
+
+(define (vector-copy x)
+  (list->vector (vector->list x)))
+
 (define (eof-object? x)
   (or (and (number? x) (= x -1))
       (and (char? x) (eof-object? (char->integer x)))))