115 lines
5.0 KiB
Scheme
115 lines
5.0 KiB
Scheme
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;; Language Technologies Institute ;;;
|
||
|
|
;;; Carnegie Mellon University ;;;
|
||
|
|
;;; Copyright (c) 2001 ;;;
|
||
|
|
;;; 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: January 2001 ;;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;; Convert a lisp list/tree into a static cst_val const ;;;
|
||
|
|
;;; ;;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
(defvar cells_count 0)
|
||
|
|
(defvar cells_cache nil)
|
||
|
|
|
||
|
|
(define (listtocstval name l ofile)
|
||
|
|
"(listtocstval name l ofile)
|
||
|
|
Converts a lisp list to static C code into ofile."
|
||
|
|
(let ((ofdc (fopen ofile "w")))
|
||
|
|
(format ofdc "/*******************************************************/\n")
|
||
|
|
(format ofdc "/** Autogenerated list structure for %s */\n" name)
|
||
|
|
(format ofdc "/*******************************************************/\n")
|
||
|
|
(format ofdc "\n")
|
||
|
|
(format ofdc "#include \"cst_string.h\"\n")
|
||
|
|
(format ofdc "#include \"cst_val.h\"\n")
|
||
|
|
|
||
|
|
(set! cells_count 0)
|
||
|
|
(set! cells_cache nil)
|
||
|
|
|
||
|
|
(format ofdc "\n\n")
|
||
|
|
|
||
|
|
(cellstovals name l ofdc)
|
||
|
|
(format ofdc "cst_val *%s = &%s_%04d;\n" name name cells_count)
|
||
|
|
|
||
|
|
(format ofdc "\n\n")
|
||
|
|
|
||
|
|
(fclose ofdc)
|
||
|
|
))
|
||
|
|
|
||
|
|
(define (cellsnewname name)
|
||
|
|
(set! cells_count (+ 1 cells_count))
|
||
|
|
(format nil "%s_%04d" name cells_count))
|
||
|
|
|
||
|
|
(define (cellstovals name l ofdc)
|
||
|
|
(let (nn)
|
||
|
|
(cond
|
||
|
|
((null l) "0")
|
||
|
|
((set! nn (assoc l cells_cache))
|
||
|
|
(car (cdr nn)))
|
||
|
|
((consp l)
|
||
|
|
(let ((c_ar (cellstovals name (car l) ofdc))
|
||
|
|
(c_dr (cellstovals name (cdr l) ofdc))
|
||
|
|
(n_name (cellsnewname name)))
|
||
|
|
(if (not (string-equal "0" c_ar))
|
||
|
|
(set! c_ar (string-append "(void *)&" c_ar)))
|
||
|
|
(if (not (string-equal "0" c_dr))
|
||
|
|
(set! c_dr (string-append "(void *)&" c_dr)))
|
||
|
|
(format ofdc "DEF_STATIC_CONST_VAL_CONS(%s,%s,%s);\n"
|
||
|
|
n_name
|
||
|
|
c_ar
|
||
|
|
c_dr)
|
||
|
|
(set! cells_cache (cons (list l n_name)))
|
||
|
|
n_name))
|
||
|
|
((symbol? l)
|
||
|
|
(let ((n_name (cellsnewname name)))
|
||
|
|
(format ofdc "DEF_STATIC_CONST_VAL_STRING(%s,\"%s\");\n"
|
||
|
|
n_name l)
|
||
|
|
(set! cells_cache (cons (list l n_name)))
|
||
|
|
n_name))
|
||
|
|
((equal? 'string (typeof l))
|
||
|
|
(let ((n_name (cellsnewname name)))
|
||
|
|
(format ofdc "DEF_STATIC_CONST_VAL_STRING(%s,%l);\n"
|
||
|
|
n_name l)
|
||
|
|
(set! cells_cache (cons (list l n_name)))
|
||
|
|
n_name))
|
||
|
|
((number? l)
|
||
|
|
(let ((n_name (cellsnewname name)))
|
||
|
|
(format ofdc "DEF_STATIC_CONST_VAL_FLOAT(%s,%s);\n"
|
||
|
|
n_name l)
|
||
|
|
(set! cells_cache (cons (list l n_name)))
|
||
|
|
n_name))
|
||
|
|
(t
|
||
|
|
(format stderr "cannot convert to vals\n")
|
||
|
|
(error l)))))
|
||
|
|
|
||
|
|
(provide 'make_vallist)
|