Changeset 5967 in project


Ignore:
Timestamp:
09/09/07 16:21:08 (12 years ago)
Author:
iraikov
Message:

More fixes related to ode-env API change.

Location:
ode/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • ode/trunk/ode.grm

    r5963 r5967  
    2929
    3030                ;; user-defined function
    31                 (DEFUN ID LPAREN idlist RPAREN expr): ((ode 'defun! ode-env) (token-value $2) (reverse $4) $6)
     31                (DEFUN ID LPAREN idlist RPAREN expr): (((ode 'defun!) ode-env) (token-value $2) (reverse $4) $6)
    3232
    3333                ;; constant during integration
    34                 (CONST ID = expr): ((ode 'env-extend! ode-env) (token-value $2) '(const) ((ode 'eval-const) $4))
     34                (CONST ID = expr): (((ode 'env-extend!) ode-env) (token-value $2) '(const) ((ode 'eval-const) $4))
    3535
    3636                ;; system state
    37                 (STATE ID = expr): ((ode 'env-extend! ode-env) (token-value $2) '(state) ((ode 'eval-const) $4))
     37                (STATE ID = expr): (((ode 'env-extend!) ode-env) (token-value $2) '(state) ((ode 'eval-const) $4))
    3838
    3939                ;; independent variable (default: t)
    40                 (INDEP ID): ((ode 'setindep! ode-env) (token-value $2))
     40                (INDEP ID): (((ode 'setindep!) ode-env) (token-value $2))
    4141
    4242                ;; algebraic assignment
    43                 (ID = expr): ((ode 'env-extend! ode-env) (token-value $1) '(asgn) 'none $3)
     43                (ID = expr): (((ode 'env-extend!) ode-env) (token-value $1) '(asgn) 'none $3)
    4444
    4545                ;; differential equation
    46                 (D LPAREN ID RPAREN = expr): ((ode 'eqdef! ode-env) (token-value $3)  $6)
     46                (D LPAREN ID RPAREN = expr): (((ode 'eqdef!) ode-env) (token-value $3)  $6)
    4747
    4848                ;; step stmt
    49                 (STEP expr COMMA expr): ((ode 'step! ode-env) $2 $3 $4)
     49                (STEP expr COMMA expr): (((ode 'step!) ode-env) $2 $3 $4)
    5050
    5151                ;; step stmt with initial step size
    52                 (STEP expr COMMA expr COMMA expr ): ((ode 'step! ode-env) $2 $4 $5)
     52                (STEP expr COMMA expr COMMA expr ): (((ode 'step!) ode-env) $2 $4 $5)
    5353
    5454                ;; examine the properties of a quantity
    55                 (EXAM ID): ((ode 'exam ode-env) (token-value $1))
     55                (EXAM ID): (((ode 'exam) ode-env) (token-value $1))
    5656
    5757                ;; set print stmt to be executed during system run
    58                 (PRINT prtlist ): ((ode 'set-print! ode-env) (reverse $2))
    59                 (PRINT prtlist EVERY expr): ((ode 'set-print! ode-env) (reverse $2) ((ode 'eval-const) $4))
     58                (PRINT prtlist ): (((ode 'set-print!) ode-env) (reverse $2))
     59                (PRINT prtlist EVERY expr): (((ode 'set-print!) ode-env) (reverse $2) ((ode 'eval-const) $4))
    6060                (PRINT prtlist EVERY expr FROM expr):
    61                 ((ode 'set-print! ode-env) (reverse $2) ((ode 'eval-const) $4) ((ode 'eval-const) $6))
     61                (((ode 'set-print!) ode-env) (reverse $2) ((ode 'eval-const) $4) ((ode 'eval-const) $6))
    6262
    6363                (HELP): (ode:help))
  • ode/trunk/ode.scm

    r5966 r5967  
    181181      env))
    182182
    183   (define (env-extend! ode-env name type initial . rest)
    184     (let-optionals  rest ((rhs #f))
    185       (let ((sym (string->symbol name)))
     183  (define (env-extend! ode-env)
     184    (lambda (name type initial . rest)
     185      (let-optionals  rest ((rhs #f))
     186       (let ((sym (string->symbol name)))
    186187        (if (environment-has-binding? ode-env sym)
    187188            (ode:error 'env-extend! ": quantity " sym " already defined")
     
    204205                                 (ode:error 'env-extend! ": state function definitions require an equation"))
    205206                             (environment-extend! ode-env sym (ASGN name 0.0 rhs 0.0 0.0))))
    206               (else (ode:error 'env-extend! ": unknown type " type)))))))
    207 
    208   (define (defun! ode-env name formals body)
    209     (let ((sym (string->symbol name)))
    210       (if (environment-has-binding? ode-env sym)
    211           (ode:error 'defun! ": quantity " sym " already defined")
    212           (let ((fenv (make-base-env)))
    213             (for-each (lambda (x) (environment-extend! fenv x #f)) formals)
    214             (let ((f (lambda args (begin (for-each (lambda (x v) (environment-set! fenv x v)) formals args)
    215                                          (eval body fenv)))))
    216               (environment-extend! ode-env sym f)
    217               (environment-extend! const-env sym f))))))
     207              (else (ode:error 'env-extend! ": unknown type " type))))))))
     208
     209  (define (defun! ode-env)
     210    (lambda (name formals body)
     211     (let ((sym (string->symbol name)))
     212       (if (environment-has-binding? ode-env sym)
     213           (ode:error 'defun! ": quantity " sym " already defined")
     214           (let ((fenv (make-base-env)))
     215             (for-each (lambda (x) (environment-extend! fenv x #f)) formals)
     216             (let ((f (lambda args (begin (for-each (lambda (x v) (environment-set! fenv x v)) formals args)
     217                                          (eval body fenv)))))
     218               (environment-extend! ode-env sym f)
     219               (environment-extend! const-env sym f)))))))
    218220                         
    219   (define (setindep! ode-env name)
    220     (let ((sym (string->symbol name)))
    221       (if (environment-has-binding? ode-env sym)
    222           (ode:error 'setindep! ": quantity " sym " already defined")
    223           (begin
    224             (environment-remove! ode-env (ode-intern 'indep))
    225             (environment-extend! ode-env (ode-intern 'indep) (INDEP name 0.0))))))
     221  (define (setindep! ode-env)
     222    (lambda (name)
     223      (let ((sym (string->symbol name)))
     224        (if (environment-has-binding? ode-env sym)
     225            (ode:error 'setindep! ": quantity " sym " already defined")
     226            (begin
     227              (environment-remove! ode-env (ode-intern 'indep))
     228              (environment-extend! ode-env (ode-intern 'indep) (INDEP name 0.0)))))))
    226229 
    227230 
    228   (define (eqdef! ode-env name rhs)
    229     (let ((sym (string->symbol name)))
    230       (if (not (environment-has-binding? ode-env sym))
    231           (ode:error 'eqdef! ": quantity " sym " is not defined")
    232           (let ((x (environment-ref ode-env sym)))
    233             (cases ode:quantity x
    234                    (STATE (name initial value rhs1 abserr relerr deriv)
    235                           (environment-set! ode-env sym (STATE name initial initial rhs 0.0 0.0 0.0)))
    236                    (else (ode:error 'eqdef! ": cannot define a differential equation for non-state quantity " sym)))))))
     231  (define (eqdef! ode-env)
     232    (lambda (name rhs)
     233      (let ((sym (string->symbol name)))
     234        (if (not (environment-has-binding? ode-env sym))
     235            (ode:error 'eqdef! ": quantity " sym " is not defined")
     236            (let ((x (environment-ref ode-env sym)))
     237              (cases ode:quantity x
     238                     (STATE (name initial value rhs1 abserr relerr deriv)
     239                            (environment-set! ode-env sym (STATE name initial initial rhs 0.0 0.0 0.0)))
     240                     (else
     241                      (ode:error 'eqdef! ": cannot define a differential equation for non-state quantity " sym))))))))
    237242 
    238243 
    239   (define (exam ode-env name)
    240     (let ((sym (string->symbol name)))
    241       (if (not (environment-has-binding? ode-env sym))
    242           (ode:error 'exam ": quantity " sym " is not defined")
    243           (let ((x (environment-ref ode-env sym)))
    244             (cases ode:quantity x
    245                    (STATE (name initial value rhs abserr relerr deriv)
    246                     (begin
    247                       (fprintf out "~a: dynamic state\n" name)
    248                       (fprintf out "    initial value: ~a\n" initial)
    249                       (fprintf out "    value: ~a\n" value)
    250                       (fprintf out "    absolute error: ~a\n" abserr)
    251                       (fprintf out "    relative error: ~a\n" relerr)))
    252 
    253                    (INDEP    (name value)
    254                     (begin
    255                       (fprintf out "~a: independent variable\n" name)
    256                       (fprintf out "    value: ~a\n" value)))
    257 
    258                    (CONST    (name value)
    259                     (begin
    260                       (fprintf out "~a: constant\n")
    261                       (fprintf out "    value: ~a\n" value)))
    262 
    263                    (ASGN     (name value rhs abserr relerr)
    264                     (begin
    265                       (fprintf out "~a: state function\n" name)
    266                       (fprintf out "    value: ~a\n" value)
    267                       (fprintf out "    absolute error: ~a\n" abserr)
    268                       (fprintf out "    relative error: ~a\n" relerr)))
    269 
    270                    (else (ode:error 'exam name ": unknown type of quantity")))))))
     244  (define (exam ode-env)
     245    (lambda (name)
     246      (let ((sym (string->symbol name)))
     247        (if (not (environment-has-binding? ode-env sym))
     248            (ode:error 'exam ": quantity " sym " is not defined")
     249            (let ((x (environment-ref ode-env sym)))
     250              (cases ode:quantity x
     251                     (STATE (name initial value rhs abserr relerr deriv)
     252                            (begin
     253                              (fprintf out "~a: dynamic state\n" name)
     254                              (fprintf out "    initial value: ~a\n" initial)
     255                              (fprintf out "    value: ~a\n" value)
     256                              (fprintf out "    absolute error: ~a\n" abserr)
     257                              (fprintf out "    relative error: ~a\n" relerr)))
     258                     
     259                     (INDEP    (name value)
     260                               (begin
     261                                 (fprintf out "~a: independent variable\n" name)
     262                                 (fprintf out "    value: ~a\n" value)))
     263                     
     264                     (CONST    (name value)
     265                               (begin
     266                                 (fprintf out "~a: constant\n")
     267                                 (fprintf out "    value: ~a\n" value)))
     268                     
     269                     (ASGN     (name value rhs abserr relerr)
     270                               (begin
     271                                 (fprintf out "~a: state function\n" name)
     272                                 (fprintf out "    value: ~a\n" value)
     273                                 (fprintf out "    absolute error: ~a\n" abserr)
     274                                 (fprintf out "    relative error: ~a\n" relerr)))
     275                     
     276                     (else (ode:error 'exam name ": unknown type of quantity"))))))))
    271277 
    272   (define (set-print! ode-env prtlist . rest)
    273     (let-optionals  rest ((every #f) (from #f))
    274       (environment-set! ode-env (ode-intern 'prtlist)
    275                         (PRTLIST prtlist
    276                                  (if every (inexact->exact every) every)
    277                                  (if from (inexact->exact from) from)))))
     278  (define (set-print! ode-env)
     279    (lambda (prtlist . rest)
     280      (let-optionals  rest ((every #f) (from #f))
     281                      (environment-set! ode-env (ode-intern 'prtlist)
     282                                        (PRTLIST prtlist
     283                                                 (if every (inexact->exact every) every)
     284                                                 (if from (inexact->exact from) from))))))
    278285 
    279   (define (set-hook! ode-env cmdlist . rest)
    280     (let-optionals  rest ((every #f) (from #f))
    281       (environment-set! ode-env (ode-intern 'cmdlist) (HOOKLIST cmdlist every from))))
     286  (define (set-hook! ode-env)
     287    (lambda (cmdlist . rest)
     288      (let-optionals  rest ((every #f) (from #f))
     289                      (environment-set! ode-env (ode-intern 'cmdlist) (HOOKLIST cmdlist every from)))))
    282290
    283291  (define (eval-const expr)
     
    464472                                       (else (ode:error 'eval-expr "unknown expression " s)))))))
    465473   
    466   (define (step! ode-env solver start stop . rest)
    467     (let-optionals  rest ((initial-h 0.1))
    468       (if (<= stop start)
    469           (ode:error 'step! ": stop <= start")
    470           (let-values (((state-list asgn-list g)  (make-eqng)))
     474  (define (step! ode-env)
     475    (lambda (solver start stop . rest)
     476      (let-optionals  rest ((initial-h 0.1))
     477       (if (<= stop start)
     478           (ode:error 'step! ": stop <= start")
     479           (let-values (((state-list asgn-list g)  (make-eqng ode-env)))
    471480            (let* ((eqposet     (graph->bfs-dist-poset g))
    472                    (eval-poset  (make-eval-poset eqposet))
    473                    (eval-env    (make-eval-env))
     481                   (eval-poset  (make-eval-poset ode-env eqposet))
     482                   (eval-env    (make-eval-env ode-env))
    474483                   (eval-expr   (eval-expr eval-env))
    475484                   (order       (length state-list))
     
    477486                                       (INDEP (name value)  (string->symbol name))
    478487                                       (else  (ode:error 'step! ": invalid independent variable entry"))))
    479                    (solve-env   (make-solve-env indep state-list asgn-list))
     488                   (solve-env   (make-solve-env ode-env indep state-list asgn-list))
    480489                   (prt         (cases ode:quantity (environment-ref ode-env (ode-intern 'prtlist))
    481490                                       (PRTLIST  (items every from)  (list items every from))
     
    619628              (condition-case (solver dispatch indep start stop initial-h)
    620629                              [exn (numerror)
    621                                    (ode:warning ((condition-property-accessor 'numerror 'message) exn))]))))))
     630                                   (ode:warning ((condition-property-accessor 'numerror 'message) exn))])))))))
    622631
    623632  ;; Dispatcher
  • ode/trunk/ode.setup

    r5845 r5967  
    66
    77
    8 (compile -d2 -s -o ode-euler.so
     8(compile -d2 -O -s -o ode-euler.so
    99         ,@(if has-exports? '(-check-imports -emit-exports ode-euler.exports) '())
    1010         euler.scm)
    1111
    12 (compile -d2 -s -o ode-heun.so
     12(compile -d2 -O -s -o ode-heun.so
    1313         ,@(if has-exports? '(-check-imports -emit-exports ode-heun.exports) '())
    1414         heun.scm)
    1515
    16 (compile -d2 -s -o ode-rkf45.so
     16(compile -d2 -O -s -o ode-rkf45.so
    1717         ,@(if has-exports? '(-check-imports -emit-exports ode-rkf45.exports) '())
    1818         rkf45.scm)
    1919
    20 (compile -d2 -s -o ode-abm4.so
     20(compile -d2 -O -s -o ode-abm4.so
    2121         ,@(if has-exports? '(-check-imports -emit-exports ode-abm4.exports) '())
    2222         abm4.scm)
    2323
    24 (compile -d2 -s
     24(compile -d2 -O -s -k
    2525         ,@(if has-exports? '(-check-imports -emit-exports ode.exports) '())
    2626         ode.scm)
  • ode/trunk/tests/run.scm

    r5965 r5967  
    55(define ode (make-ode))
    66
    7 ;(ode:parse ode (open-input-file "examples/euler.ode"))
    8 (ode:parse ode (open-input-file "examples/butcher/p201a.ode"))
    9 ((ode 'step!) ode:rkf45 0.0 1.0 0.05)
     7;(let ((ode-env (ode:parse ode (open-input-file "examples/butcher/p201a.ode"))))
     8(let ((ode-env (ode:parse ode (open-input-file "examples/euler.ode"))))
     9  (((ode 'step!) ode-env) ode:rkf45 0.0 1.0 0.05))
     10
Note: See TracChangeset for help on using the changeset viewer.