Changeset 12967 in project


Ignore:
Timestamp:
01/09/09 08:32:12 (12 years ago)
Author:
Ivan Raikov
Message:

Bug fixes in the functor code.

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

Legend:

Unmodified
Added
Removed
  • release/3/nemo/trunk/examples/AKP06/AKP06.nemo

    r12960 r12967  
    457457     ;; end Na current
    458458
    459 #|       
    460          
    461459     (component (name Narsg) =
    462                 Nafun ((const Narsg_Con   = 0.005)
    463                        (const Narsg_Coff  = 0.5)
    464                        (const Narsg_Oon   = 0.75)
    465                        (const Narsg_Ooff  = 0.005)
     460                Nafun ((const Na_Con   = 0.005)
     461                       (const Na_Coff  = 0.5)
     462                       (const Na_Oon   = 0.75)
     463                       (const Na_Ooff  = 0.005)
    466464                       
    467                        (const Narsg_alfac = (pow ((Narsg_Oon / Narsg_Con) (1.0 / 4.0))))
    468                        (const Narsg_btfac = (pow ((Narsg_Ooff / Narsg_Coff) (1.0 / 4.0))))
     465                       (const Na_alfac = (pow ((Na_Oon / Na_Con) (1.0 / 4.0))))
     466                       (const Na_btfac = (pow ((Na_Ooff / Na_Coff) (1.0 / 4.0))))
    469467                       
    470                        (const Narsg_alpha = 150)
    471                        (const Narsg_beta  = 3)
    472                        (const Narsg_gamma = 150)
    473                        (const Narsg_delta = 40)
    474                        (const Narsg_epsilon = 1.75)
    475                        (const Narsg_zeta = 0.03)
    476                        (const Narsg_x1 = 20)
    477                        (const Narsg_x2 = -20)
    478                        (const Narsg_x3 = 1000000000000.0)
    479                        (const Narsg_x4 = -1000000000000.0)
    480                        (const Narsg_x5 = 1000000000000.0)
    481                        (const Narsg_x6 = -25)))
     468                       (const Na_alpha = 150)
     469                       (const Na_beta  = 3)
     470                       (const Na_gamma = 150)
     471                       (const Na_delta = 40)
     472                       (const Na_epsilon = 1.75)
     473                       (const Na_zeta = 0.03)
     474                       (const Na_x1 = 20)
     475                       (const Na_x2 = -20)
     476                       (const Na_x3 = 1000000000000.0)
     477                       (const Na_x4 = -1000000000000.0)
     478                       (const Na_x5 = 1000000000000.0)
     479                       (const Na_x6 = -25)))
    482480     ;; end Narsg current
    483 |#
     481
    484482
    485483   ))
  • release/3/nemo/trunk/expr-parser.scm

    r12232 r12967  
    7272(define-syntax tok
    7373  (syntax-rules ()
    74     ((tok t) (token (quasiquote t) 0))))
     74    ((tok t) (token (quasiquote t) 0))
     75    ((tok t l) (token (quasiquote t) l))))
    7576
    76 
    77 (define (parse-error msg #!optional arg)
    78   (match arg
    79          [#f (error msg)]
    80          [(or (_ . ($ token symbol value line))
    81               ($ token symbol value line))
    82           (error (conc "line " line ": " msg)
    83                  (conc symbol (if value (conc " " value) "")))]
    84          [_ (error msg arg)]))
     77(define (make-parse-error loc)
     78  (lambda ( msg #!optional arg)
     79    (let ((loc-str (or (and loc (if (list? loc) (conc " " loc " ") (conc " (" loc ") "))) "")))
     80      (match arg
     81             [#f (nemo:error loc-str msg)]
     82             [(or (_ . ($ token (symbol value) line))
     83                  ($ token symbol value line))
     84              (nemo:error (conc "line " line ": " msg) loc-str
     85                          (conc symbol (if value (conc " " value) "")))]
     86             [_ (nemo:error loc-str (conc msg arg))]
     87             ))))
    8588
    8689
     
    106109                      (let ((s (list->string (reverse l))))
    107110                        (let ((n (string->number s)))
    108                           (if (not n) (error "invalid numeric string: " s) n))
     111                          (if (not n) (errorp "invalid numeric string: " s) n))
    109112                          )))))
    110113             (read-id
     
    144147(include "expr.grm.scm")
    145148
    146 (define (nemo:parse-string-expr s)
     149(define (nemo:parse-string-expr s #!optional loc)
    147150  (or (and (string? s) (string-null? s) '())
    148151      (let ((port
    149152             (cond ((string? s)  (open-input-string s))
    150153                   ((port? s)    s)
    151                    (else (error 'nemo:parse-expr "bad argument type: not a string or a port: " s)))))
    152         (expr-parser  (make-char-lexer port parse-error) parse-error))))
     154                   (else (error 'nemo:parse-string-expr "bad argument type: not a string or a port: " s)))))
     155        (expr-parser  (make-char-lexer port (make-parse-error loc))
     156                      (make-parse-error loc)))))
    153157
    154158(define (make-sym-lexer lst errorp)
     
    180184 
    181185
    182 (define (nemo:parse-sym-expr lst)
     186(define (nemo:parse-sym-expr lst #!optional loc)
    183187  (let ((ret (cond ((number? lst)  lst)
    184188                   ((symbol? lst)  lst)
    185189                   ((and (list? lst) (null? lst) '()))
    186                    (else (expr-parser  (make-sym-lexer lst parse-error) parse-error)))))
     190                   (else (expr-parser  (make-sym-lexer lst (make-parse-error loc))
     191                                       (make-parse-error loc))))))
    187192    ret))
    188193   
  • release/3/nemo/trunk/nemo-core.scm

    r12960 r12967  
    924924
    925925(define (eval-nemo-system-decls nemo-core name sys declarations . rest)
    926   (let-optionals rest ((parse-expr identity))
     926  (let-optionals rest ((parse-expr (lambda (x . rest) x)))
    927927   (define (eval-const x) (and x ((nemo-core 'eval-const) sys x)))
    928928   (define env-extend!  ((nemo-core 'env-extend!) sys))
     
    980980                            (((or 'const 'CONST) (and id (? symbol?)) '= (and expr (? expr? )))
    981981                             (let* ((qid    (compute-qid id scope scope-subst))
    982                                     (qexpr  (subst-expr (parse-expr expr) scope-subst))
     982                                    (qexpr  (subst-expr (parse-expr expr `(const ,qid)) scope-subst))
    983983                                    (qval   (eval-const qexpr)))
    984984                               (env-extend! qid '(const) qval)
     
    987987                            ;; state transition complex
    988988                            (((or 'reaction 'REACTION) ((and id (? symbol?)) . alst) )
    989                              (let* ((initial      (lookup-def 'initial alst))
     989                             (let* ((loc          `(reaction ,id))
     990                                    (initial      (lookup-def 'initial alst))
    990991                                    (conserve-eq  (alist-ref 'conserve alst))
    991992                                    (power        (lookup-def 'power alst))
    992993                                    (power-val    (if (expr? power)
    993                                                       (eval-const (subst-expr (parse-expr power) scope-subst))
     994                                                      (eval-const (subst-expr (parse-expr power loc) scope-subst))
    994995                                                      (nemo:error 'eval-nemo-system-decls
    995996                                                                  "invalid power expression" power
     
    10051006                                                      ((a '<-> b r1 r2) (list a b r1 r2)))))
    10061007                                             (if (and rate1 rate2)
    1007                                                  `( <-> ,src ,dst
    1008                                                         ,(subst-expr (parse-expr rate1) scope-subst)
    1009                                                         ,(subst-expr (parse-expr rate2) scope-subst))
    1010                                                  `( -> ,src ,dst ,(subst-expr (parse-expr rate1) scope-subst)))))
     1008                                                 (let ((loc `(,@loc (eq. ,src <-> ,dst))))
     1009                                                   `( <-> ,src ,dst
     1010                                                          ,(subst-expr (parse-expr rate1 loc) scope-subst)
     1011                                                          ,(subst-expr (parse-expr rate2 loc) scope-subst)))
     1012                                                 (let ((loc `(,@loc (eq. ,src -> ,dst))))
     1013                                                   `( -> ,src ,dst ,(subst-expr (parse-expr rate1 loc) scope-subst))))))
    10111014                                          (or (alist-ref 'transitions alst) (list)))))
    10121015                               
    10131016                               (let ((conserve-eq
    1014                                       (and conserve-eq (map (lambda (eq)
    1015                                                               (if (expr? (third eq))
    1016                                                                   `(,(first eq) =
    1017                                                                     ,(subst-expr (parse-expr (third eq)) scope-subst))
    1018                                                                   (nemo:error 'eval-nemo-system-decls
    1019                                                                               "invalid equation " eq)))
    1020                                                             conserve-eq))))
     1017                                      (and conserve-eq
     1018                                           (let ((loc `(,@loc (cons. eqs.))))
     1019                                             (map (lambda (eq)
     1020                                                    (if (expr? (third eq))
     1021                                                        `(,(first eq) =
     1022                                                          ,(subst-expr (parse-expr (third eq) loc) scope-subst))
     1023                                                        (nemo:error 'eval-nemo-system-decls
     1024                                                                    "invalid equation " eq)))
     1025                                                  conserve-eq)))))
    10211026                                 
    10221027                                 (if (and (list? conserve-eq) (not (every lineq? conserve-eq)))
     
    10261031                                 
    10271032                                 (let* ((qid          (compute-qid id scope scope-subst))
    1028                                         (initial-expr (and initial (subst-expr (parse-expr initial) scope-subst)))
     1033                                        (initial-expr (and initial
     1034                                                           (let ((loc `(,@loc (init. eq.))))
     1035                                                             (subst-expr (parse-expr initial loc) scope-subst))))
    10291036                                        (initial-val  (and initial-expr (eval-const initial-expr))))
    10301037                                   (apply env-extend!
    10311038                                          (cons* qid '(reaction) initial-val `(power ,power-val)
    1032                                                  (alist-update! 'conserve conserve-eq
    1033                                                                 (alist-update! 'transitions transitions alst))
    1034                                                  ))
     1039                                                 (cons* `(conserve ,@conserve-eq)
     1040                                                        `(transitions ,@transitions) alst)))
    10351041                                   (list (cons qid qs) (update-subst id qid scope-subst))))))
    10361042                           
     
    10391045                            (((or 'd 'D) ((and id (? symbol?))) '= (and expr (? expr?) ))
    10401046                             (let* ((qid    (compute-qid id scope scope-subst))
    1041                                     (qexpr  (subst-expr (parse-expr expr) scope-subst)))
     1047                                    (qexpr  (subst-expr (parse-expr expr `(rate ,id)) scope-subst)))
    10421048                               (env-extend! qid '(rate) 0.0 `(rhs ,qexpr))
    10431049                               (list (cons qid qs) (update-subst id qid scope-subst))))
     
    10461052                            (((and id (? symbol?)) '= (and expr (? expr?) ))
    10471053                             (let* ((qid    (compute-qid id scope scope-subst))
    1048                                     (qexpr  (subst-expr (parse-expr expr) scope-subst)))
     1054                                    (qexpr  (subst-expr (parse-expr expr `(asgn ,id)) scope-subst)))
    10491055                               (env-extend! qid '(asgn) 'none `(rhs ,qexpr))
    10501056                               (list (cons qid qs) (update-subst id qid scope-subst))))
     
    10541060                              (and idlist (? (lambda (x) (every symbol? x)))) (and expr (? expr?)))
    10551061                             (let ((qid    (compute-qid id scope scope-subst)))
    1056                                (((nemo-core 'defun!) sys) qid idlist (parse-expr expr))
     1062                               (((nemo-core 'defun!) sys) qid idlist (parse-expr expr `(defun ,id)))
    10571063                               (list (cons qid qs) (update-subst id qid scope-subst))))
    10581064                           
     
    10891095                                        (list (cons sym qs) scope-subst1)))))
    10901096
    1091 
    10921097                            (((or 'component 'COMPONENT)  ((or 'name 'NAME) name) '=
    10931098                              (and functor-name (? symbol?)) (and args (? list?)))
     
    11061111                                      (nemo:error 'eval-nemo-system-decls! functor-name
    11071112                                                  " is not a functor" )))))
     1113
    11081114                              (if (not (= (length functor-args)  (length args)))
    11091115                                  (nemo:error 'eval-nemo-system-decls! "functor " functor-name
     
    11281134                                      (comp   (COMPONENT name functor-type (append cqs1 cqs2))))
    11291135                                 (environment-set! sys sym comp)
     1136
    11301137                                 (list (cons sym qs) #f))))))
    11311138                             
Note: See TracChangeset for help on using the changeset viewer.