Changeset 27093 in project


Ignore:
Timestamp:
07/21/12 18:01:32 (9 years ago)
Author:
Ivan Raikov
Message:

nemo: eliminated dependency on environments

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

Legend:

Unmodified
Added
Removed
  • release/4/nemo/trunk/extensions/nemo-hh.scm

    r27021 r27093  
    2424        (nemo:hh-transformer)
    2525
    26         (import scheme chicken data-structures srfi-1 srfi-13)
     26        (import scheme chicken data-structures srfi-1 srfi-13 srfi-69)
    2727       
    28         (require-extension matchable environments varsubst nemo-core)
     28        (require-extension matchable varsubst nemo-core)
    2929
    3030(define (s+ . lst)    (string-concatenate (map ->string lst)))
     
    4141(define (check-names ion env . names)
    4242  (for-each (lambda (name)
    43               (if (environment-includes? env name)
     43              (if (hash-table-exists? env name)
    4444                  (nemo:error 'nemo:hh-transformer "quantity " name " in ionic conductance declaration " ion
    4545                             "is already declared elsewhere")))
     
    236236  (let-optionals rest ((parse-expr (lambda (x . rest) (identity x))))
    237237   (let ((new-sys  (nemo:env-copy sys)))
    238      (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref new-sys (nemo-intern 'dispatch))))
     238     (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref new-sys (nemo-intern 'dispatch))))
    239239      (let* ((eval-const         (dis 'eval-const))
    240240             (subst-expr         (dis 'subst-expr))
     
    252252                         new-sys parse-expr subst-expr scope-subst scope
    253253                         (dis 'eval-const) env-extend! add-external! component-extend!
    254                          comp-name (environment-ref new-sys sym) markov?))
     254                         comp-name (hash-table-ref new-sys sym) markov?))
    255255                      comp-symbols)
    256256            (for-each (lambda (subcomp) (recur subcomp (or scope subcomp))) (map third subcomps))))
  • release/4/nemo/trunk/extensions/nemo-vclamp.scm

    r27021 r27093  
    2323        (nemo:vclamp-translator)
    2424
    25         (import scheme chicken utils data-structures lolevel srfi-1 srfi-13 )
     25        (import scheme chicken utils data-structures lolevel srfi-1 srfi-13 srfi-69)
    2626
    2727        (require-extension lolevel datatype matchable strictly-pretty
    28                            environments varsubst datatype
     28                           varsubst datatype
    2929                           nemo-core nemo-utils nemo-gate-complex)
    3030
     
    112112  (let-optionals rest ((target 'hoc) (filename #f))
    113113
    114     (cases nemo:quantity (environment-ref sys (nemo-intern 'dispatch)) 
     114    (cases nemo:quantity (hash-table-ref sys (nemo-intern 'dispatch)) 
    115115
    116116         (DISPATCH  (dis)
     
    411411                   (pp indent (plot( ,@(intersperse
    412412                                        (concatenate
    413                                          (list-tabulate (inexact->exact (const-val (environment-ref env vcsteps)))
     413                                         (list-tabulate (inexact->exact (const-val (hash-table-ref env vcsteps)))
    414414                                          (lambda (i)
    415415                                           `(,(s+ sysname "_ilog{" (+ 1 i) "}(:,1)")
     
    422422
    423423                   (pp indent (,(s+ name "_log") = vertcat ,(intersperse
    424                                        (list-tabulate (inexact->exact (const-val (environment-ref env vcsteps)))
     424                                       (list-tabulate (inexact->exact (const-val (hash-table-ref env vcsteps)))
    425425                                         (lambda (i)
    426426                                           (s+ #\[
  • release/4/nemo/trunk/nemo-core.scm

    r27021 r27093  
    3131
    3232 (import scheme chicken data-structures ports lolevel extras
    33          srfi-1 srfi-4 srfi-13 srfi-14)
     33         srfi-1 srfi-4 srfi-13 srfi-14 srfi-69)
    3434
    3535 (require-extension lolevel datatype matchable vector-lib
    36                     environments varsubst digraph
    37                     graph-bfs graph-cycles mathh)
     36                    varsubst digraph graph-bfs graph-cycles mathh)
    3837
    3938 (include "mathh-constants")
     
    7877(define (make-opt pred?) (lambda (x)
    7978                           (or (not x) (pred? x))))
     79
     80(define (eval-math x . rest)
     81  (if (null? rest)
     82      (let ((ex `(begin (import mathh) ,x)))
     83        (eval ex))
     84      (let ((ex `(begin (import mathh) (list ,x . ,rest))))
     85        (eval ex))
     86      ))
     87     
    8088
    8189(define (expr? x) 
     
    176184(define (nemo:bind ks vs e) `(let ,(zip ks vs) ,e))
    177185
    178 (define nemo:env-copy environment-copy)
     186(define nemo:env-copy hash-table-copy)
    179187
    180188
     
    199207        sqrt tan cosh sinh tanh hypot gamma lgamma log10 log2 log1p ldexp cube
    200208        > < <= >= = and or round ceiling floor max min
    201         fpvector-ref))
     209        ))
     210
    202211
    203212  (define (add-primitives! env)
    204     (for-each (lambda (n b fms rt)
    205                 (let ((fb (extend-procedure b `((rt ,rt) (formals ,fms)))))
    206                   (environment-extend! env n fb)))
    207               builtin-fns
    208               (list fp+ fp- fp* fp/ expt fpneg
    209                     abs atan asin acos sin cos exp log sqrt tan
    210                     cosh sinh tanh hypot gamma lgamma log10 log2 log1p ldexp
    211                     (lambda (x) (* x x x))
    212                     fp> fp< fp<= fp>= fp=
    213                     (lambda (x y) (and x y)) (lambda (x y) (or x y))
    214                     round ceiling floor fpmax fpmin
    215                     fpvector-ref)
    216               `((,fptype ,fptype) (,fptype ,fptype) (,fptype ,fptype) (,fptype ,fptype)
    217                 (,fptype ,fptype) (,fptype)
    218                 (,fptype) (,fptype) (,fptype) (,fptype) (,fptype) (,fptype) (,fptype)
    219                 (,fptype) (,fptype) (,fptype)
    220                 (,fptype) (,fptype) (,fptype) (,fptype) (,fptype) (,fptype) (,fptype)
    221                 (,fptype) (,fptype) (,fptype)
    222                 (,fptype)
    223                 (bool bool) (bool bool) (bool bool) (bool bool) (bool bool) (bool bool) (bool bool)
    224                 (,fptype) (,fptype) (,fptype) (,fptype ,fptype) (,fptype ,fptype)
    225                 (,fpvector-type integer) )
    226               `(,fptype ,fptype ,fptype ,fptype
    227                 ,fptype ,fptype
    228                 ,fptype ,fptype ,fptype ,fptype ,fptype ,fptype ,fptype
    229                 ,fptype ,fptype ,fptype
    230                 ,fptype ,fptype ,fptype ,fptype ,fptype ,fptype ,fptype
    231                 ,fptype ,fptype ,fptype
    232                 ,fptype
    233                 bool bool bool bool bool bool bool
    234                 ,fptype ,fptype ,fptype ,fptype ,fptype
    235                 ,fptype )
    236               ))
     213    (let ((prim-exprs
     214           '(fp+ fp- fp* fp/ expt fpneg
     215                 abs atan asin acos sin cos exp log sqrt tan
     216                 cosh sinh tanh hypot gamma lgamma log10 log2 log1p ldexp
     217                 (lambda (x) (* x x x))
     218                 fp> fp< fp<= fp>= fp=
     219                 (lambda (x y) (and x y)) (lambda (x y) (or x y))
     220                 round ceiling floor fpmax fpmin
     221                 )))
     222      (for-each (lambda (n v qb fms rt)
     223                  (let ((fb (extend-procedure
     224                             v `((name ,n) (eval-body ,qb)
     225                                 (rt ,rt) (formals ,fms)))))
     226                    (hash-table-set! env n fb)))
     227                builtin-fns
     228                (apply eval-math prim-exprs)
     229                prim-exprs
     230                `((,fptype ,fptype) (,fptype ,fptype) (,fptype ,fptype) (,fptype ,fptype)
     231                  (,fptype ,fptype) (,fptype)
     232                  (,fptype) (,fptype) (,fptype) (,fptype) (,fptype) (,fptype) (,fptype)
     233                  (,fptype) (,fptype) (,fptype)
     234                  (,fptype) (,fptype) (,fptype) (,fptype) (,fptype) (,fptype) (,fptype)
     235                  (,fptype) (,fptype) (,fptype)
     236                  (,fptype)
     237                  (bool bool) (bool bool) (bool bool) (bool bool) (bool bool) (bool bool) (bool bool)
     238                  (,fptype) (,fptype) (,fptype) (,fptype ,fptype) (,fptype ,fptype)
     239                  (,fpvector-type integer) )
     240                `(,fptype ,fptype ,fptype ,fptype
     241                          ,fptype ,fptype
     242                          ,fptype ,fptype ,fptype ,fptype ,fptype ,fptype ,fptype
     243                          ,fptype ,fptype ,fptype
     244                          ,fptype ,fptype ,fptype ,fptype ,fptype ,fptype ,fptype
     245                          ,fptype ,fptype ,fptype
     246                          ,fptype
     247                          bool bool bool bool bool bool bool
     248                          ,fptype ,fptype ,fptype ,fptype ,fptype
     249                          ,fptype )
     250                )))
    237251
    238252  (define (add-constants! env)
    239     (for-each (lambda (n b) (environment-extend! env n b))
     253    (for-each (lambda (n b) (hash-table-set! env n b))
    240254              `(E 1/E E^2 E^PI/4 LOG2E LOG10E LN2 LN3 LNPI LN10 1/LN2 1/LN10 PI PI/2
    241255                  PI/4 1/PI 2/PI 2/SQRTPI SQRTPI PI^2 DEGREE SQRT2 1/SQRT2 SQRT3 SQRT5
     
    300314
    301315  (define (make-base-env)
    302     (let ((env (make-environment #t)))
     316    (let ((env (make-hash-table hash: symbol-hash)))
    303317      (add-primitives! env)
    304318      (add-constants! env)
     
    307321  (define (make-const-env nemo-env)
    308322    (let ((env (make-base-env)))
    309       (environment-for-each nemo-env
     323      (hash-table-for-each nemo-env
    310324        (lambda (sym en)
    311325          (cond  ((nemo:quantity? en) 
    312326                  (cases nemo:quantity en
    313327                         (CONST (name value) 
    314                                 (environment-extend! env name value))
     328                                (hash-table-set! env name value))
    315329                         (PRIM (name value) 
    316                                (environment-extend! env name value))))
     330                               (hash-table-set! env name value))))
    317331                 ((procedure? en)
    318                   (environment-extend! env sym en)))))
     332                  (hash-table-set! env sym en)))))
    319333        env))
     334
     335
     336  (define (const-env-entry->value en)
     337    (cond  ((nemo:quantity? en) 
     338            (cases nemo:quantity en
     339                   (CONST (name value)  value)
     340                   (PRIM (name value)  value)
     341                   ))
     342           ((procedure? en) (lookup-def 'eval-body (procedure-data en)))
     343           ((or (number? en) (symbol? en))   en)
     344           (else #f)))
    320345
    321346  (define (system name)
    322347    (let ((env  (make-base-env))
    323348          (name (if (symbol? name) name (string->symbol name))))
    324       (environment-extend! env (nemo-intern 'dispatch)  (DISPATCH nemo-dispatch))
    325       (environment-extend! env (nemo-intern 'name)      (SYSNAME name))
    326       (environment-extend! env (nemo-intern 'exports)   (EXPORTS (list)))
    327       (environment-extend! env (nemo-intern 'toplevel)  (COMPONENT 'toplevel 'toplevel (list) (list)))
     349      (hash-table-set! env (nemo-intern 'dispatch)  (DISPATCH nemo-dispatch))
     350      (hash-table-set! env (nemo-intern 'name)      (SYSNAME name))
     351      (hash-table-set! env (nemo-intern 'exports)   (EXPORTS (list)))
     352      (hash-table-set! env (nemo-intern 'toplevel)  (COMPONENT 'toplevel 'toplevel (list) (list)))
    328353      env))
    329354
     
    333358             ('output
    334359              (begin
    335                 (if (not (environment-has-binding? nemo-env sym))
     360                (if (not (hash-table-exists? nemo-env sym))
    336361                    (nemo:error 'add-external! ": exported quantity " sym " is not defined"))
    337362                (let* ((exports-sym   (nemo-intern 'exports))
    338                        (exports       (environment-ref nemo-env exports-sym)))
     363                       (exports       (hash-table-ref nemo-env exports-sym)))
    339364                  (cases nemo:quantity exports
    340                          (EXPORTS (lst) (environment-extend! nemo-env exports-sym (EXPORTS (cons sym lst))))
     365                         (EXPORTS (lst) (hash-table-set! nemo-env exports-sym (EXPORTS (cons sym lst))))
    341366                         (else  (nemo:error 'add-external! ": invalid exports entry " exports))))))
    342367             
     
    344369              (let ((lsym (or lsym sym)))
    345370               
    346                 (if (environment-has-binding? nemo-env lsym)
     371                (if (hash-table-exists? nemo-env lsym)
    347372                    (nemo:error 'add-import! ": import symbol " lsym " is already defined"))
    348373               
     
    354379  (define (make-arity-check nemo-env)
    355380    (lambda (s args)
    356       (let ((op (environment-ref nemo-env s)))
     381      (let ((op (hash-table-ref nemo-env s)))
    357382        (if (extended-procedure? op)
    358383            (let* ((fd   (procedure-data op))
     
    370395              (arity-check (make-arity-check nemo-env))
    371396              (normalize-expr (make-normalize-expr arity-check)))
    372         (if (environment-has-binding? nemo-env sym)
     397        (if (hash-table-exists? nemo-env sym)
    373398            (nemo:error 'env-extend! ": quantity " sym " already defined")
    374399            (match type
     
    376401                            (if (not (symbol? initial))
    377402                                (nemo:error 'env-extend! ": label definitions require symbolic value"))
    378                             (environment-extend! nemo-env sym (LABEL initial))))
     403                            (hash-table-set! nemo-env sym (LABEL initial))))
    379404
    380405              (('external)  (begin
     
    382407                                     (external-name  (lookup-def 'name alst))
    383408                                     (x              (EXTERNAL name external-name ns )))
    384                                 (environment-extend! nemo-env sym x)
     409                                (hash-table-set! nemo-env sym x)
    385410                                )))
    386411                             
     
    389414                                          (extend-procedure initial rhs)
    390415                                          initial)))
    391                             (environment-extend! nemo-env sym (PRIM name val ))))
     416                            (hash-table-set! nemo-env sym (PRIM name val ))))
    392417
    393418              (('const)   (begin
    394419                            (if (not (number? initial))
    395420                                (nemo:error 'env-extend! ": constant definitions require numeric value"))
    396                             (environment-extend! nemo-env sym (CONST name initial))))
     421                            (hash-table-set! nemo-env sym (CONST name initial))))
    397422
    398423              (('asgn)    (let ((rhs (lookup-def 'rhs alst)))
     
    402427                            (if (not rhs)
    403428                                (nemo:error 'env-extend! ": state function definitions require an equation"))
    404                             (environment-extend! nemo-env sym (ASGN  name 0.0 (normalize-expr rhs)))))
     429                            (hash-table-set! nemo-env sym (ASGN  name 0.0 (normalize-expr rhs)))))
    405430
    406431              (('rate)    (let ((rhs (lookup-def 'rhs alst))
     
    409434                                (nemo:error 'env-extend! ": rate law definitions require an equation"))
    410435
    411                             (environment-extend! nemo-env sym (RATE name initial (normalize-expr rhs) power))))
     436                            (hash-table-set! nemo-env sym (RATE name (and initial (normalize-expr initial))
     437                                                                (normalize-expr rhs) power))))
    412438
    413439              (('reaction)  (begin
     
    437463                                              " requires an integer power (" power  " was given)"))
    438464                             
    439                               (let ((en (REACTION name initial open transitions (and conserve (list conserve)) power)))
    440                                 (environment-extend! nemo-env sym en)))))
     465                              (let ((en (REACTION name (and initial (normalize-expr initial))
     466                                                  open transitions
     467                                                  (and conserve (list conserve)) power)))
     468                                (hash-table-set! nemo-env sym en)))))
    441469
    442470
    443471              (else       (begin
    444                             (environment-extend! nemo-env sym `(,type (name ,sym) . ,initial))))
     472                            (hash-table-set! nemo-env sym `(,type (name ,sym) . ,initial))))
    445473              )))))
    446474
     
    466494             
    467495             ((s . es)   
    468               (let* ((f    (environment-ref nemo-env s))
     496              (let* ((f    (hash-table-ref nemo-env s))
    469497                     (lst  (procedure-data f)))
    470498                (and lst
     
    474502                            (begin
    475503                              (for-each (lambda (x ft)
    476                                           (if (and (symbol? x) (not (environment-includes? ftenv x)))
    477                                               (environment-extend! ftenv x ft)))
     504                                          (if (and (symbol? x) (not (hash-table-exists? ftenv x)))
     505                                              (hash-table-set! ftenv x ft)))
    478506                                        es fms)
    479507                              (let* ((rlb (lambda (x) (recur x lb)))
     
    483511                                     rt))))))))
    484512             
    485              (id    (cond ((symbol? id)     (or (lookup-def id lb) (environment-ref ftenv id)))
     513             (id    (cond ((symbol? id)     (or (lookup-def id lb) (hash-table-ref ftenv id)))
    486514                          ((number? id)     fptype)
    487515                          ((boolean? id)    'bool)
     
    504532                                               (ec e (fold ec ax (map second bs)))))
    505533                               (('if . es)   (fold (enumconsts lb) ax es))
    506                                ((s . es)     (if (symbol? s)  (cons s (fold (enumconsts lb) ax es)) ax))
     534                               ((s . es)     (if (symbol? s) 
     535                                                 (let ((v (const-env-entry->value (hash-table-ref const-env s))))
     536                                                   (cons (cons s v) (fold (enumconsts lb) ax es)))
     537                                                 ax))
    507538                               (s            (cond
    508                                                ((and (symbol? s) (not (member s lb)) (environment-includes? const-env s))
    509                                                 (cons s ax) )
     539                                               ((and (symbol? s) (not (member s lb))
     540                                                     (hash-table-exists? const-env s))
     541                                                (let ((v (const-env-entry->value (hash-table-ref const-env s))))
     542                                                  (cons (cons s v) ax) ))
    510543                                               ((and (symbol? s) (not (member s lb)))
    511544                                                (nemo:error 'defun ": quantity " s " not defined"))
    512                                                (else ax))))))))
    513             (if (environment-has-binding? nemo-env sym)
     545                                               (else ax)))))))
     546                   
     547                   )
     548            (if (hash-table-exists? nemo-env sym)
    514549                (nemo:error 'defun! ": quantity " sym " already defined")
    515                 (let* ((body    (normalize-expr body))
    516                        (consts  (delete-duplicates ((enumconsts formals) body (list))))
    517                        (fc     `(let ,(map (lambda (v) `(,v ,v)) consts)
    518                                     (lambda ,formals ,body)))
    519                        (f      (eval fc const-env)))
    520                   (let* ((ftenv  (make-environment #t))
     550                (let* (
     551                       (body    (normalize-expr body))
     552                       (consts  (delete-duplicates ((enumconsts formals) body (list))
     553                                                   (lambda (x y) (equal? (car x) (car y)))))
     554                       (eval-body `(let ,(map (lambda (sv)
     555                                                `(,(car sv) ,(cdr sv))) consts)
     556                                     (lambda ,formals ,body)))
     557                       (f      (eval eval-body))
     558                       )
     559                  (let* ((ftenv  (make-hash-table))
    521560                         (rt     (infer nemo-env ftenv body))
    522561                         (ftypes (filter-map (lambda (x)
    523                                                (or (and (environment-includes? ftenv x)
    524                                                         (environment-ref ftenv x)) 'double))
     562                                               (or (and (hash-table-exists? ftenv x)
     563                                                        (hash-table-ref ftenv x)) 'double))
    525564                                             formals))
    526565                         (ef     (extend-procedure f
    527                                    `((rt ,rt) (formals ,ftypes) (vars ,formals)
    528                                      (body ,body)
     566                                   `((name ,sym) (body ,body) (eval-body ,eval-body)
     567                                     (rt ,rt) (formals ,ftypes) (vars ,formals)
    529568                                     (consts ,(filter (lambda (x) (not (member x builtin-fns))) consts)))))
    530569                         )
    531                   (environment-extend! nemo-env sym ef))))))))
     570                  (hash-table-set! nemo-env sym ef))))))))
    532571
    533572  (define (symbol-list? lst)
     
    536575  (define (extended nemo-env)
    537576      (filter-map (lambda (sym)
    538                     (let ((x (environment-ref nemo-env sym)))
     577                    (let ((x (hash-table-ref nemo-env sym)))
    539578                      (and (not (nemo:quantity? x)) (not (procedure? x))
    540579                           (match x
    541580                                  (((? symbol-list?) ('name name) . rest)  `(,sym ,x))
    542581                                  (else #f)))))
    543            (environment-symbols nemo-env)))
     582           (hash-table-keys nemo-env)))
    544583                       
    545584
    546585  (define (extended-with-tag nemo-env tag)
    547586      (filter-map (lambda (sym)
    548                     (let ((x (environment-ref nemo-env sym)))
     587                    (let ((x (hash-table-ref nemo-env sym)))
    549588                      (and (not (nemo:quantity? x)) (not (procedure? x))
    550589                           (match x
     
    552591                                   `(,sym ,x))
    553592                                  (else #f)))))
    554            (environment-symbols nemo-env)))
     593           (hash-table-keys nemo-env)))
    555594                       
    556595
    557596  (define (components nemo-env)
    558597      (filter-map (lambda (sym)
    559                     (let ((x (environment-ref nemo-env sym)))
     598                    (let ((x (hash-table-ref nemo-env sym)))
    560599                      (and (nemo:quantity? x)
    561600                           (cases nemo:quantity x
    562601                                  (COMPONENT (name type lst _)  `(,name ,type ,sym))
    563602                                  (else #f)))))
    564            (environment-symbols nemo-env)))
     603           (hash-table-keys nemo-env)))
    565604
    566605
    567606  (define (component-name nemo-env sym)
    568     (let ((x (environment-ref nemo-env sym)))
     607    (let ((x (hash-table-ref nemo-env sym)))
    569608      (and (nemo:quantity? x)
    570609           (cases nemo:quantity x
     
    574613
    575614  (define (component-symbols nemo-env sym)
    576     (let ((x (environment-ref nemo-env sym)))
     615    (let ((x (hash-table-ref nemo-env sym)))
    577616      (and (nemo:quantity? x)
    578617           (cases nemo:quantity x
     
    582621
    583622  (define (component-scope-subst nemo-env sym)
    584     (let ((x (environment-ref nemo-env sym)))
     623    (let ((x (hash-table-ref nemo-env sym)))
    585624      (and (nemo:quantity? x)
    586625           (cases nemo:quantity x
     
    590629
    591630  (define (component-exports nemo-env sym)
    592     (let ((all-exports (cases nemo:quantity (environment-ref nemo-env (nemo-intern 'exports))
     631    (let ((all-exports (cases nemo:quantity (hash-table-ref nemo-env (nemo-intern 'exports))
    593632                              (EXPORTS (lst)  lst))))
    594       (let ((x  (environment-ref nemo-env sym)))
     633      (let ((x  (hash-table-ref nemo-env sym)))
    595634        (and (nemo:quantity? x)
    596635             (cases nemo:quantity x
     
    609648             (COMPONENT (name type lst _) name)
    610649             (else #f)))
    611     (let ((en (environment-ref nemo-env sym)))
     650    (let ((en (hash-table-ref nemo-env sym)))
    612651      (and (nemo:quantity? en)
    613652           (cases nemo:quantity en
     
    615654                             (filter-map
    616655                              (lambda (s)
    617                                 (let ((x (environment-ref nemo-env s)))
     656                                (let ((x (hash-table-ref nemo-env s)))
    618657                                  (and (iscomp? x) `(,(component-type x) ,(component-name x) ,s)))) lst))
    619658                  (else #f)))))
     
    621660  (define (component-extend! nemo-env)
    622661    (lambda (comp-name sym)
    623       (let ((x (environment-ref nemo-env comp-name)))
     662      (let ((x (hash-table-ref nemo-env comp-name)))
    624663        (if (nemo:quantity? x)
    625664            (cases nemo:quantity x
    626665                   (COMPONENT (name type lst scope-subst) 
    627666                              (let ((en1 (COMPONENT name type (delete-duplicates (append lst (list sym))) scope-subst)))
    628                                 (environment-extend! nemo-env comp-name en1)))
     667                                (hash-table-set! nemo-env comp-name en1)))
    629668                   (else (nemo:error 'component-extend! ": invalid component " comp-name)))
    630669            (nemo:error 'component-extend! ": invalid component " comp-name)))))
    631670
    632671  (define (component-enumdeps nemo-env sym)
    633     (let ((x (environment-ref nemo-env sym)))
     672    (let ((x (hash-table-ref nemo-env sym)))
    634673      (and (nemo:quantity? x)
    635674           (cases nemo:quantity x
     
    639678                    (append
    640679                     (fold (lambda (qsym ax)
    641                              (let* ((q   (environment-ref nemo-env qsym))
     680                             (let* ((q   (hash-table-ref nemo-env qsym))
    642681                                    (rhs (qrhs q)))
    643682                               (or (and rhs (append (enumdeps rhs) ax)) ax)))
     
    651690    (fold
    652691     (lambda (sym env)
    653        (let ((comp (environment-ref nemo-env sym)))
     692       (let ((comp (hash-table-ref nemo-env sym)))
    654693         (and (nemo:quantity? comp)
    655694              (cases nemo:quantity comp
     
    661700
    662701                        (let* ((syms (delete-duplicates (append depnames subnames cnames)))
    663                                (vals (map (lambda (x) (environment-ref nemo-env x)) syms)))
    664                           (for-each (lambda (s v) (environment-extend! env s v))
     702                               (vals (map (lambda (x) (hash-table-ref nemo-env x)) syms)))
     703                          (for-each (lambda (s v) (hash-table-set! env s v))
    665704                                    syms vals)
    666705                          env
     
    672711
    673712  (define (exports nemo-env)
    674     (cases nemo:quantity (environment-ref nemo-env (nemo-intern 'exports))
     713    (cases nemo:quantity (hash-table-ref nemo-env (nemo-intern 'exports))
    675714           (EXPORTS (lst)  lst)))
    676715
     
    678717  (define (imports nemo-env)
    679718      (filter-map (lambda (sym)
    680                     (let ((x (environment-ref nemo-env sym)))
     719                    (let ((x (hash-table-ref nemo-env sym)))
    681720                      (and (nemo:quantity? x)
    682721                           (cases nemo:quantity x
    683722                                  (EXTERNAL (local-name name namespace)  (list local-name name namespace))
    684723                                  (else #f)))))
    685            (environment-symbols nemo-env)))
     724           (hash-table-keys nemo-env)))
    686725
    687726
    688727  (define (consts nemo-env)
    689728      (filter-map (lambda (sym)
    690                     (let ((x (environment-ref nemo-env sym)))
     729                    (let ((x (hash-table-ref nemo-env sym)))
    691730                      (and (nemo:quantity? x)
    692731                           (cases nemo:quantity x
    693732                                  (CONST (name value)  (list name value) )
    694733                                  (else #f)))))
    695            (environment-symbols nemo-env)))
     734           (hash-table-keys nemo-env)))
    696735
    697736
     
    699738  (define (states nemo-env)
    700739      (fold (lambda (sym ax)
    701                     (let ((x (environment-ref nemo-env sym)))
     740                    (let ((x (hash-table-ref nemo-env sym)))
    702741                      (if (nemo:quantity? x)
    703742                           (cases nemo:quantity x
     
    710749                                  (else ax))
    711750                           ax)))
    712            (list) (environment-symbols nemo-env)))
     751           (list) (hash-table-keys nemo-env)))
    713752
    714753
    715754  (define (reactions nemo-env)
    716755      (fold (lambda (sym ax)
    717                     (let ((x (environment-ref nemo-env sym)))
     756                    (let ((x (hash-table-ref nemo-env sym)))
    718757                      (if (nemo:quantity? x)
    719758                           (cases nemo:quantity x
     
    722761                                  (else ax))
    723762                           ax)))
    724            (list) (environment-symbols nemo-env)))
     763           (list) (hash-table-keys nemo-env)))
    725764
    726765
    727766  (define (rates nemo-env)
    728767      (filter-map (lambda (sym)
    729                     (let ((x (environment-ref nemo-env sym)))
     768                    (let ((x (hash-table-ref nemo-env sym)))
    730769                      (and (nemo:quantity? x)
    731770                           (cases nemo:quantity x
    732771                                  (RATE (name value rhs _) name)
    733772                                  (else #f)))))
    734            (environment-symbols nemo-env)))
     773           (hash-table-keys nemo-env)))
    735774
    736775  (define (asgns nemo-env)
    737776      (filter-map (lambda (sym)
    738                     (let ((x (environment-ref nemo-env sym)))
     777                    (let ((x (hash-table-ref nemo-env sym)))
    739778                      (and (nemo:quantity? x)
    740779                           (cases nemo:quantity x
    741780                                  (ASGN (name value rhs) name)
    742781                                  (else #f)))))
    743            (environment-symbols nemo-env)))
     782           (hash-table-keys nemo-env)))
    744783
    745784
    746785  (define (defuns nemo-env)
    747786      (filter-map (lambda (sym)
    748                     (let ((x (environment-ref nemo-env sym)))
     787                    (let ((x (hash-table-ref nemo-env sym)))
    749788                      (and (procedure? x) (not (member sym builtin-fns)) (list sym x))))
    750            (environment-symbols nemo-env)))
     789           (hash-table-keys nemo-env)))
    751790
    752791
    753792  (define (toplevel nemo-env)
    754     (cases nemo:quantity (environment-ref nemo-env (nemo-intern 'toplevel))
     793    (cases nemo:quantity (hash-table-ref nemo-env (nemo-intern 'toplevel))
    755794           (COMPONENT (name type lst _) `(,type ,lst))))
    756795
     
    760799      (let ((sym (if (symbol? name) name (string->symbol name)))
    761800            (out (current-output-port)))
    762         (if (not (environment-has-binding? nemo-env sym))
     801        (if (not (hash-table-exists? nemo-env sym))
    763802            (nemo:error 'exam ": quantity " sym " is not defined")
    764             (let ((x (environment-ref nemo-env sym)))
     803            (let ((x (hash-table-ref nemo-env sym)))
    765804              (cases nemo:quantity x
    766805                     (LABEL  (v)
     
    800839  (define (eval-simple-expr env expr)
    801840    (cond ((number? expr) expr)
    802           ((symbol? expr) (environment-ref env expr))
     841          ((symbol? expr) (hash-table-ref env expr))
    803842          ((pair? expr)   (let ((expr1 (map (lambda (x) (eval-simple-expr env x)) expr)))
    804843                            (apply (car expr1) (cdr expr1))))))
     
    851890           
    852891  (define (sysname nemo-env)
    853     (cases nemo:quantity (environment-ref nemo-env (nemo-intern 'name))
     892    (cases nemo:quantity (hash-table-ref nemo-env (nemo-intern 'name))
    854893           (SYSNAME (name)  name)))
    855894
     
    862901           (add-node!  (g 'add-node!))
    863902           (add-edge!  (g 'add-edge!))
    864            (nemo-list  (filter (lambda (sym) (let ((x (environment-ref nemo-env sym)))
     903           (nemo-list  (filter (lambda (sym) (let ((x (hash-table-ref nemo-env sym)))
    865904                                               (or (isstate? x) (isdep? x))))
    866                                (environment-symbols nemo-env)))
     905                               (hash-table-keys nemo-env)))
    867906           (nemo-ids      (list-tabulate (length nemo-list) identity))
    868907           (name->id-map  (zip nemo-list nemo-ids)))
    869908      (let-values (((state-list asgn-list) 
    870                     (partition (lambda (sym) (isstate? (environment-ref nemo-env sym)))
     909                    (partition (lambda (sym) (isstate? (hash-table-ref nemo-env sym)))
    871910                               nemo-list)))
    872911                 
     
    881920                            (else (nemo:error 'make-eqng ": invalid edge " e))))
    882921                   (fold (lambda (qsym ax)
    883                            (let* ((q   (environment-ref nemo-env qsym))
     922                           (let* ((q   (hash-table-ref nemo-env qsym))
    884923                                  (rhs (qrhs q)))
    885924                             (if rhs
    886925                                 (let* ((deps (filter (if (isstate? q)
    887926                                                          (lambda (sym)
    888                                                             (if (not (environment-has-binding? nemo-env sym))
     927                                                            (if (not (hash-table-exists? nemo-env sym))
    889928                                                                (nemo:error 'make-eqng ": undefined symbol " sym
    890929                                                                            " in definition of quantity " qsym))
    891                                                             (and (let ((x (environment-ref nemo-env sym)))
     930                                                            (and (let ((x (hash-table-ref nemo-env sym)))
    892931                                                                   (and (isdep? x) (not (eq? sym qsym))))))
    893932                                                          (lambda (sym)
    894                                                             (if (not (environment-has-binding? nemo-env sym))
     933                                                            (if (not (hash-table-exists? nemo-env sym))
    895934                                                                (nemo:error 'make-eqng ": undefined symbol " sym
    896935                                                                            " in definition of quantity " qsym))
    897                                                             (and (let ((x (environment-ref nemo-env sym)))
     936                                                            (and (let ((x (hash-table-ref nemo-env sym)))
    898937                                                                   (isdep? x)))))
    899938                                                      (enumdeps rhs)))
     
    928967         (filter-map (lambda (id+sym)
    929968                       (let* ((sym  (cdr id+sym))
    930                               (x    (environment-ref nemo-env sym)))
     969                              (x    (hash-table-ref nemo-env sym)))
    931970                         (and (nemo:quantity? x)
    932971                              (cases nemo:quantity x
     
    956995                        ((s . es)   
    957996                         (condition-case
    958                           (let ((op   (environment-ref env s))
     997                          (let ((op   (hash-table-ref env s))
    959998                                (args (map (eval-expr env) es)))
    960999                            (if (extended-procedure? op)
     
    9711010                       
    9721011                        (s                 
    973                          (cond ((symbol? s) (environment-ref env s))
     1012                         (cond ((symbol? s) (hash-table-ref env s))
    9741013                               ((number? s) s)
    9751014                               (else (nemo:error 'eval-expr "unknown expression " s)))))))
     
    10331072   (define env-extend!  ((nemo-core 'env-extend!) sys))
    10341073   (define (compute-qid id scope scope-subst) (or (and scope scope-subst (nemo-scoped scope id)) id))
    1035    (define (update-subst id qid subst) (if (not (equal? id qid)) (subst-extend id qid subst) subst))
     1074   (define (update-subst id qid subst) (if (equal? id qid) subst
     1075                                           (subst-extend id qid subst) ))
    10361076   (define subst-expr  (subst-driver (lambda (x) (and (symbol? x) x))
    10371077                                     nemo:binding?
     
    10471087                      (let* ((top-syms   ((nemo-core 'component-symbols ) sys (nemo-intern 'toplevel)))
    10481088                             (top-syms1  (append qs top-syms)))
    1049                         (environment-extend! sys (nemo-intern 'toplevel) (COMPONENT 'toplevel 'toplevel top-syms1 '()))))
     1089                        (hash-table-set! sys (nemo-intern 'toplevel) (COMPONENT 'toplevel 'toplevel top-syms1 '()))))
    10501090                  (list qs scope-subst))
    10511091                (let ((decl (car ds)))
     
    11031143                                    (qval   (eval-const qexpr)))
    11041144                               (env-extend! qid '(const) qval)
    1105                                (list (cons qid qs) (update-subst id qid scope-subst))))
     1145                               (list (cons qid qs) (update-subst id qid scope-subst))
     1146                               ))
    11061147
    11071148                            ;; state transition complex
     
    12001241                              (and expr (? expr?)))
    12011242
    1202                              (let* ((qid    (compute-qid id scope scope-subst))
    1203                                     (qexpr  (subst-expr (parse-expr expr `(defun ,qid)) scope-subst)))
     1243                             (let* ((qid          (compute-qid id scope scope-subst))
     1244                                    (scope-subst1 (fold (lambda (x ax) (subst-remove x ax))
     1245                                                        scope-subst
     1246                                                        idlist))
     1247                                    (qexpr         (subst-expr (parse-expr expr `(defun ,qid))
     1248                                                               scope-subst1))
     1249                                    )
    12041250                               (((nemo-core 'defun!) sys) qid idlist qexpr)
    12051251                               (list (cons qid qs) (update-subst id qid scope-subst))))
     
    12141260                            (((or 'sysname 'SYSNAME) name) 
    12151261                             (if (symbol? name)
    1216                                  (environment-extend! sys (nemo-intern 'name) (SYSNAME name))
     1262                                 (hash-table-set! sys (nemo-intern 'name) (SYSNAME name))
    12171263                                 (nemo:error 'eval-nemo-system-decls
    12181264                                             "system name must be a symbol")))
     
    12221268                              ((or 'name 'NAME) name) . lst)
    12231269
    1224                              (let ((name1 (let ((x (and (environment-includes?
     1270                             (let ((name1 (let ((x (and (hash-table-exists?
    12251271                                                         sys (or (lookup-def name scope-subst) name))
    1226                                                         (environment-ref
     1272                                                        (hash-table-ref
    12271273                                                         sys (or (lookup-def name scope-subst) name)))))
    12281274                                            (or (and x (nemo:quantity? x)
     
    12361282                                 (match-let (((cqs scope-subst1)   (loop lst (list) scope scope-subst)))
    12371283                                            (let ((comp  (COMPONENT name1 typ cqs scope-subst1)))
    1238                                               (environment-extend! sys sym comp)
     1284                                              (hash-table-set! sys sym comp)
    12391285                                              (list (cons sym qs) scope-subst1))))))
    12401286
     
    12441290                                   (match-let (((cqs scope-subst1)   (loop lst (list) scope scope-subst)))
    12451291                                      (let ((comp  (COMPONENT sym typ cqs scope-subst1)))
    1246                                         (environment-extend! sys sym comp)
     1292                                        (hash-table-set! sys sym comp)
    12471293                                        (list (cons sym qs) scope-subst1)))))
    12481294
     
    12571303                             (match-let
    12581304                              (((functor-args functor-type functor-lst)
    1259                                 (let ((x (environment-ref sys functor-name)))
     1305                                (let ((x (hash-table-ref sys functor-name)))
    12601306                                  (or (and (nemo:quantity? x)
    12611307                                           (cases nemo:quantity x
     
    12891335                                    (let* ((sym    (fresh "comp"))
    12901336                                           (comp   (COMPONENT name functor-type (append cqs1 cqs2) scope-subst2)))
    1291                                       (environment-extend! sys sym comp)
     1337                                      (hash-table-set! sys sym comp)
    12921338                                     
    12931339                                      (list (cons sym qs) '())))))))
     
    13011347                             (let* ((sym      (string->symbol (->string name)))
    13021348                                    (functor  (FUNCTOR sym args typ lst)))
    1303                                (if (environment-has-binding? sys sym)
     1349                               (if (hash-table-exists? sys sym)
    13041350                                   (nemo:error 'eval-nemo-system-decls! ": functor " sym " already defined"))
    1305                                (environment-extend! sys sym functor)
     1351                               (hash-table-set! sys sym functor)
    13061352                               (list (cons sym qs) '())))
    13071353                           
  • release/4/nemo/trunk/nemo-deploy-linux.sh

    r26234 r27093  
    33${CHICKEN_HOME}/bin/chicken-install -location ${CHICKEN_EGGS_DIR} -transport local \
    44 -deploy -prefix $PWD/nemo \
    5  make matchable iexpr sxml-transforms ssax sxpath datatype vector-lib environments \
     5 make matchable iexpr sxml-transforms ssax sxpath datatype vector-lib \
    66 digraph graph-bfs graph-cycles graph-scc mathh strictly-pretty varsubst lalr \
    77 getopt-long dyn-vector iset input-parse nemo
  • release/4/nemo/trunk/nemo-deploy-macosx.sh

    r26232 r27093  
    33${CHICKEN_HOME}/bin/chicken-install -location ${CHICKEN_EGGS_DIR} -transport local \
    44 -deploy -prefix $PWD/nemo \
    5  make matchable iexpr sxml-transforms ssax sxpath datatype vector-lib environments \
     5 make matchable iexpr sxml-transforms ssax sxpath datatype vector-lib \
    66 digraph graph-bfs graph-cycles graph-scc mathh strictly-pretty varsubst lalr \
    77 getopt-long dyn-vector iset input-parse nemo
  • release/4/nemo/trunk/nemo-gate-complex.scm

    r26152 r27093  
    2424  nemo:gate-complex-query)
    2525
    26  (import scheme chicken srfi-1 srfi-13)
     26 (import scheme chicken srfi-1 srfi-13 srfi-69)
    2727
    28  (require-extension environments matchable nemo-core nemo-utils)
     28 (require-extension matchable nemo-core nemo-utils)
    2929
    3030(define (cid x)  (second x))
     
    3737
    3838(define (nemo:ion-pool-query sys)
    39    (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
     39   (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
    4040     (let recur ((comp-name (nemo-intern 'toplevel)) (ax (list)))
    4141       (let ((subcomps  ((dis 'component-subcomps)  sys comp-name)))
     
    5757                       (out-concentration-name (lambda (ion-name) (s+ ion-name 'o))))
    5858
    59   (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
     59  (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
    6060    (let ((imports  ((dis 'imports)  sys))
    6161          (exports  ((dis 'exports)  sys)))
  • release/4/nemo/trunk/nemo-macros.scm

    r25870 r27093  
    2222        (nemo-begin nemo-model nemo-transform)
    2323
    24         (import scheme chicken srfi-1)
     24        (import scheme chicken srfi-1 srfi-69)
    2525       
    26         (require-extension matchable environments nemo-core )
    27         (import-for-syntax matchable environments nemo-core)
     26        (require-extension matchable nemo-core )
     27        (import-for-syntax matchable nemo-core)
    2828
    2929(define-syntax nemo-begin
     
    3636          (%match  (r 'match)))
    3737      `(,%begin
    38          (,%if (not (environment? ,sys)) (nemo:error 'nemo-begin "system argument must be an environment"))
    39          (,%let ((nemo (,%match (environment-ref ,sys (nemo-intern 'nemocore))
     38         (,%if (not (hash-table? ,sys)) (nemo:error 'nemo-begin "system argument must be an environment"))
     39         (,%let ((nemo (,%match (hash-table-ref ,sys (nemo-intern 'nemocore))
    4040                                (($ nemo:quantity 'DISPATCH value)  value))))
    4141                ,@body)))))
     
    6666          (%let*     (r 'let*)))
    6767      `(,%begin
    68         (,%if (not (environment? ,sys)) (nemo:error 'nemo-transform "system argument must be an environment"))
    69         (,%let* ((nemo  (,%match (environment-ref ,sys (nemo-intern 'dispatch))
     68        (,%if (not (hash-table? ,sys)) (nemo:error 'nemo-transform "system argument must be an environment"))
     69        (,%let* ((nemo  (,%match (hash-table-ref ,sys (nemo-intern 'dispatch))
    7070                                 (($ nemo:quantity 'DISPATCH value)  value)))
    7171                 (sys1 (nemo:env-copy ,sys))
  • release/4/nemo/trunk/nemo-matlab.scm

    r26274 r27093  
    2424         nemo:octave-translator)
    2525
    26         (import scheme chicken utils data-structures lolevel ports srfi-1 srfi-13)
     26        (import scheme chicken utils data-structures lolevel ports srfi-1 srfi-13 srfi-69)
    2727       
    28         (require-extension lolevel matchable strictly-pretty environments
     28        (require-extension lolevel matchable strictly-pretty
    2929                           varsubst datatype nemo-core nemo-utils
    3030                           nemo-gate-complex)
     
    4040      sqrt tan cosh sinh tanh hypot gamma lgamma log10 log2 log1p ldexp cube
    4141      > < <= >= = and or round ceiling floor max min
    42       fpvector-ref))
     42      ))
    4343
    4444(define (matlab-name s)
     
    5858                                         `(let ((,tmp ,x)) (* . ,(list-tabulate (inexact->exact y) (lambda (i) tmp)))))
    5959                              x)
    60                             (if (zero? y) 1.0 expr)))
     60                            (if (and (number? y) (zero? y)) 1.0 expr)))
    6161         ((s . es)    (if (symbol? s)  (cons (if (member s builtin-fns) s (matlab-name s)) (map (lambda (x) (rhsexpr/MATLAB x)) es)) expr))
    6262         (id          (if (symbol? id) (matlab-name id) id))))
     
    306306     (fold  (lambda (x ax)
    307307              (match-let (((i . n)  x))
    308                          (let ((en (environment-ref sys n)))
     308                         (let ((en (hash-table-ref sys n)))
    309309                           (if (nemo:quantity? en)
    310310                               (cases nemo:quantity en
     
    320320     (fold  (lambda (x ax)
    321321              (match-let (((i . n)  x))
    322                          (let ((en (environment-ref sys n)))
     322                         (let ((en (hash-table-ref sys n)))
    323323                           (if (nemo:quantity? en)
    324324                               (cases nemo:quantity en
     
    349349     (fold  (lambda (x ax)
    350350              (match-let (((i . n)  x))
    351                          (let ((en (environment-ref sys n)))
     351                         (let ((en (hash-table-ref sys n)))
    352352                           (if (nemo:quantity? en)
    353353                               (cases nemo:quantity en
     
    366366      (lambda (x ax)
    367367              (match-let (((i . n)  x))
    368                          (let ((en (environment-ref sys n)))
     368                         (let ((en (hash-table-ref sys n)))
    369369                           (if (nemo:quantity? en)
    370370                               (cases nemo:quantity en
     
    391391     (fold  (lambda (x ax)
    392392              (match-let (((i . n)  x))
    393                          (let ((en (environment-ref sys n)))
     393                         (let ((en (hash-table-ref sys n)))
    394394                           (if (nemo:quantity? en)
    395395                               (cases nemo:quantity en
     
    406406
    407407(define (rate/reaction-power sys n)
    408   (let ((en (environment-ref sys n)))
     408  (let ((en (hash-table-ref sys n)))
    409409    (if (nemo:quantity? en)
    410410        (cases nemo:quantity en
     
    680680  (define (cn x)   (first x))
    681681  (let-optionals rest ((mode 'multiple) (method 'lsode) (filename #t) (dirname "."))
    682   (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
     682  (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
    683683    (let ((imports  ((dis 'imports)  sys))
    684684          (exports  ((dis 'exports)  sys)))
  • release/4/nemo/trunk/nemo-nest.scm

    r26477 r27093  
    2525        (nemo:nest-translator)
    2626
    27         (import scheme chicken utils data-structures lolevel ports extras srfi-1 srfi-13)
     27        (import scheme chicken utils data-structures lolevel ports extras srfi-1 srfi-13 srfi-69)
    2828       
    29         (require-extension lolevel matchable strictly-pretty environments
     29        (require-extension lolevel matchable strictly-pretty
    3030                           varsubst datatype nemo-core nemo-utils
    3131                           nemo-gate-complex nemo-synapse)
     
    4141      sqrt tan cosh sinh tanh hypot gamma lgamma log10 log2 log1p ldexp cube
    4242      > < <= >= = and or round ceiling floor max min
    43       fpvector-ref))
     43      ))
    4444
    4545(define (nest-name s)
     
    5959                                         `(let ((,tmp ,x)) (* . ,(list-tabulate (inexact->exact y) (lambda (i) tmp)))))
    6060                              x)
    61                             (if (zero? y) 1.0 expr)))
     61                            (if (and (number? y) (zero? y)) 1.0 expr)))
    6262         ((s . es)    (if (symbol? s)  (cons (if (member s builtin-fns) s (nest-name s)) (map (lambda (x) (rhsexpr/C++ x)) es)) expr))
    6363         (id          (if (symbol? id) (nest-name id) id))))
     
    260260     (fold  (lambda (x ax)
    261261              (match-let (((i . n)  x))
    262                          (let ((en (environment-ref sys n)))
     262                         (let ((en (hash-table-ref sys n)))
    263263                           (if (nemo:quantity? en)
    264264                               (cases nemo:quantity en
     
    274274     (fold  (lambda (x ax)
    275275              (match-let (((i . n)  x))
    276                          (let ((en (environment-ref sys n)))
     276                         (let ((en (hash-table-ref sys n)))
    277277                           (if (nemo:quantity? en)
    278278                               (cases nemo:quantity en
     
    298298     (fold  (lambda (x ax)
    299299              (match-let (((i . n)  x))
    300                          (let ((en (environment-ref sys n)))
     300                         (let ((en (hash-table-ref sys n)))
    301301                           (if (nemo:quantity? en)
    302302                               (cases nemo:quantity en
     
    315315      (lambda (x ax)
    316316              (match-let (((i . n)  x))
    317                          (let ((en (environment-ref sys n)))
     317                         (let ((en (hash-table-ref sys n)))
    318318                           (if (nemo:quantity? en)
    319319                               (cases nemo:quantity en
     
    340340     (fold  (lambda (x ax)
    341341              (match-let (((i . n)  x))
    342                          (let ((en (environment-ref sys n)))
     342                         (let ((en (hash-table-ref sys n)))
    343343                           (if (nemo:quantity? en)
    344344                               (cases nemo:quantity en
     
    370370
    371371(define (rate/reaction-power sys n)
    372   (let ((en (environment-ref sys n)))
     372  (let ((en (hash-table-ref sys n)))
    373373    (if (nemo:quantity? en)
    374374        (cases nemo:quantity en
     
    14541454
    14551455  (let-optionals rest ((dirname "."))
    1456   (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
     1456  (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
    14571457    (let ((imports  ((dis 'imports)  sys))
    14581458          (exports  ((dis 'exports)  sys)))
  • release/4/nemo/trunk/nemo-nmodl.scm

    r27007 r27093  
    2323        (nemo:nmodl-translator)
    2424
    25         (import scheme chicken utils data-structures lolevel srfi-1 srfi-13 )
     25        (import scheme chicken utils data-structures lolevel srfi-1 srfi-13 srfi-69)
    2626
    2727        (require-extension lolevel datatype matchable strictly-pretty
    28                            environments varsubst datatype
     28                           varsubst datatype
    2929                           nemo-core nemo-utils nemo-gate-complex)
    3030
     
    3939      sqrt tan cosh sinh tanh hypot gamma lgamma log10 log2 log1p ldexp cube
    4040      > < <= >= = and or round ceiling floor max min
    41       fpvector-ref))
     41      ))
    4242
    4343
     
    6666                                         `(let ((,tmp ,x)) (* . ,(list-tabulate (inexact->exact y) (lambda (i) tmp)))))
    6767                              x)
    68                           (if (zero? y) 1.0 expr)))
     68                          (if (and (number? y) (zero? y)) 1.0 expr)))
    6969         ((s . es)    (if (symbol? s)   (cons (if (member s builtin-fns) s (nmodl-name s)) (map (lambda (x) (rhsexpr/NMODL x)) es)) expr))
    7070         (id          (if (symbol? id) (nmodl-name id) id))))
     
    472472     (fold  (lambda (x ax)
    473473              (match-let (((i . n)  x))
    474                          (let ((en (environment-ref sys n)))
     474                         (let ((en (hash-table-ref sys n)))
    475475                           (if (nemo:quantity? en)
    476476                               (cases nemo:quantity en
     
    489489     (fold  (lambda (x ax)
    490490              (match-let (((i . n)  x))
    491                          (let ((en (environment-ref sys n)))
     491                         (let ((en (hash-table-ref sys n)))
    492492                           (if (nemo:quantity? en)
    493493                               (cases nemo:quantity en
     
    504504     (fold  (lambda (x ax)
    505505              (match-let (((i . n)  x))
    506                          (let ((en (environment-ref sys n)))
     506                         (let ((en (hash-table-ref sys n)))
    507507                           (if (and (not (member n kinetic)) (nemo:quantity? en))
    508508                               (cases nemo:quantity en
     
    532532     (fold  (lambda (x ax)
    533533              (match-let (((i . n)  x))
    534                          (let ((en (environment-ref sys n)))
     534                         (let ((en (hash-table-ref sys n)))
    535535                           (if (and (member n kinetic) (nemo:quantity? en))
    536536                               (cases nemo:quantity en
     
    548548     (fold  (lambda (x ax)
    549549              (match-let (((i . n)  x))
    550                          (let ((en (environment-ref sys n)))
     550                         (let ((en (hash-table-ref sys n)))
    551551                           (if (nemo:quantity? en)
    552552                               (cases nemo:quantity en
     
    570570     (fold  (lambda (x ax)
    571571              (match-let (((i . n)  x))
    572                          (let ((en (environment-ref sys n)))
     572                         (let ((en (hash-table-ref sys n)))
    573573                           (if (nemo:quantity? en)
    574574                               (cases nemo:quantity en
     
    599599
    600600(define (rate/reaction-power sys n)
    601   (let ((en (environment-ref sys n)))
     601  (let ((en (hash-table-ref sys n)))
    602602    (if (nemo:quantity? en)
    603603        (cases nemo:quantity en
     
    627627  (let-optionals rest ((method 'cnexp) (table? #f) (min-v -100) (max-v 100) (step 0.5)
    628628                       (depend #f)  (kinetic (list)) (linear? #f))
    629   (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
     629  (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
    630630    (let ((imports  ((dis 'imports)  sys))
    631631          (exports  ((dis 'exports)  sys)))
  • release/4/nemo/trunk/nemo-pyparams.scm

    r25987 r27093  
    2323        (nemo:pyparams-translator)
    2424
    25         (import scheme chicken utils data-structures lolevel ports srfi-1 srfi-13)
     25        (import scheme chicken utils data-structures lolevel ports srfi-1 srfi-13 srfi-69)
    2626       
    27         (require-extension lolevel matchable strictly-pretty environments
     27        (require-extension lolevel matchable strictly-pretty
    2828                           varsubst datatype nemo-core nemo-utils
    2929                           nemo-gate-complex)
     
    3939      sqrt tan cosh sinh tanh hypot gamma lgamma log10 log2 log1p ldexp cube
    4040      > < <= >= = and or round ceiling floor max min
    41       fpvector-ref))
     41      ))
    4242
    4343(define (python-name s)
     
    309309     (fold  (lambda (x ax)
    310310              (match-let (((i . n)  x))
    311                          (let ((en (environment-ref sys n)))
     311                         (let ((en (hash-table-ref sys n)))
    312312                           (if (nemo:quantity? en)
    313313                               (cases nemo:quantity en
     
    323323     (fold  (lambda (x ax)
    324324              (match-let (((i . n)  x))
    325                          (let ((en (environment-ref sys n)))
     325                         (let ((en (hash-table-ref sys n)))
    326326                           (if (nemo:quantity? en)
    327327                               (cases nemo:quantity en
     
    347347     (fold  (lambda (x ax)
    348348              (match-let (((i . n)  x))
    349                          (let ((en (environment-ref sys n)))
     349                         (let ((en (hash-table-ref sys n)))
    350350                           (if (nemo:quantity? en)
    351351                               (cases nemo:quantity en
     
    364364      (lambda (x ax)
    365365              (match-let (((i . n)  x))
    366                          (let ((en (environment-ref sys n)))
     366                         (let ((en (hash-table-ref sys n)))
    367367                           (if (nemo:quantity? en)
    368368                               (cases nemo:quantity en
     
    389389     (fold  (lambda (x ax)
    390390              (match-let (((i . n)  x))
    391                          (let ((en (environment-ref sys n)))
     391                         (let ((en (hash-table-ref sys n)))
    392392                           (if (nemo:quantity? en)
    393393                               (cases nemo:quantity en
     
    404404
    405405(define (reaction-power sys n)
    406   (let ((en (environment-ref sys n)))
     406  (let ((en (hash-table-ref sys n)))
    407407    (if (nemo:quantity? en)
    408408        (cases nemo:quantity en
     
    517517  (define (cn x)   (first x))
    518518  (let-optionals rest ((mode 'multiple) (filename #f))
    519   (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
     519  (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
    520520    (let ((imports  ((dis 'imports)  sys))
    521521          (exports  ((dis 'exports)  sys)))
  • release/4/nemo/trunk/nemo-synapse.scm

    r26351 r27093  
    2323 (nemo:post-synaptic-conductance-query)
    2424
    25  (import scheme chicken srfi-1 srfi-13)
     25 (import scheme chicken srfi-1 srfi-13 srfi-69)
    2626
    27  (require-extension environments matchable nemo-core nemo-utils)
     27 (require-extension matchable nemo-core nemo-utils)
    2828
    2929(define (cid x)  (second x))
     
    3535
    3636
    37   (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
     37  (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
    3838
    3939    (let ((imports  ((dis 'imports)  sys))
  • release/4/nemo/trunk/nemo-utils.scm

    r26013 r27093  
    269269
    270270
    271 ;;    `(+ - * / pow neg abs atan asin acos sin cos exp ln
    272 ;;      sqrt tan cosh sinh tanh hypot gamma lgamma log10 log2 log1p ldexp cube
    273 ;;      > < <= >= = and or round ceiling floor max min
    274 ;;      fpvector-ref))
    275 
    276271(define LOG10E 0.434294481903252)
    277272(define LOG2E  1.44269504088896)
  • release/4/nemo/trunk/nemo.meta

    r26269 r27093  
    2222
    2323 (needs make matchable (iexpr 1.8) sxml-transforms ssax sxpath
    24         datatype vector-lib environments digraph graph-bfs graph-cycles
    25         mathh strictly-pretty varsubst (lalr 2.4.2)
     24        datatype vector-lib digraph graph-bfs graph-cycles
     25        mathh strictly-pretty (varsubst 1.3) (lalr 2.4.2)
    2626        getopt-long)
    2727
  • release/4/nemo/trunk/nemo.scm

    r27021 r27093  
    1919;;
    2020
    21 (import files setup-api srfi-1 srfi-4 srfi-13)
     21(import files setup-api srfi-1 srfi-4 srfi-13 srfi-69)
    2222
    2323(define deployed? (make-parameter #f))
     
    4242(require-extension matchable lalr-driver
    4343                   ssax sxml-transforms sxpath sxpath-lolevel
    44                    environments getopt-long)
     44                   getopt-long)
    4545(import (prefix iexpr iexpr: ))
    4646
     
    481481(define (make-component->ncml dis model parse-expr)
    482482  (lambda (x)
    483     (let ((en (environment-ref model x)))
     483    (let ((en (hash-table-ref model x)))
    484484        (cond ((procedure? en)
    485485               (let ((fd (procedure-data en)))
     
    547547(define (model->ncml model parse-expr)
    548548  (match-let ((($ nemo:quantity 'DISPATCH  dis)     
    549                (environment-ref model (nemo-intern 'dispatch))))
     549               (hash-table-ref model (nemo-intern 'dispatch))))
    550550     (let ((sysname     ((dis 'sysname) model))
    551551           (component->ncml (make-component->ncml dis model parse-expr)))
     
    10051005         (lambda (operand model.iexpr)
    10061006
    1007            (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref (car model.iexpr) (nemo-intern 'dispatch))))
     1007           (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref (car model.iexpr) (nemo-intern 'dispatch))))
    10081008                     
    10091009            (let* ((model (car model.iexpr))
  • release/4/nemo/trunk/nemo.setup

    r26989 r27093  
    44  (make-pathname #f fn ##sys#load-dynamic-extension))   
    55
    6 (define nemo-version 6.5)
     6(define nemo-version 6.6)
    77
    88(use make)
Note: See TracChangeset for help on using the changeset viewer.