Alan W Blackfirst commite7e48689 years agoHistory
114 lines · 5.0 KB · Scheme
RawDownload
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                                                                     ;;;;;;                  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)

Keyboard shortcuts

General

Show keyboard shortcuts
?
Focus the current search
/

Issues and pull requests

Open filters
f

Issues, pull requests and Inbox

Select next item
j↓
Select previous item
k↑
Open selected item
Enter
Dismiss filters or clear selection
Esc

Repository code

Go to file
t