source: project/release/4/nemo/trunk/nemo-macros.scm @ 27093

Last change on this file since 27093 was 27093, checked in by Ivan Raikov, 9 years ago

nemo: eliminated dependency on environments

File size: 2.3 KB
Line 
1;;
2;; NEMO macros
3;;
4;; Copyright 2008-2012 Ivan Raikov and the Okinawa Institute of Science and Technology
5;;
6;; This program is free software: you can redistribute it and/or
7;; modify it under the terms of the GNU General Public License as
8;; published by the Free Software Foundation, either version 3 of the
9;; License, or (at your option) any later version.
10;;
11;; This program is distributed in the hope that it will be useful, but
12;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14;; General Public License for more details.
15;;
16;; A full copy of the GPL license can be found at
17;; <http://www.gnu.org/licenses/>.
18;;
19
20(module nemo-macros
21       
22        (nemo-begin nemo-model nemo-transform)
23
24        (import scheme chicken srfi-1 srfi-69)
25       
26        (require-extension matchable  nemo-core )
27        (import-for-syntax matchable  nemo-core)
28
29(define-syntax nemo-begin
30  (lambda (f r c)
31    (let ((sys  (cadr f))
32          (body (cddr f))
33          (%begin  (r 'begin))
34          (%if     (r 'if))
35          (%let    (r 'let))
36          (%match  (r 'match)))
37      `(,%begin
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))
40                                (($ nemo:quantity 'DISPATCH value)  value))))
41                ,@body)))))
42
43
44(define-syntax nemo-model 
45  (lambda (f r c)
46    (let ((name  (cadr f))
47          (declarations (caddr f))
48          (body         (cdddr f))
49          (%begin    (r 'begin))
50          (%let*     (r 'let*)))
51      `(,%begin
52        (,%let* ((nemo   (make-nemo-core))
53                 (,name     ((nemo 'system) ',name)))
54                (eval-nemo-system-decls nemo ',name ,name (list ,@(map (lambda (x) (list 'quasiquote x)) declarations)))
55                ,@body)))))
56                   
57
58(define-syntax nemo-transform
59  (lambda (f r c)
60    (let ((sys  (cadr f))
61          (declarations (caddr f))
62          (body         (cdddr f))
63          (%begin    (r 'begin))
64          (%if       (r 'if))
65          (%match    (r 'match))
66          (%let*     (r 'let*)))
67      `(,%begin
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))
70                                 (($ nemo:quantity 'DISPATCH value)  value)))
71                 (sys1 (nemo:env-copy ,sys))
72                 (name ((nemo 'sysname) sys1)))
73                (eval-nemo-system-decls nemo name sys1 (list ,@(map (lambda (x) (list 'quasiquote x)) declarations)))
74                sys1)))))
75
76)
Note: See TracBrowser for help on using the repository browser.