#! /usr/bin/env gosh
;;
;; egauche - embedding gauche codes into a text file.
;; by Satoru Takabayashi <satoru@namazu.org>
;;
;; % cat foo.txt
;; 1 + 2 = [(+ 1 2)]
;;
;; % egauche < foo.txt
;; 1 + 2 = 3
;;

(use gauche.regexp)
(use srfi-1)
(use srfi-13)

(define (substring2 string start)
  (substring string start (string-length string)))

(define (read-file file-name)
  (port->string (open-input-file file-name)))

(define (egauche input-file)
  (define (scheme-start contents)
    (let ((m (rxmatch #/([^\[]|\\\[)+/ contents)))
      (cond ((string-null? contents)
	     #f)
	    ((eq? (string-ref contents 0) #\[)
	     0)
	    ((and m (< (rxmatch-end m) (string-length contents)))
	     (rxmatch-end m))
	    (else #f))))
    
  (define (scheme-end contents start)
    (let ((m (rxmatch #/([^\]]|\\\])+/ (substring2 contents start))))
      (if (and m
	       (< (+ start (rxmatch-end m)) (string-length contents)))
	  (+ start (rxmatch-end m))
	  (errorf "Unmatched bracket at ~a" start))))

  (define (eval-string string)
    (let1 sexp-list (call-with-input-string string port->sexp-list)
          (let loop ((sexp-list sexp-list))
            (let1 value (eval (car sexp-list) (interaction-environment))
                  (if (null? (cdr sexp-list))
                      value
                      (loop (cdr sexp-list)
                            ))))))

  (define (eval-string-display string)
    (let ((val (eval-string string)))
      (if (and val (not (eq? (class-of val) <unknown>)))
	  (display val))))

  (define (unescape string)
    (let loop ((string string)
	       (result ""))
      (let ((pos (string-index string #\\)))
	(if pos
	    (loop (substring2 string (+ pos 1)) 
		  (string-append result (substring string 0 pos)))
	    (string-append result string)))))
	       
  (let1 contents (read-file input-file)
        (let loop ((contents contents))
          (let ((start (scheme-start contents)))
            (if start
                (let* ((end (scheme-end contents start))
                       (preceded-string (substring contents 0 start)))
                  (display (unescape preceded-string))
                  (eval-string-display (substring contents
                                                  (+ start 1)
                                                  end))
                  (loop (substring2 contents (+ end 1))))
                (display (unescape contents)))))
        ))

(define (usage)
  (display "Usage: egauche <input-file>")
  (newline))

(define (main args)
  (if (not (= (length args) 2))
      (usage)
      (egauche (cadr args)))
  0)