source: project/release/4/9ML-toolkit/trunk/NineMLdiagram.scm @ 30917

Last change on this file since 30917 was 30917, checked in by Ivan Raikov, 6 years ago

9ML-toolkit: reformulation of regimes to use ON signal combinator; added LIF UL xml file; fixes to AEIF example

File size: 3.9 KB
Line 
1
2(define (Diagram:module-initialize module-name enter-module find-module eval-env )
3 
4  (define path-sigfun   (Pdot (Pident (ident-create "Signal")) "sigfun"))
5  (define sigfun-type   (Tcon (Tpath path-sigfun) '()))
6 
7  (define ident-diagram   (ident-create "diagram"))
8  (define path-diagram    (Pident ident-diagram))
9  (define diagram-type    (Tcon (Tpath path-diagram) '()))
10
11  (define ident-pure   (ident-create "pure"))
12  (define path-pure    (Pident ident-pure))
13  (define pure-type    (Tcon (Tpath path-pure) '()))
14
15  (define-values (type-variables reset-type-variables
16                                 find-type-variable instance typerepr
17                                 begin-def end-def newvar generalize
18                                 make-deftype make-valtype make-kind
19                                 binop ternop path-star path-list path-arrow
20                                 star-type list-type arrow-type label-type string-type bot-type
21                                 )
22    (core-utils))
23
24  (let (
25        (sig
26          (list
27           (Type_sig ident-pure (make-typedecl (make-kind 0) #f))
28           (Type_sig ident-diagram (make-typedecl (make-kind 0) #f))
29
30           (Value_sig (ident-create "IDENTITY") 
31                      (make-valtype '() (arrow-type diagram-type diagram-type)))
32
33           (Value_sig (ident-create "SENSE") 
34                      (make-valtype '() (arrow-type (list-type label-type) (arrow-type diagram-type diagram-type))))
35
36           (Value_sig (ident-create "ACTUATE") 
37                      (make-valtype '() (arrow-type (list-type label-type) (arrow-type diagram-type diagram-type))))
38
39           (Value_sig (ident-create "ASSIGN") 
40                      (make-valtype '() (arrow-type (list-type label-type) (arrow-type pure-type diagram-type))))
41           
42           (Value_sig (ident-create "ODE") 
43                      (make-valtype '() (arrow-type (list-type sigfun-type) (arrow-type sigfun-type (arrow-type sigfun-type  (arrow-type pure-type diagram-type))))))
44
45           (Value_sig (ident-create "PURE") 
46                      (make-valtype '() (arrow-type sigfun-type pure-type)))
47           
48           (Value_sig (ident-create "GROUP") 
49                      (make-valtype '() (arrow-type pure-type (arrow-type pure-type pure-type))))
50           
51           (Value_sig (ident-create "RELATION") 
52                      (make-valtype '() (arrow-type label-type (arrow-type label-type (arrow-type sigfun-type (arrow-type pure-type pure-type))))))
53
54           (Value_sig (ident-create "SEQUENCE") 
55                      (make-valtype '() (arrow-type diagram-type (arrow-type diagram-type diagram-type))))
56           
57           (Value_sig (ident-create "UNION") 
58                      (make-valtype '() (arrow-type diagram-type (arrow-type diagram-type diagram-type))))
59
60           (Value_sig (ident-create "TRANSITION") 
61                      (make-valtype '() (arrow-type diagram-type (arrow-type diagram-type (arrow-type sigfun-type diagram-type)))))
62           
63           (Value_sig (ident-create "TRANSIENT") 
64                      (make-valtype '() (arrow-type diagram-type (arrow-type diagram-type (arrow-type sigfun-type diagram-type)))))
65           
66           (Value_sig (ident-create "ON") 
67                      (make-valtype '() (arrow-type diagram-type (arrow-type sigfun-type diagram-type))))
68           
69           (Value_sig (ident-create "RTRANSITION") 
70                      (make-valtype '() (arrow-type diagram-type 
71                                                    (arrow-type diagram-type
72                                                                (arrow-type sigfun-type
73                                                                            (arrow-type sigfun-type (arrow-type sigfun-type diagram-type)))))))
74
75           ))
76
77
78        (struct
79         (list
80
81          (Type_def ident-diagram (make-kind 0) 
82                    (make-deftype '() (Tcon (Tpath path-diagram) '()) ))
83
84          (datacon 'diagram 'SENSE   2)
85          (datacon 'diagram 'ACTUATE 2)
86          (datacon 'diagram 'ASSIGN 2)
87          (datacon 'diagram 'ODE 4)
88          (datacon 'pure 'RELATION 4)
89          (datacon 'pure 'PURE 1)
90          (datacon 'pure 'GROUP 2)
91          (datacon 'diagram 'IDENTITY 1)
92          (datacon 'diagram 'TRANSITION 3)
93          (datacon 'diagram 'TRANSIENT 3)
94          (datacon 'diagram 'RTRANSITION 5)
95          (datacon 'diagram 'ON 2)
96          (datacon 'diagram 'SEQUENCE 2)
97          (datacon 'diagram 'UNION 2)
98
99         ))
100         
101        )
102
103    (let ((modname (ident-create module-name)))
104      (enter-module modname (Signature sig))
105      (eval-env (mod-eval-cbv (eval-env) (list (Module_def modname (Structure struct)))))
106    )
107  ))
108
109
Note: See TracBrowser for help on using the repository browser.