Changeset 31417 in project


Ignore:
Timestamp:
09/14/14 10:13:00 (7 years ago)
Author:
Ivan Raikov
Message:

nemo: refactoring code generator to using ersatz templates

File:
1 edited

Legend:

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

    r31356 r31417  
    3030
    3131                           )
     32        (require-library ersatz-lib)
     33
     34        (import (prefix ersatz-lib ersatz: ))
     35
     36
     37(define (tenv-enter x env)
     38  (let ((k (car x)) (v (cdr x)))
     39    (cons (cons k (if (null? v)
     40                      (ersatz:Tlist '())
     41                      (ersatz:sexpr->tvalue v)))
     42          env)))
     43
     44
     45(define (instantiate-template tmpl tmpl-vars)
     46    (let ((ctx (ersatz:init-context models: tmpl-vars )))
     47      (display
     48       (ersatz:eval-statements
     49        tmpl
     50        env: (ersatz:template-std-env autoescape: #f)
     51        models: tmpl-vars ctx: ctx
     52        ))
     53      ))
    3254
    3355
    3456(define C++-ops
    3557  `(+ - * / > < <= >= =))
    36 
    3758
    3859
     
    234255
    235256
    236 (define (make-define-fn sysname )
     257
     258(define fn-template
     259  (ersatz:statements-from-string
     260   (ersatz:template-std-env autoescape: #f)
     261#<<EOF
     262
     263{{returnType}} {{functionName}} {{ join (", ", functionVars) }} {
     264
     265  double {{returnVar}};
     266
     267{% if (!(localVars == [])) %}
     268  double {{join(", ", localVars)}};
     269{% endif %}
     270
     271{% if (!(consts == [])) %}
     272  double {{join(", ", consts)}};
     273  const ~A::Parameters_{{sysname}} & p = *(reinterpret_cast< const ~A::Parameters_ *>(params));
     274
     275{% for const in consts %}
     276  {{const}} =  p.{{const}};
     277{% endfor %}
     278{% endif %}
     279
     280{{ pad(indent,exprString) }}
     281
     282  return {{returnVar}};
     283}
     284
     285EOF
     286))
     287
     288
     289
     290(define fn-header
     291  (ersatz:statements-from-string
     292   (ersatz:template-std-env autoescape: #f)
     293#<<EOF
     294
     295{{returnType}} {{functionName}} {{ join (", ", functionVars) }} {
     296
     297  double {{returnVar}};
     298
     299{% if (!(localVars == [])) %}
     300  double {{join(", ", localVars)}};
     301{% endif %}
     302
     303{% if (!(consts == [])) %}
     304  double {{join(", ", consts)}};
     305  const ~A::Parameters_{{sysname}} & p = *(reinterpret_cast< const ~A::Parameters_ *>(params));
     306
     307{% for const in consts %}
     308  {{const}} =  p.{{const}};
     309{% endfor %}
     310{% endif %}
     311
     312{{ pad(indent,exprString) }}
     313
     314  return {{returnVar}};
     315}
     316
     317EOF
     318))
     319
     320
     321(define (make-fn-translator sysname )
    237322  (lambda (indent n proc)
    238323
    239     (let ((lst (procedure-data proc))
    240           (indent+ (+ 2 indent)))
    241 
    242       (let ((rt       (or (lookup-def 'rt lst) 'double))
    243             (formals  (lookup-def 'formals lst))
    244             (vars     (lookup-def 'vars lst))
    245             (consts   (filter (lambda (x) (not (procedure? (cdr x)))) (lookup-def 'consts lst)))
    246             (body     (lookup-def 'body lst))
    247             (rv       (gensym 'rv)))
    248 
    249         (let ((argument-list
    250                (append
    251                 (if (null? vars) '() (map (lambda (x) (sprintf "double ~A" (nest-name x))) vars))
    252                 '("const void* params"))))
    253           (pp indent ,nl (,rt ,(nest-name n) (,(slp ", " argument-list)) "{" ))
    254           (let* ((body0 (rhsexpr/C++ body))
    255                  (body1 (canonicalize-expr/C++ (add-params-to-fncall body0 builtin-fns)))
    256                  (lbs   (enum-bnds body1 (list))))
    257             (pp indent+ (double ,rv ";"))
    258             (if (not (null? lbs)) (pp indent+ (double ,(slp ", " lbs) ";")))
    259             (if (not (null? consts))
    260                 (begin (pp indent+ (double ,(slp ", " (map (compose nest-name car) consts)) ";")
    261                            (,(sprintf "const ~A::Parameters_" sysname) "& p =  "
    262                             ,(sprintf " *(reinterpret_cast< const ~A::Parameters_ *>(params));" sysname)))
    263                        (for-each (lambda (x) (let ((n (car x)))
    264                                                (pp indent+ (,(nest-name n) = ,(sprintf "p.~A;" (nest-name n))))))
    265                                  consts)
    266                        ))
    267             (pp indent+ ,(expr->string/C++ body1 (nest-name rv)))
    268             (pp indent+ ,(s+ "return " rv ";"))
    269             ))
    270         (pp indent "}"))
    271     )))
     324    (let* (
     325           (lst      (procedure-data proc))
     326           (indent+  (+ 2 indent))
     327           (rt       (or (lookup-def 'rt lst) 'double))
     328           (formals  (lookup-def 'formals lst))
     329           (vars     (lookup-def 'vars lst))
     330           (consts   (filter (lambda (x) (not (procedure? (cdr x)))) (lookup-def 'consts lst)))
     331           (body     (lookup-def 'body lst))
     332           (rv       (gensym 'rv))
     333           (body0    (rhsexpr/C++ body))
     334           (body1    (canonicalize-expr/C++ (add-params-to-fncall body0 builtin-fns)))
     335           (lbs      (enum-bnds body1 (list)))
     336           )
     337
     338        (let (
     339              (tmpl-env
     340               (fold tenv-enter '()
     341                     `(
     342                       (indent       . ,indent+)
     343                       (functionName . ,(nest-name n))
     344                       (functionVars . ,(append
     345                                         (if (null? vars) '() (map (lambda (x) (sprintf "double ~A" (nest-name x))) vars))
     346                                         '("const void* params")))
     347                       (localVars    . ,(if (null? lbs) (ersatz:Tlist '()) (ersatz:sexpr->tvalue lbs)))
     348                       (exprString   . ,(ersatz:Tstr (expr->string/C++ body1 (nest-name rv))))
     349                       
     350                       (returnType . ,rt)
     351                       (returnVar  . ,rv)
     352                       
     353                       (consts . ,(map (compose nest-name car) consts))
     354                       ))
     355               )
     356              )
     357
     358          (instantiate-template fn-template tmpl-env)
     359
     360          ))
     361    ))
    272362
    273363
     
    295385
    296386
     387
    297388(define (ith v i) (sprintf "Ith(~A,~A)" v i))
    298389
    299390
    300 (define (output-prelude sysname indent)
    301 
    302   (pp indent ,#<#EOF
    303 ##include "#{sysname}.h"
    304 ##include "exceptions.h"
    305 ##include "network.h"
    306 ##include "dict.h"
    307 ##include "integerdatum.h"
    308 ##include "doubledatum.h"
    309 ##include "dictutils.h"
    310 ##include "numerics.h"
    311 ##include <limits>
    312 
    313 ##include "universal_data_logger_impl.h"
    314 
    315 ##include <iomanip>
    316 ##include <iostream>
    317 ##include <cstdio>
    318 ##include <cstring>
    319 ##include <cmath>
     391(define prelude-template
     392  (ersatz:statements-from-string
     393   (ersatz:template-std-env autoescape: #f)
     394#<<EOF
     395
     396/* This file was generated by {{nemoVersionString}} on {{currentTimestamp}} */
     397
     398
     399#include "{{sysname}}.h"
     400#include "exceptions.h"
     401#include "network.h"
     402#include "dict.h"
     403#include "integerdatum.h"
     404#include "doubledatum.h"
     405#include "dictutils.h"
     406#include "numerics.h"
     407#include <limits>
     408
     409#include "universal_data_logger_impl.h"
     410
     411#include <iomanip>
     412#include <iostream>
     413#include <cstdio>
     414#include <cstring>
     415#include <cmath>
     416
    320417EOF
    321418))
     
    447544
    448545
    449 (define sundials-prelude
     546(define sundials-prelude-template
     547  (ersatz:statements-from-string
     548   (ersatz:template-std-env autoescape: #f)
    450549#<<EOF
    451550
     
    508607
    509608EOF
    510 )
     609))
    511610
    512611(define (fsolve-prelude ss-method)
     
    33603459             )
    33613460       
    3362        
    3363        
    33643461        (for-each
    33653462         (lambda (a)
     
    33773474          (with-output-to-port cpp-output
    33783475            (lambda ()
    3379               (pp indent ,nl ("/* " This file was generated by ,(nemo:version-string) on ,(seconds->string (current-seconds)) " */" ,nl))
    3380               (output-prelude sysname indent)
    3381               ))
    3382          
    3383           (with-output-to-port cpp-output
    3384             (lambda () (pp indent ,nl "namespace nest {" ,nl)))
    3385          
    3386           (case method
    3387             ((cvode ida)
    3388              (with-output-to-port cpp-output
    3389                (lambda ()
    3390                  (pp indent ,sundials-prelude)))))
    3391 
     3476              (instantiate-template prelude-template tmpl-env)
     3477              (pp indent ,nl "namespace nest {" ,nl)
     3478
     3479              (case method
     3480                ((cvode ida)
     3481                 (instantiate-template sundials-prelude-template tmpl-env)
     3482                 ))
     3483
     3484              ))
    33923485
    33933486          (if (not (null? steady-state-index-map))
     
    33983491
    33993492          ;; user-defined functions
    3400           (let ((define-fn  (make-define-fn sysname))
     3493          (let ((define-fn  (make-fn-translator sysname))
    34013494                (define-fn-header (make-define-fn-header sysname)))
    34023495           
Note: See TracChangeset for help on using the changeset viewer.