Changeset 26988 in project


Ignore:
Timestamp:
07/05/12 06:32:57 (9 years ago)
Author:
Ivan Raikov
Message:

nemo: completed corrections to ixml input parser

Location:
release/4/nemo/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/nemo/trunk/expr-parser.scm

    r26982 r26988  
    134134              ((else ELSE Else)    (tok loc ELSE))
    135135              (else
    136                (tok loc ID  (read-id (list c)))))
     136               (tok loc ID id)))
    137137            ))
    138138         ((or (char=? c #\space)
  • release/4/nemo/trunk/nemo-core.scm

    r26982 r26988  
    338338                       (exports       (environment-ref nemo-env exports-sym)))
    339339                  (cases nemo:quantity exports
    340                          (EXPORTS (lst) (environment-set! nemo-env exports-sym (EXPORTS (cons sym lst))))
     340                         (EXPORTS (lst) (environment-extend! nemo-env exports-sym (EXPORTS (cons sym lst))))
    341341                         (else  (nemo:error 'add-external! ": invalid exports entry " exports))))))
    342342             
     
    366366  (define (env-extend! nemo-env)
    367367    (lambda (name type initial . alst)
     368
    368369       (let* ((sym (if (symbol? name) name (string->symbol name)))
    369370              (arity-check (make-arity-check nemo-env))
     
    517518                                    (lambda ,formals ,body)))
    518519                       (f      (eval fc const-env)))
    519                   (let* ((ftenv  (make-environment))
     520                  (let* ((ftenv  (make-environment #t))
    520521                         (rt     (infer nemo-env ftenv body))
    521522                         (ftypes (filter-map (lambda (x)
     
    625626                   (COMPONENT (name type lst scope-subst) 
    626627                              (let ((en1 (COMPONENT name type (delete-duplicates (append lst (list sym))) scope-subst)))
    627                                 (environment-set! nemo-env comp-name en1)))
     628                                (environment-extend! nemo-env comp-name en1)))
    628629                   (else (nemo:error 'component-extend! ": invalid component " comp-name)))
    629630            (nemo:error 'component-extend! ": invalid component " comp-name)))))
     
    797798                     (else (nemo:error 'exam name ": unknown type of quantity"))))))))
    798799 
     800  (define (eval-simple-expr env expr)
     801    (cond ((number? expr) expr)
     802          ((symbol? expr) (environment-ref env expr))
     803          ((pair? expr)   (let ((expr1 (map (lambda (x) (eval-simple-expr env x)) expr)))
     804                            (apply (car expr1) (cdr expr1))))))
    799805
    800806  (define (eval-const nemo-env expr)
     
    804810            (const-env (make-const-env nemo-env)))
    805811        (condition-case
    806          (exact->inexact (eval expr1 const-env))
     812         (exact->inexact (eval-simple-expr const-env expr1))
    807813         [var () expr1])
    808814        )))
     
    10351041   (let ((res
    10361042          (let loop ((ds declarations) (qs (list)) (scope #f) (scope-subst '()))
     1043
    10371044            (if (null? ds) 
    10381045                (let ((qs (reverse qs)))
     
    10401047                      (let* ((top-syms   ((nemo-core 'component-symbols ) sys (nemo-intern 'toplevel)))
    10411048                             (top-syms1  (append qs top-syms)))
    1042                         (environment-set! sys (nemo-intern 'toplevel) (COMPONENT 'toplevel 'toplevel top-syms1 '()))))
     1049                        (environment-extend! sys (nemo-intern 'toplevel) (COMPONENT 'toplevel 'toplevel top-syms1 '()))))
    10431050                  (list qs scope-subst))
    10441051                (let ((decl (car ds)))
    1045                   (print "decl = " decl)
     1052                  (if (null? decl)
     1053                      (loop (cdr ds) qs scope scope-subst)
    10461054                  (match-let
    10471055                   (((qs1 scope-subst1)
     
    12031211                            (((or 'sysname 'SYSNAME) name) 
    12041212                             (if (symbol? name)
    1205                                  (environment-set! sys (nemo-intern 'name) (SYSNAME name))
     1213                                 (environment-extend! sys (nemo-intern 'name) (SYSNAME name))
    12061214                                 (nemo:error 'eval-nemo-system-decls
    12071215                                             "system name must be a symbol")))
     
    12251233                                 (match-let (((cqs scope-subst1)   (loop lst (list) scope scope-subst)))
    12261234                                            (let ((comp  (COMPONENT name1 typ cqs scope-subst1)))
    1227                                               (environment-set! sys sym comp)
     1235                                              (environment-extend! sys sym comp)
    12281236                                              (list (cons sym qs) scope-subst1))))))
    12291237
     
    12331241                                   (match-let (((cqs scope-subst1)   (loop lst (list) scope scope-subst)))
    12341242                                      (let ((comp  (COMPONENT sym typ cqs scope-subst1)))
    1235                                         (environment-set! sys sym comp)
     1243                                        (environment-extend! sys sym comp)
    12361244                                        (list (cons sym qs) scope-subst1)))))
    12371245
     
    12781286                                    (let* ((sym    (fresh "comp"))
    12791287                                           (comp   (COMPONENT name functor-type (append cqs1 cqs2) scope-subst2)))
    1280                                       (environment-set! sys sym comp)
     1288                                      (environment-extend! sys sym comp)
    12811289                                     
    12821290                                      (list (cons sym qs) '())))))))
    12831291                             
    12841292                            (((or 'functor 'FUNCTOR) ((or 'name 'NAME) name) ((or 'type 'TYPE) typ)
    1285                               ((or 'args 'ARGS) (and args (? list?)))  '= . lst)
     1293                              (and args (? list?))  '= . lst)
    12861294
    12871295                             (if (and scope scope-subst)
     
    12921300                               (if (environment-has-binding? sys sym)
    12931301                                   (nemo:error 'eval-nemo-system-decls! ": functor " sym " already defined"))
    1294                                (environment-set! sys sym functor)
     1302                               (environment-extend! sys sym functor)
    12951303                               (list (cons sym qs) '())))
    12961304                           
     
    13551363                                         ))
    13561364                            )))
    1357            (loop (cdr ds) qs1 scope scope-subst1)))
     1365           (loop (cdr ds) qs1 scope scope-subst1))))
    13581366        ))))
    13591367     res
  • release/4/nemo/trunk/nemo.scm

    r26983 r26988  
    602602        (sxml:match 'ncml:input
    603603                    (lambda (node bindings root env)
    604                       (let ((id    (sxml:attr node 'id))
     604                      (let ((id    (or (sxml:attr node 'id) (sxml:attr node 'name)))
    605605                            (from  (sxml:kidn* 'ncml:from node))
    606606                            (as    (sxml:kidn* 'ncml:as node)))
     
    622622        (sxml:match 'ncml:const
    623623                    (lambda (node bindings root env)
    624                       (print "const: node = " node)
    625624                      (let* ((id   (or (sxml:attr node 'id)
    626625                                       (sxml:attr node 'name)))
    627626                             (expr ((lambda (x)
    628                                       (print "const: x = " x)
    629 
    630627                                      (if (not x) 
    631628                                          (error 'const-template "const declaration " id " requires expr element")
     
    719716                            (conserve ((lambda (x)
    720717                                         (and x (let ((tmpl (sxml:make-null-ss conseq-template)))
    721                                                   (stx:apply-templates (second x) tmpl root env))))
     718                                                  (stx:apply-templates (cons 'ncml:conseq (cdr x)) tmpl root env))))
    722719                                       (sxml:kidn* 'ncml:conserve node)))
    723720
     
    748745        (sxml:match 'ncml:defun
    749746                    (lambda (node bindings root env)
    750 
    751                       (print "defun node: node = ") (pp node)
    752747
    753748                      (let* ((id    (or (sxml:attr node 'id)
     
    759754                                           (map (compose $ second) x)))
    760755                                     (sxml:kidsn 'ncml:arg node)))
    761                              (dd (print "args = " args))
    762756                             (body ((lambda (x)
    763                                       (print "body = " x)
    764                                      
    765757                                      (if (not x) 
    766758                                          (error 'defun-template
     
    775767        (sxml:match 'ncml:component
    776768                    (lambda (node bindings root env)
    777 
    778                       (print "component node: node = ")
    779                       (pp node)
    780769
    781770                      (let ((name (sxml:attr node 'name))
     
    812801                            (error 'functor-template "functor definition requires parameters attribute"))
    813802                        `(functor (name ,($ name)) (type ,($ type))
    814                                   (args ,(map string->symbol (string-split parameters ",")))
     803                                  ,(map string->symbol (string-split parameters ","))
    815804                                  = . ,(ncml->declarations (sxml:kids node) parse-expr))))))
    816805
     
    819808                    (lambda (node bindings root env)
    820809                      (let* (
    821                              (id         (sxml:attr node 'id))
     810                             (id         (or (sxml:attr node 'id) (sxml:attr node 'name)))
    822811                             (and-expr   (lambda (x) (and x (parse-expr (second x) id))))
    823812                             (initial_m  (and-expr (sxml:kidn* 'ncml:initial_m node)))
     
    900889                           (if (null? x) (error 'ncml->model "ncml:model element not found in input document") (car x)))
    901890                         (ncml:sxpath '(// ncml:model) `(*TOP* . ,doc))))
    902          (model-name     (sxml:attr ncml:model 'name))
     891         (model-name     (or (sxml:attr ncml:model 'name) (gensym 'model)))
    903892         (membraneprops  (ncml:sxpath '(// cell biophysicalProperties membraneProperties)
    904893                                      `(*TOP* . ,ncml:model)))
     
    916905           (nemo        (second model+nemo)))
    917906
    918       (let ((model-1 (nemo:hh-transformer model (alist-ref 'hh-markov options) identity)))
     907      (let ((model-1 (nemo:hh-transformer model (alist-ref 'hh-markov options) (lambda (x . rest) (identity x)))))
     908
    919909        (if (assoc 'depgraph options) (print "dependency graph: " ((nemo 'depgraph*) model-1)))
    920910        (if (assoc 'exports options) (print "exports: " ((nemo 'exports) model-1)))     
     
    10621052                                 ((sexp)        identity)
    10631053                                 ((ixml)        (lambda (x #!optional loc)
    1064                                                   (print "ixml parse-expr: x = " x)
    10651054                                                  (let ((xs (if (string? x) x
    10661055                                                                (string-concatenate
     
    10701059                                                                                (->string el))))
    10711060                                                                      x)))))
    1072                                                     (print "ixml parse-expr: xs = " xs)
    10731061                                                    (nemo:parse-string-expr xs loc))))
    10741062                                 ((nemo)        (if iexpr?
Note: See TracChangeset for help on using the changeset viewer.