ref: 397265f5791291defa76487c2388e1898e2e433c
dir: /tools/make_cart.scm/
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; Language Technologies Institute ;;;
;;; Carnegie Mellon University ;;;
;;; Copyright (c) 2000 ;;;
;;; 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 2000 ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; Generate C compilable CART trees. ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar val_table_length 0)
(define (carttoC name tree odir)
"(carttoC NAME TREE ODIR)
Coverts a CART tree to a single C file called ODIR/NAME_cart.c."
(let
((ofdc (fopen (path-append odir (string-append name "_cart.c")) "w"))
(ofdh(fopen (path-append odir (string-append name "_cart.h")) "w")))
(format ofdc "/*******************************************************/\n")
(format ofdc "/** Autogenerated cart trees for %s */\n" name)
(format ofdc "/*******************************************************/\n")
(format ofdc "\n")
(format ofdc "#include \"cst_string.h\"\n")
(format ofdc "#include \"cst_cart.h\"\n")
(format ofdc "#include \"cst_regex.h\"\n")
(format ofdc "#include \"%s_cart.h\"\n" name)
(format ofdh "/*******************************************************/\n")
(format ofdh "/** Autogenerated cart tree for %s */\n" name)
(format ofdh "/** from %s */\n" odir)
(format ofdh "/*******************************************************/\n")
(format ofdh "\n")
(set! current_node -1)
(set! val_table nil)
(set! feat_nums nil)
(do_carttoC ofdc ofdh name tree)
(fclose ofdc)
(fclose ofdh)
))
(define (do_carttoC ofdc ofdh name tree)
"(do_carttoC ofdc ofdh name tree)
Do the tree dump, this section is split off for cases when we
want multiple trees in the same file."
(set! cart_name name)
(format ofdc "\n")
(format ofdc "static const cst_cart_node %s_cart_nodes[] = {\n" name)
(carttoC_tree_nodes tree ofdc ofdh)
(format ofdc "{ 255, CST_CART_OP_NONE, 0, 0}};\n\n")
;; definitions are in the .h file
; (mapcar
; (lambda (f)
; (format ofdc "%s" (caddr f)))
; (reverse val_table))
(format ofdc "\n")
(format ofdc "static const char * const %s_feat_table[] = {\n" name)
(mapcar
(lambda (f)
(if (string-equal "string" (typeof (car f)))
(format ofdc "%s,\n" (car f))
(format ofdc "\"%s\",\n" (car f))))
(reverse feat_nums))
(format ofdc "NULL };\n\n")
(format ofdc "const cst_cart %s_cart = {\n" name)
(format ofdc " %s_cart_nodes,\n" name)
(format ofdc " %s_feat_table\n" name)
(format ofdc "};\n")
t
)
(defvar cart_operators
'(("is" "CST_CART_OP_IS")
("in" "CST_CART_OP_IN")
("<" "CST_CART_OP_LESS")
(">" "CST_CART_OP_GREATER")
("matches" "CST_CART_OP_MATCHES")
("=" "CST_CART_OP_EQUALS")))
(define (carttoC_feat_num f)
(let ((fn (assoc_string f feat_nums)))
(cond
(fn
(cadr fn))
(t
(set! feat_nums
(cons (list f (length feat_nums))
feat_nums))
(carttoC_feat_num f)))))
(define (carttoC_val_table ofdh f operator)
(let ((fn (if (number? f)
nil ;; if its a number don't try to share it
(assoc_string
(if (string-equal operator "is")
(format nil "is_%s" f)
f)
val_table))))
(if (null val_table)
(begin
(set! val_table_length 0)
(set! val_table (cons (list "_xxx" "_xxx" nil)))))
(cond
(fn
; (format t "awb_debug reused_val %l\n" fn)
(cadr fn))
(t
(let ((nname (format nil "val_%04d" val_table_length)))
(set! val_table_length (+ 1 val_table_length))
(set! val_table_key
(if (string-equal operator "is")
(format nil "is_%s" f)
f))
; (format ofdh "static const cst_val %s;\n" nname)
(cond
((string-equal operator "is")
(set! val_table
(cons (list val_table_key nname
(format ofdh "DEF_STATIC_CONST_VAL_STRING(%s,\"%s\");\n"
nname f))
val_table)))
((string-equal "matches" operator)
(set! val_table
(cons (list val_table_key nname
(format ofdh "DEF_STATIC_CONST_VAL_INT(%s,CST_RX_%s_NUM);\n"
nname f))
val_table)))
((number? f)
(format ofdh "DEF_STATIC_CONST_VAL_FLOAT(%s,%f);\n"
nname f))
((consp f)
(format stderr "list vals not supported here yet\n")
(error f))
(t
(set! val_table
(cons (list val_table_key nname
(format ofdh "DEF_STATIC_CONST_VAL_STRING(%s,\"%s\");\n"
nname f))
val_table))))
; (format t "awb_debug new_val %l\n" (car val_table))
nname
)))))
(define (carttoC_tree_nodes tree ofdc ofdh)
"(carttoC_tree_nodes tree ofdc ofdh)
Dump the nodes in the tree."
(let ((this_node (set! current_node (+ 1 current_node))))
(cond
((cdr tree) ;; a question node
(format ofdc "{ %d, %s, %s, (cst_val *)&%s},\n"
(carttoC_feat_num (caar tree)) ;; the feature
(cadr (assoc_string ;; operator
(cadr (car tree))
cart_operators))
(format nil "CTNODE_%s_NO_%04d" cart_name this_node); the no node
(carttoC_val_table ofdh
(nth 2 (car tree))
(cadr (car tree))))
(carttoC_tree_nodes (car (cdr tree)) ofdc ofdh)
(format ofdh "#define CTNODE_%s_NO_%04d %d\n" cart_name
this_node (+ 1 current_node))
(carttoC_tree_nodes (car (cdr (cdr tree))) ofdc ofdh))
(t ;; a leaf node
(format ofdc
"{ 255, CST_CART_OP_NONE, 0, (cst_val *)&%s },\n"
(carttoC_extract_answer ofdh tree))))))
(define (carttoC_extract_answer ofdh tree)
"(carttoC_extract_answer tree)
Get answer from leaf node. (this can be redefined if you want different
behaviour)."
(carttoC_val_table ofdh
(car (last (car tree)))
'none))
(set! basic_carttoC_extract_answer carttoC_extract_answer)
(provide 'make_cart)