]> git.jsancho.org Git - gacela.git/commitdiff
(no commit message)
authorjsancho <devnull@localhost>
Tue, 20 Sep 2011 19:29:48 +0000 (19:29 +0000)
committerjsancho <devnull@localhost>
Tue, 20 Sep 2011 19:29:48 +0000 (19:29 +0000)
src/gacela_mobs.scm

index dabb9dc2a40102aa5202fb171f510c52bfc1e3e6..313848c6cc7801c7ae2bbeeffc9929ea876b7895 100755 (executable)
   (let ((name (car mob-head)) (attr (cdr mob-head)))
     `(define ,(string->symbol (string-concatenate (list "make-" (symbol->string name))))
        (lambda* ,(if (null? attr) '() `(#:key ,@attr))
   (let ((name (car mob-head)) (attr (cdr mob-head)))
     `(define ,(string->symbol (string-concatenate (list "make-" (symbol->string name))))
        (lambda* ,(if (null? attr) '() `(#:key ,@attr))
-        (lambda-mob () ,@body)))))
+        (the-mob ',name () ,attr ,@body)))))
 
 
-(define-macro (lambda-mob attr . body)
+(define-macro (the-mob type attr publish . body)
   (let ((mob-id-symbol (gensym))
   (let ((mob-id-symbol (gensym))
-       (type-mob
-    `(let ,(cons `(,mob-id-symbol (gensym)) attr)
+       (type-symbol (gensym)))
+    `(let ((,mob-id-symbol (gensym))
+          (,type-symbol ,type)
+          ,@attr)
        (lambda* (#:optional (option #f))
         (define (kill-me)
           (hide-mob-hash ,mob-id-symbol))
         (case option
           ((get-mob-id)
            ,mob-id-symbol)
        (lambda* (#:optional (option #f))
         (define (kill-me)
           (hide-mob-hash ,mob-id-symbol))
         (case option
           ((get-mob-id)
            ,mob-id-symbol)
+          ((get-type)
+           ,type-symbol)
           (else
           (else
+           (display ,(cons 'list (map (lambda (x) `(acons ',(car x) ,(car x) '())) publish)))
+           (newline)
            (catch #t
                   (lambda () ,@body)
                   (lambda (key . args) #f))))))))
            (catch #t
                   (lambda () ,@body)
                   (lambda (key . args) #f))))))))
+
+(define-macro (lambda-mob attr . body)
+  `(the-mob 'undefined ,attr '() ,@body))