(datatype option
  (some val)
  (none))

(define some option.some)
(define some? option.some?)
(define some->val option.some->val)
(define (option->val-with-default thing default)
  (if (option.none? thing)
      default
      (option.some->val thing)))
  
(define none option.none)
(define none? option.none?)

(define (or-map p? xs)
  (and (pair? xs)
       (or (p? (car xs))
           (or-map p? (cdr xs)))))

(define (filter pred lst)
  (if (null? lst)
      '()
      (if (pred (car lst))
          (cons (car lst) (filter pred (cdr lst)))
          (filter pred (cdr lst)))))

(define (fold-left f accu l)
  (if (null? l)
      accu
      (fold-left f (f accu (car l)) (cdr l))))

; can only handle list of lists
;(define (flatten xss)
;  (apply append xss))
; can handle every type of list
(define (flatten lists)
  (if (null? lists)
      lists
      (if (list? (car lists))
	  (append (flatten (car lists)) (flatten (cdr lists)))
	  (cons (car lists) (flatten (cdr lists))))))

(define (string-for-each p s)
  (do ((l (string-length s))
       (i 0 (+ 1 i)))
      ((= i l))
    (p (string-ref s i))))

(define (my-map f lst)
  (cond ((null? lst)
	 '())
	((null? (cdr lst))
	 (cons (f (car lst) #f) (my-map f (cdr lst))))
	(else
	 (cons (f (car lst) (cadr lst)) (my-map f (cdr lst))))))

(define (my-filter-map f lst)
  (cond ((null? lst)
	 '())
	((null? (cdr lst))
	 (let ((erg (f (car lst) #f)))
	   (if erg
	       (cons erg (my-filter-map f (cdr lst)))
	       (my-filter-map f (cdr lst)))))
	(else
	 (let ((erg (f (car lst) (cadr lst))))
	   (if erg
	       (cons erg (my-filter-map f (cdr lst)))
	       (my-filter-map f (cdr lst)))))))

(define (take n lst)
  (if (or (null? lst) (<= n 0))
      '()
      (cons (car lst) (take (- n 1) (cdr lst)))))

(define (sublist begin end lst)
  (take (+ (- end begin) 1) (list-tail lst begin)))

(define (c-prog->stream filename)
  (list->stream
   (call-with-input-file filename
     (lambda (port)
       (let loop ()
	 (let ((c (read-char port)))
	   (if (eof-object? c)
	       '()
	       (cons c (loop)))))))))

(define (writelpp l filename)
  (with-output-to-file filename
    (lambda ()
      (for-each p l)))) 


;;; return first or second optional argument
;;; if existant, otherwise a default value
(define (safe-first x default) 
  (if (null? x)
      default
      (car x)))

(define (safe-second x default) 
  (if (or (null? x)
	  (null? (cdr x)))
      default
      (cadr x)))

;;; (string-join string-list [delimiter grammar]) => string
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Paste strings together using the delimiter string.
;;;
;;; (join-strings '("foo" "bar" "baz") ":") => "foo:bar:baz"
;;;
;;; DELIMITER defaults to a single space " "
;;; GRAMMAR is one of the symbols {prefix, infix, strict-infix, suffix} 
;;; and defaults to 'infix.

;; slightly adopted from srfi-13
;; changes: * hand-written "let-optionals"
;;          * (apply string-append ...) instead of (string-concatenate ...)
;;            (srfi-13 says this will blow, if we have many many arguments,
;;             I hope, we won't...)
(define (string-join strings . delim+grammar)
  (let* ((delim (safe-first delim+grammar " "))
	 (grammar (safe-second delim+grammar 'infix)))
    ; parameter check:
    (cond 
     ((not (string? delim))
      (error "string-join: delimiter must be a string ~a" delim))
     ((> (length delim+grammar) 2) 
      (error "wrong number of arguments to string-join: ~a" delim+grammar)))
      
    (let ((buildit (lambda (lis final)
		     (let recur ((lis lis))
		       (if (pair? lis)
			   (cons delim (cons (car lis) (recur (cdr lis))))
			   final)))))

      (cond ((pair? strings)
	     (apply string-append
	      (case grammar

		((infix strict-infix)
		 (cons (car strings) (buildit (cdr strings) '())))

		((prefix) (buildit strings '()))

		((suffix)
		 (cons (car strings) (buildit (cdr strings) (list delim))))

		(else (error "Illegal join grammar"
			     grammar string-join)))))

	     ((not (null? strings))
	      (error "STRINGS parameter not list." strings string-join))

	     ;; STRINGS is ()

	     ((eq? grammar 'strict-infix)
	      (error "Empty list cannot be joined with STRICT-INFIX grammar."
		     string-join))

	     (else "")))))	; Special-cased for infix grammar.