#! /bin/sh
# restart with -*- scheme -*-
exec guile -s $0 "$@"
!#

(debug-enable 'debug)
(debug-enable 'backtrace)
(read-enable 'positions)

;;;  Copyright (C) 1998,1999,2000,2001  Marius Vollmer
;;;
;;;  VAUL is free software; you can redistribute it and/or modify it
;;;  under the terms of the GNU Library General Public License as
;;;  published by the Free Software Foundation; either version 2 of the
;;;  License, or (at your option) any later version.
;;;
;;;  VAUL is distributed in the hope that it will be useful, but WITHOUT
;;;  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;;;  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General
;;;  Public License for more details.
;;;
;;;  You should have received a copy of the GNU Library General Public
;;;  License along with VAUL; see the file COPYING.LIB.  If not, write
;;;  to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;  Boston, MA 02111-1307 USA.

;; TODO
;;
;; - give correct position for (err ...)

;; This is `gen-nodes', the Scheme program used to generate the C++
;; rendition of the data types used in the intermediate
;; representation.

;;; Used modules.

;; We include them here inline to make gen-nodes selfcontained.

(define-module (struct)
  :use-module (ice-9 common-list))

(defmacro-public define-struct (tag . fields)
  (let ((type-sym (gensym))
	(field-syms (map (lambda (f)
			   (if (pair? f) (car f) f))
			 fields))
	(make-parms (remove-if pair? fields))
	(make-args (map (lambda (f)
			  (if (pair? f) (cadr f) f))
			fields)))
    `(begin
       (define ,type-sym (make-record-type ',tag ',field-syms))
       (define ,(symbol-append 'make- tag)
	 (let ((maker (record-constructor ,type-sym)))
	   (lambda ,make-parms
	     (maker ,@make-args))))
       (define ,(symbol-append tag '?) (record-predicate ,type-sym))
       ,@(map (lambda (f)
		`(define ,(symbol-append tag '- f)
		   (record-accessor ,type-sym ',f)))
	      field-syms)
       ,@(map (lambda (f)
		`(define ,(symbol-append 'set- tag '- f '!)
		   (record-modifier ,type-sym ',f)))
	      field-syms))))

(define-module (mini-format))

(define-public (format-with-list-template dst fmt . args)
  (cond
   ((eq? dst #t)
    (apply format-with-list-template (current-output-port) fmt args))
   ((eq? dst #f)
    (call-with-output-string
     (lambda (p)
       (apply format-with-list-template p fmt args))))
   (else
    (let loop ((fmt fmt)
	       (args args))
      (if (null? fmt)
	  #t
	  (let ((f (car fmt)))
	    (cond
	     ((string? f)
	      (display f dst)
	      (loop (cdr fmt) args))
	     ((procedure? f)
	      (loop (cdr fmt) (f args dst)))
	     (else
	      (error "unknown formatting op" f)))))))))

(define (fmt-display args dst)
  (display (car args) dst)
  (cdr args))

(define (fmt-write args dst)
  (write (car args) dst)
  (cdr args))

(define (fmt-newline args dst)
  (newline dst)
  args)

(define-public (string-template->list-template fmt)
  (let ((tilde (string-index fmt #\~)))
    (if (and tilde (< tilde (string-length fmt)))
	(let* ((prefix (substring fmt 0 tilde))
	       (arg (string-ref fmt (+ tilde 1))))
	  (if (not (memq arg '(#\a #\d #\s #\%)))
	      #f
	      (let* ((rest (string-template->list-template
			    (substring fmt (+ tilde 2))))
		     (subst
		      (case arg
			((#\a #\d)
			 fmt-display)
			((#\s)
			 fmt-write)
			((#\%)
			 (set! prefix (string-append prefix "\n"))
			 #f))))
		(and rest
		     (if (zero? (string-length prefix))
			 (cons subst rest)
			 (cons prefix (if subst
					  (cons subst rest)
					  rest)))))))
	;; no ~ in fmt
	(if (zero? (string-length fmt))
	    '()
	    (list fmt)))))

(defmacro-public mini-format-macro (dst fmt . args)
  (let ((m-fmt (and (string? fmt) (string-template->list-template fmt))))
    (if m-fmt
	`(format-with-list-template ,dst ',m-fmt ,@args)
	(error "unsupported format template" fmt))))

(define-public (mini-format dst fmt . args)
  (let ((m-fmt (and (string? fmt) (string-template->list-template fmt))))
    (if m-fmt
	(apply format-with-list-template dst m-fmt args)
	(error "unsupported format template" fmt))))

;;; Start of gen-nodes.

(define-module (gen-nodes)
  :use-module (mini-format)
  :use-module (struct)
  :use-module (ice-9 common-list)
  :use-module (ice-9 regex))

(if (not (defined? 'read-line))
    (use-modules (ice-9 rdelim)))

;;; Configuration

(define default-include-path "/usr/include")

;;; Some utility functions

;; Like STRING-APPEND but also works on symbols.

(define (string-append* . args)
  (apply string-append
	 (map (lambda (s)
		(if (symbol? s)
		    (symbol->string s)
		    s))
	      args)))

;; Write ARGS to the current error port and return the last arg.

(define (pk . args)
  (write args (current-error-port))
  (newline (current-error-port))
  (car (last-pair args)))

;; Return a string whose characters are the result of applying PROC to
;; the characters of STR, from left to right.

(define (string-map proc str)
  (if (symbol? str)
      (string-map proc (symbol->string str))
      (let* ((len (string-length str))
	     (str2 (make-string len)))
	(do ((i 0 (1+ i)))
	    ((= i len) str2)
	  (string-set! str2 i (proc (string-ref str i)))))))
  
;; Return a new string that is the upper-case version of STR

(define (upcase str)
  (string-map char-upcase str))

;; A weak imitation of CL push.  Insert X at the front of the list
;; stored in PLACE.  When PLACE is a symbol, this macro expands to
;;
;;   (set! place (cons x place))
;;
;; When PLACE is a list whose first element is a symbol,
;;
;;   (push! x (field s))
;;
;; it essentially expands to
;;
;;   (set-field! s (cons x (field s)))
;;
;; but S is only evaluated once.  This works well with the structures
;; defined by `define-struct'.

(define-macro (push! x place)
  (cond ((symbol? place)
	 `(set! ,place (cons ,x ,place)))
	((and (list? place) (symbol? (car place)))
	 (let ((getter (car place))
	       (setter (symbol-append 'set- (car place) '!))
	       (stmp (gensym)))
	   `(let ((,stmp ,(cadr place)))
	      (,setter ,stmp (cons ,x (,getter ,stmp))))))
	(else
	 (error "bad push! syntax"))))

;; Split STR into its syllables.  Syllable delimiters are "_", "-" and
;; the transition from lower to upper case.  Thus, the strings
;; "Holz_Hacker", "Holz-Hacker" and "HolzHacker" have all three the
;; syllables ("Holz" "Hacker").

(define (syllables str)
  (if (symbol? str)
      (syllables (symbol->string str))
      (do ((syls '())
	   (start 0)
	   (pos 0 (1+ pos))
	   (was-lower #f)
	   (len (string-length str)))
	  ((>= pos len) (reverse (cons (substring str start pos) syls)))
	(let ((ch (string-ref str pos)))
	  (cond ((memq ch '(#\- #\_))
		 (push! (substring str start pos) syls)
		 (set! start (1+ pos)))
		((and was-lower (char-upper-case? ch))
		 (push! (substring str start pos) syls)
		 (set! start pos)))
	  (set! was-lower (char-lower-case? ch))))))

    
;; Concatenate the strings in L (a list) with DEL between them

(define (concat-strings l del)
  (cond ((null? l)
	 "")
	((null? (cdr l))
	 (car l))
	(else
	 (string-append* (car l) del (concat-strings (cdr l) del)))))

;; Execute the BODY once for each element of the list L.  Within BODY,
;; the variable V is bound to the current list element.

(define-macro (do-list v l . body)
  `(for-each (lambda (,v) ,@body) ,l))

;; Print formatted output to the current error port.

(define (info fmt . rest)
  (apply mini-format (current-error-port) fmt rest))

;; Like INFO, but also print the position of the current input port.
;; Then throw a `processing-error'.  That is, the execution of
;; gen-nodes is aborted.

(define (err fmt . rest)
  (let ((port (current-input-port)))
    (info "~a:~a: " (port-filename port) (port-line port))
    (apply info fmt rest)
    (info "~%")
    (throw 'processing-error)))

;; Print formatted output to the current output port.  The current
;; output port is usually the generated file when this function is
;; called.

(define (emit fmt . rest)
  (apply mini-format (current-output-port) fmt rest))

;;; Input

;; The input files are evaluated as regular Scheme code.  Definition
;; statements like `defnode', etc are reall                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    