Changeset 27322 in project

Timestamp:

08/29/12 03:30:51 (9 years ago)

Author:

Ivan Raikov

Message:

9ML-toolkit: additional fixes to eval module

File:

• release/4/9ML-toolkit/trunk/eval.scm (modified) (10 diffs)

release/4/9ML-toolkit/trunk/eval.scm

@@ -100 +100 @@
 
 (define (sxml-term->sexpr term)
-  (print "term = " term)
   (let ((tree
          (sxml:pre-post-order* 
@@ -111 +110 @@
               (string *preorder* . ,(lambda (tag elems) (sxml:text elems)))
               
-              (real *preorder* . ,(lambda (tag elems) (string->number (sxml:text elems))))
+              (real *preorder* . ,(lambda (tag elems) 
+                                    (let ((v (sxml:text elems)))
+                                      (if (number? v) v (string->number v)))))
               
-              (nat  *preorder* . ,(lambda (tag elems) (string->number (sxml:text elems))))
+              (nat  *preorder* . ,(lambda (tag elems) 
+                                    (let ((v (sxml:text elems)))
+                                      (if (number? v) v (string->number v)))))
               
               (bool *preorder* . ,(lambda (tag elems) (if (string=? (sxml:text elems) "true") #t #f)))
@@ -130 +133 @@
                                       (let ((formal (string->symbol (sxml:attr (cons tag elems) 'formal)))
                                             (body (sxml:kid elems)))
-                                        (print "Function body = " body)
-                                        (print "Function formal = " formal)
                                         `(lambda (,formal) ,(sxml-term->sexpr body)))))
             (Let0 *preorder* . ,(lambda (tag elems)
@@ -154 +155 @@
         `(let (,ax) ,fin)
         (let ((en (car env)))
-          (print "en = " en)
-          (print "ax = " ax)
           (let ((name (string->symbol (sxml:attr en 'name)))
                 (value (sxml-value->sexpr (sxml:kid en))))
-            (print "value = " value)
             (let ((en (list name value)))
               (recur (cdr env) (if value (cons en ax) ax))
@@ -166 +164 @@
                                          
 (define (sxml-value->sexpr tree)
-  (print "tree = " tree)
     (let* ((tree 
             (sxml:pre-post-order* 
@@ -174 +171 @@
                       ,(lambda (tag elems) 
                          (let ((node (cons tag elems)))
-                           (print "Tuple elems = " elems)
                            (let ((left (sxml:kidn-cadr 'left node))
-                                 (right (sxml:kidn-cdr 'right node)))
-                             (print "left = " left)
-                             (print "right = " right)
-                             (cons left right)))
+                                 (right (sxml:kidn-cadr 'right node)))
+
+                             (list left right)))
                          ))
 
@@ -187 +182 @@
                       (string . ,(lambda (tag elems) (car elems)))
                       
-                      (real . ,(lambda (tag elems) (string->number (car elems))))
+                      (real . ,(lambda (tag elems) (let ((v (car elems)))
+                                                     (if (number? v) v (string->number v)))))
                       
-                      (nat  . ,(lambda (tag elems) (string->number (car elems))))
+                      (nat  . ,(lambda (tag elems) (let ((v (car elems)))
+                                                     (if (number? v) v (string->number v)))))
                       
                       (bool . ,(lambda (tag elems) (if (string=? (car elems) "true") #t #f)))
@@ -200 +197 @@
 
                       ) . ,(lambda (tag elems) 
-                             (print "Const elems = " elems)
                              (car elems)))
 
@@ -214 +210 @@
                           ))
 
+              (null . ,(lambda (tag elems) '()))
 
               (*text* . ,(lambda (trigger str) str))
@@ -238 +235 @@
               (cond ((or (atom? tree) (null? tree) (null? (cdr tree))) tree)
                     (else (cons (flatten (car tree)) 
-                                (flatten (cadr tree))))))))
+                                (flatten (cadr tree)))))))
+
+             )
       tree))