diff options
Diffstat (limited to 'legacy/bigloo/api.sch')
| -rw-r--r-- | legacy/bigloo/api.sch | 91 |
1 files changed, 0 insertions, 91 deletions
diff --git a/legacy/bigloo/api.sch b/legacy/bigloo/api.sch deleted file mode 100644 index 390b8fa..0000000 --- a/legacy/bigloo/api.sch +++ /dev/null @@ -1,91 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/src/bigloo/api.sch */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Mon Jul 21 18:15:25 2003 */ -;* Last change : Wed Oct 27 12:43:23 2004 (eg) */ -;* Copyright : 2003-04 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* The Bigloo macros for the API implementation */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* define-pervasive-macro ... */ -;*---------------------------------------------------------------------*/ -(define-macro (define-pervasive-macro proto . body) - `(begin - (eval '(define-macro ,proto ,@body)) - (define-macro ,proto ,@body))) - -;*---------------------------------------------------------------------*/ -;* define-markup ... */ -;*---------------------------------------------------------------------*/ -(define-pervasive-macro (define-markup proto . body) - (define (s2k symbol) - (string->keyword (string-append ":" (symbol->string symbol)))) - (if (not (pair? proto)) - (error 'define-markup "Illegal markup definition" proto) - (let* ((id (car proto)) - (args (cdr proto)) - (dargs (dsssl-formals->scheme-formals args error))) - `(begin - ,(if (and (memq #!key args) - (memq '&skribe-eval-location args)) - `(define-expander ,id - (lambda (x e) - (append - (cons ',id (map (lambda (x) (e x e)) (cdr x))) - (list :&skribe-eval-location - '(skribe-eval-location))))) - #unspecified) - (define ,(cons id dargs) - ,(make-dsssl-function-prelude proto - args `(begin ,@body) - error s2k)))))) - -;*---------------------------------------------------------------------*/ -;* define-simple-markup ... */ -;*---------------------------------------------------------------------*/ -(define-pervasive-macro (define-simple-markup markup) - `(define-markup (,markup #!rest opts #!key ident class loc) - (new markup - (markup ',markup) - (ident (or ident (symbol->string (gensym ',markup)))) - (loc loc) - (class class) - (required-options '()) - (options (the-options opts :ident :class :loc)) - (body (the-body opts))))) - -;*---------------------------------------------------------------------*/ -;* define-simple-container ... */ -;*---------------------------------------------------------------------*/ -(define-pervasive-macro (define-simple-container markup) - `(define-markup (,markup #!rest opts #!key ident class loc) - (new container - (markup ',markup) - (ident (or ident (symbol->string (gensym ',markup)))) - (loc loc) - (class class) - (required-options '()) - (options (the-options opts :ident :class :loc)) - (body (the-body opts))))) - -;*---------------------------------------------------------------------*/ -;* define-processor-markup ... */ -;*---------------------------------------------------------------------*/ -(define-pervasive-macro (define-processor-markup proc) - `(define-markup (,proc #!rest opts) - (new processor - (engine (find-engine ',proc)) - (body (the-body opts)) - (options (the-options opts))))) - -;*---------------------------------------------------------------------*/ -;* new (at runtime) */ -;*---------------------------------------------------------------------*/ -(eval '(define-macro (new id . inits) - (cons (symbol-append 'new- id) - (map (lambda (i) - (list 'list (list 'quote (car i)) (cadr i))) - inits)))) |