132 lines
5.5 KiB
Scheme
132 lines
5.5 KiB
Scheme
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;; Language Technologies Institute ;;;
|
||
|
|
;;; Carnegie Mellon University ;;;
|
||
|
|
;;; Copyright (c) 2002 ;;;
|
||
|
|
;;; All Rights Reserved. ;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;; Permission is hereby granted, free of charge, to use and distribute ;;;
|
||
|
|
;;; this software and its documentation without restriction, including ;;;
|
||
|
|
;;; without limitation the rights to use, copy, modify, merge, publish, ;;;
|
||
|
|
;;; distribute, sublicense, and/or sell copies of this work, and to ;;;
|
||
|
|
;;; permit persons to whom this work is furnished to do so, subject to ;;;
|
||
|
|
;;; the following conditions: ;;;
|
||
|
|
;;; 1. The code must retain the above copyright notice, this list of ;;;
|
||
|
|
;;; conditions and the following disclaimer. ;;;
|
||
|
|
;;; 2. Any modifications must be clearly marked as such. ;;;
|
||
|
|
;;; 3. Original authors' names are not deleted. ;;;
|
||
|
|
;;; 4. The authors' names are not used to endorse or promote products ;;;
|
||
|
|
;;; derived from this software without specific prior written ;;;
|
||
|
|
;;; permission. ;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;; CARNEGIE MELLON UNIVERSITY AND THE CONTRIBUTORS TO THIS WORK ;;;
|
||
|
|
;;; DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ;;;
|
||
|
|
;;; ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT ;;;
|
||
|
|
;;; SHALL CARNEGIE MELLON UNIVERSITY NOR THE CONTRIBUTORS BE LIABLE ;;;
|
||
|
|
;;; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES ;;;
|
||
|
|
;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN ;;;
|
||
|
|
;;; AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ;;;
|
||
|
|
;;; ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF ;;;
|
||
|
|
;;; THIS SOFTWARE. ;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; Author: Alan W Black (awb@cs.cmu.edu) ;;;
|
||
|
|
;;; Date: August 2002 ;;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;; Generate a C compilable lts rewrite rules. ;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;; From CMU Flite ;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
(define (lts_norm_rule rule)
|
||
|
|
(let (q w)
|
||
|
|
|
||
|
|
(mapcar
|
||
|
|
(lambda (l)
|
||
|
|
(cond
|
||
|
|
((string-equal l "[")
|
||
|
|
(set! q (list w))
|
||
|
|
(set! w nil))
|
||
|
|
((string-equal l "]")
|
||
|
|
(set! q (cons (reverse w) q))
|
||
|
|
(set! w nil))
|
||
|
|
((string-equal l "=")
|
||
|
|
(set! q (cons (reverse w) q))
|
||
|
|
(set! w nil))
|
||
|
|
(t
|
||
|
|
(set! w (cons l w)))))
|
||
|
|
rule)
|
||
|
|
|
||
|
|
(set! xxx (list
|
||
|
|
(car (cddr q)) ;; reversed left hand side of rules
|
||
|
|
(car (cdr q)) ;; middle condition
|
||
|
|
(flip_stars (car q)) ;; RHS with * reverse
|
||
|
|
(reverse w))) ;; re-write output
|
||
|
|
(format t "%l %l\n" rule xxx)
|
||
|
|
xxx))
|
||
|
|
|
||
|
|
(define (flip_stars q)
|
||
|
|
;; We want klene star to appear before the object
|
||
|
|
(cond
|
||
|
|
((null q) q)
|
||
|
|
((and (cdr q)
|
||
|
|
(string-equal (cadr q) "*"))
|
||
|
|
(cons (cadr q)
|
||
|
|
(cons (car q)
|
||
|
|
(flip_stars (cddr q)))))
|
||
|
|
(t
|
||
|
|
(cons (car q) (flip_stars (cdr q))))))
|
||
|
|
|
||
|
|
(define (ltsrewritestoC name fname odir)
|
||
|
|
"(ltsrewritestoC name idir odir)"
|
||
|
|
|
||
|
|
(let
|
||
|
|
((ofde (fopen (path-append odir (string-append name ".c")) "w"))
|
||
|
|
(ofdh (fopen (path-append odir (string-append name ".h")) "w"))
|
||
|
|
(rules (car (load fname t)))
|
||
|
|
(ifd))
|
||
|
|
(format ofde "/*******************************************************/\n")
|
||
|
|
(format ofde "/** Autogenerated lts rewrite rules for %s */\n" name)
|
||
|
|
(format ofde "/** from %s */\n" name)
|
||
|
|
(format ofde "/*******************************************************/\n")
|
||
|
|
(format ofde "\n")
|
||
|
|
(format ofde "#include \"cst_string.h\"\n")
|
||
|
|
(format ofde "#include \"cst_val.h\"\n")
|
||
|
|
(format ofde "#include \"cst_lts_rewrites.h\"\n")
|
||
|
|
(format ofdh "extern const cst_lts_rewrites %s;\n\n" name)
|
||
|
|
|
||
|
|
(cellstovals
|
||
|
|
(format nil "%s_lts_sets" name)
|
||
|
|
(car (cdr (cdr rules)))
|
||
|
|
ofde)
|
||
|
|
(set! eoc_sets cells_count)
|
||
|
|
(cellstovals
|
||
|
|
(format nil "%s_lts_rules" name)
|
||
|
|
(mapcar
|
||
|
|
lts_norm_rule
|
||
|
|
(car (cdr (cdr (cdr rules)))))
|
||
|
|
ofde)
|
||
|
|
|
||
|
|
(if (equal? eoc_sets 0)
|
||
|
|
(format ofde "#define %s_lts_sets 0\n" name)
|
||
|
|
(format ofde "#define %s_lts_sets &%s_lts_sets_%04d\n"
|
||
|
|
name name eoc_sets))
|
||
|
|
(format ofde "#define %s_lts_rules &%s_lts_rules_%04d\n"
|
||
|
|
name name cells_count)
|
||
|
|
|
||
|
|
(format ofde "\n")
|
||
|
|
(format ofde "const cst_lts_rewrites %s = {\n" name)
|
||
|
|
(format ofde " \"%s\",\n" name)
|
||
|
|
(format ofde " %s_lts_sets,\n" name)
|
||
|
|
(format ofde " %s_lts_rules,\n" name)
|
||
|
|
(format ofde "};\n")
|
||
|
|
(format ofde "\n")
|
||
|
|
|
||
|
|
(fclose ofde)
|
||
|
|
(fclose ofdh)
|
||
|
|
))
|
||
|
|
|
||
|
|
(provide 'make_lts_rewrite)
|