Changeset 12967 in project
 Timestamp:
 01/09/09 08:32:12 (11 years ago)
 Location:
 release/3/nemo/trunk
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

release/3/nemo/trunk/examples/AKP06/AKP06.nemo
r12960 r12967 457 457 ;; end Na current 458 458 459 #460 461 459 (component (name Narsg) = 462 Nafun ((const Na rsg_Con = 0.005)463 (const Na rsg_Coff = 0.5)464 (const Na rsg_Oon = 0.75)465 (const Na rsg_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) 466 464 467 (const Na rsg_alfac = (pow ((Narsg_Oon / Narsg_Con) (1.0 / 4.0))))468 (const Na rsg_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)))) 469 467 470 (const Na rsg_alpha = 150)471 (const Na rsg_beta = 3)472 (const Na rsg_gamma = 150)473 (const Na rsg_delta = 40)474 (const Na rsg_epsilon = 1.75)475 (const Na rsg_zeta = 0.03)476 (const Na rsg_x1 = 20)477 (const Na rsg_x2 = 20)478 (const Na rsg_x3 = 1000000000000.0)479 (const Na rsg_x4 = 1000000000000.0)480 (const Na rsg_x5 = 1000000000000.0)481 (const Na rsg_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))) 482 480 ;; end Narsg current 483 # 481 484 482 485 483 )) 
release/3/nemo/trunk/exprparser.scm
r12232 r12967 72 72 (definesyntax tok 73 73 (syntaxrules () 74 ((tok t) (token (quasiquote t) 0)))) 74 ((tok t) (token (quasiquote t) 0)) 75 ((tok t l) (token (quasiquote t) l)))) 75 76 76 77 (define (parseerror 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 (makeparseerror loc) 78 (lambda ( msg #!optional arg) 79 (let ((locstr (or (and loc (if (list? loc) (conc " " loc " ") (conc " (" loc ") "))) ""))) 80 (match arg 81 [#f (nemo:error locstr msg)] 82 [(or (_ . ($ token (symbol value) line)) 83 ($ token symbol value line)) 84 (nemo:error (conc "line " line ": " msg) locstr 85 (conc symbol (if value (conc " " value) "")))] 86 [_ (nemo:error locstr (conc msg arg))] 87 )))) 85 88 86 89 … … 106 109 (let ((s (list>string (reverse l)))) 107 110 (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)) 109 112 ))))) 110 113 (readid … … 144 147 (include "expr.grm.scm") 145 148 146 (define (nemo:parsestringexpr s )149 (define (nemo:parsestringexpr s #!optional loc) 147 150 (or (and (string? s) (stringnull? s) '()) 148 151 (let ((port 149 152 (cond ((string? s) (openinputstring s)) 150 153 ((port? s) s) 151 (else (error 'nemo:parseexpr "bad argument type: not a string or a port: " s))))) 152 (exprparser (makecharlexer port parseerror) parseerror)))) 154 (else (error 'nemo:parsestringexpr "bad argument type: not a string or a port: " s))))) 155 (exprparser (makecharlexer port (makeparseerror loc)) 156 (makeparseerror loc))))) 153 157 154 158 (define (makesymlexer lst errorp) … … 180 184 181 185 182 (define (nemo:parsesymexpr lst )186 (define (nemo:parsesymexpr lst #!optional loc) 183 187 (let ((ret (cond ((number? lst) lst) 184 188 ((symbol? lst) lst) 185 189 ((and (list? lst) (null? lst) '())) 186 (else (exprparser (makesymlexer lst parseerror) parseerror))))) 190 (else (exprparser (makesymlexer lst (makeparseerror loc)) 191 (makeparseerror loc)))))) 187 192 ret)) 188 193 
release/3/nemo/trunk/nemocore.scm
r12960 r12967 924 924 925 925 (define (evalnemosystemdecls nemocore name sys declarations . rest) 926 (letoptionals rest ((parseexpr identity))926 (letoptionals rest ((parseexpr (lambda (x . rest) x))) 927 927 (define (evalconst x) (and x ((nemocore 'evalconst) sys x))) 928 928 (define envextend! ((nemocore 'envextend!) sys)) … … 980 980 (((or 'const 'CONST) (and id (? symbol?)) '= (and expr (? expr? ))) 981 981 (let* ((qid (computeqid id scope scopesubst)) 982 (qexpr (substexpr (parseexpr expr ) scopesubst))982 (qexpr (substexpr (parseexpr expr `(const ,qid)) scopesubst)) 983 983 (qval (evalconst qexpr))) 984 984 (envextend! qid '(const) qval) … … 987 987 ;; state transition complex 988 988 (((or 'reaction 'REACTION) ((and id (? symbol?)) . alst) ) 989 (let* ((initial (lookupdef 'initial alst)) 989 (let* ((loc `(reaction ,id)) 990 (initial (lookupdef 'initial alst)) 990 991 (conserveeq (alistref 'conserve alst)) 991 992 (power (lookupdef 'power alst)) 992 993 (powerval (if (expr? power) 993 (evalconst (substexpr (parseexpr power ) scopesubst))994 (evalconst (substexpr (parseexpr power loc) scopesubst)) 994 995 (nemo:error 'evalnemosystemdecls 995 996 "invalid power expression" power … … 1005 1006 ((a '<> b r1 r2) (list a b r1 r2))))) 1006 1007 (if (and rate1 rate2) 1007 `( <> ,src ,dst 1008 ,(substexpr (parseexpr rate1) scopesubst) 1009 ,(substexpr (parseexpr rate2) scopesubst)) 1010 `( > ,src ,dst ,(substexpr (parseexpr rate1) scopesubst))))) 1008 (let ((loc `(,@loc (eq. ,src <> ,dst)))) 1009 `( <> ,src ,dst 1010 ,(substexpr (parseexpr rate1 loc) scopesubst) 1011 ,(substexpr (parseexpr rate2 loc) scopesubst))) 1012 (let ((loc `(,@loc (eq. ,src > ,dst)))) 1013 `( > ,src ,dst ,(substexpr (parseexpr rate1 loc) scopesubst)))))) 1011 1014 (or (alistref 'transitions alst) (list))))) 1012 1015 1013 1016 (let ((conserveeq 1014 (and conserveeq (map (lambda (eq) 1015 (if (expr? (third eq)) 1016 `(,(first eq) = 1017 ,(substexpr (parseexpr (third eq)) scopesubst)) 1018 (nemo:error 'evalnemosystemdecls 1019 "invalid equation " eq))) 1020 conserveeq)))) 1017 (and conserveeq 1018 (let ((loc `(,@loc (cons. eqs.)))) 1019 (map (lambda (eq) 1020 (if (expr? (third eq)) 1021 `(,(first eq) = 1022 ,(substexpr (parseexpr (third eq) loc) scopesubst)) 1023 (nemo:error 'evalnemosystemdecls 1024 "invalid equation " eq))) 1025 conserveeq))))) 1021 1026 1022 1027 (if (and (list? conserveeq) (not (every lineq? conserveeq))) … … 1026 1031 1027 1032 (let* ((qid (computeqid id scope scopesubst)) 1028 (initialexpr (and initial (substexpr (parseexpr initial) scopesubst))) 1033 (initialexpr (and initial 1034 (let ((loc `(,@loc (init. eq.)))) 1035 (substexpr (parseexpr initial loc) scopesubst)))) 1029 1036 (initialval (and initialexpr (evalconst initialexpr)))) 1030 1037 (apply envextend! 1031 1038 (cons* qid '(reaction) initialval `(power ,powerval) 1032 (alistupdate! 'conserve conserveeq 1033 (alistupdate! 'transitions transitions alst)) 1034 )) 1039 (cons* `(conserve ,@conserveeq) 1040 `(transitions ,@transitions) alst))) 1035 1041 (list (cons qid qs) (updatesubst id qid scopesubst)))))) 1036 1042 … … 1039 1045 (((or 'd 'D) ((and id (? symbol?))) '= (and expr (? expr?) )) 1040 1046 (let* ((qid (computeqid id scope scopesubst)) 1041 (qexpr (substexpr (parseexpr expr ) scopesubst)))1047 (qexpr (substexpr (parseexpr expr `(rate ,id)) scopesubst))) 1042 1048 (envextend! qid '(rate) 0.0 `(rhs ,qexpr)) 1043 1049 (list (cons qid qs) (updatesubst id qid scopesubst)))) … … 1046 1052 (((and id (? symbol?)) '= (and expr (? expr?) )) 1047 1053 (let* ((qid (computeqid id scope scopesubst)) 1048 (qexpr (substexpr (parseexpr expr ) scopesubst)))1054 (qexpr (substexpr (parseexpr expr `(asgn ,id)) scopesubst))) 1049 1055 (envextend! qid '(asgn) 'none `(rhs ,qexpr)) 1050 1056 (list (cons qid qs) (updatesubst id qid scopesubst)))) … … 1054 1060 (and idlist (? (lambda (x) (every symbol? x)))) (and expr (? expr?))) 1055 1061 (let ((qid (computeqid id scope scopesubst))) 1056 (((nemocore 'defun!) sys) qid idlist (parseexpr expr ))1062 (((nemocore 'defun!) sys) qid idlist (parseexpr expr `(defun ,id))) 1057 1063 (list (cons qid qs) (updatesubst id qid scopesubst)))) 1058 1064 … … 1089 1095 (list (cons sym qs) scopesubst1))))) 1090 1096 1091 1092 1097 (((or 'component 'COMPONENT) ((or 'name 'NAME) name) '= 1093 1098 (and functorname (? symbol?)) (and args (? list?))) … … 1106 1111 (nemo:error 'evalnemosystemdecls! functorname 1107 1112 " is not a functor" ))))) 1113 1108 1114 (if (not (= (length functorargs) (length args))) 1109 1115 (nemo:error 'evalnemosystemdecls! "functor " functorname … … 1128 1134 (comp (COMPONENT name functortype (append cqs1 cqs2)))) 1129 1135 (environmentset! sys sym comp) 1136 1130 1137 (list (cons sym qs) #f)))))) 1131 1138
Note: See TracChangeset
for help on using the changeset viewer.