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

;;
;; NEMO macros
;;
;; Copyright 2008-2012 Ivan Raikov and the Okinawa Institute of Science and Technology
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; A full copy of the GPL license can be found at
;; <http://www.gnu.org/licenses/>.
;;

(module nemo-macros
        
        (nemo-begin nemo-model nemo-transform)

        (import scheme chicken srfi-1)
        
        (require-extension matchable environments nemo-core )
        (import-for-syntax matchable environments nemo-core)

(define-syntax nemo-begin
  (lambda (f r c)
    (let ((sys  (cadr f))
          (body (cddr f))
          (%begin  (r 'begin))
          (%if     (r 'if))
          (%let    (r 'let))
          (%match  (r 'match)))
      `(,%begin
         (,%if (not (environment? ,sys)) (nemo:error 'nemo-begin "system argument must be an environment"))
         (,%let ((nemo (,%match (environment-ref ,sys (nemo-intern 'nemocore))
                                (($ nemo:quantity 'DISPATCH value)  value))))
                ,@body)))))


(define-syntax nemo-model 
  (lambda (f r c)
    (let ((name  (cadr f))
          (declarations (caddr f))
          (body         (cdddr f))
          (%begin    (r 'begin))
          (%let*     (r 'let*)))
      `(,%begin
        (,%let* ((nemo   (make-nemo-core))
                 (,name     ((nemo 'system) ',name)))
                (eval-nemo-system-decls nemo ',name ,name (list ,@(map (lambda (x) (list 'quasiquote x)) declarations)))
                ,@body)))))
                   

(define-syntax nemo-transform
  (lambda (f r c)
    (let ((sys  (cadr f))
          (declarations (caddr f))
          (body         (cdddr f))
          (%begin    (r 'begin))
          (%if       (r 'if))
          (%match    (r 'match))
          (%let*     (r 'let*)))
      `(,%begin
        (,%if (not (environment? ,sys)) (nemo:error 'nemo-transform "system argument must be an environment"))
        (,%let* ((nemo  (,%match (environment-ref ,sys (nemo-intern 'dispatch))
                                 (($ nemo:quantity 'DISPATCH value)  value)))
                 (sys1 (nemo:env-copy ,sys))
                 (name ((nemo 'sysname) sys1)))
                (eval-nemo-system-decls nemo name sys1 (list ,@(map (lambda (x) (list 'quasiquote x)) declarations)))
                sys1)))))

)