home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Src / macros.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-17  |  2.5 KB  |  84 lines
  1. /*
  2.  * m a c r o s . c            -- Simple statically scoped macros
  3.  *
  4.  * Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5.  * 
  6.  *
  7.  * Permission to use, copy, and/or distribute this software and its
  8.  * documentation for any purpose and without fee is hereby granted, provided
  9.  * that both the above copyright notice and this permission notice appear in
  10.  * all copies and derived works.  Fees for distribution or use of this
  11.  * software or derived works may only be charged with express written
  12.  * permission of the copyright holder.  
  13.  * This software is provided ``as is'' without express or implied warranty.
  14.  *
  15.  * This software is a derivative work of other copyrighted softwares; the
  16.  * copyright notices of these softwares are placed in the file COPYRIGHTS
  17.  *
  18.  *           Author: Erick Gallesio [eg@unice.fr]
  19.  *    Creation date: ??-Oct-1993 ??:?? 
  20.  * Last file update:  2-Jun-1995 22:42
  21.  *
  22.  */
  23.  
  24.  
  25. #include "stk.h"
  26.  
  27. PRIMITIVE STk_macro(SCM args, SCM env, int len)
  28. {
  29.   SCM z, code;
  30.   
  31.   if (len != 2) Err("macro: Bad parameter list", args);
  32.  
  33.   code = Cons(Sym_lambda, args); /* Create code before to avoid GC problems */
  34.   NEWCELL(z, tc_macro);
  35.   z->storage_as.macro.code = EVAL(code);
  36.   return z;
  37. }
  38.  
  39. /*
  40.  * macro_expand and macro_expand_1 are defined as fsubr rather than subr_1.
  41.  * This provision permits to carry the environment with the form to expand
  42.  * (this permits to corerctly expanse macros which are not are global level, 
  43.  * since we do a varlookup instead of grabbing the macro in a global var).
  44.  * But are there people which define macros at a level which are not global?
  45.  *
  46.  */
  47.  
  48. static SCM expand(SCM form, SCM env, int just_1)
  49. {
  50.   if (CONSP(form)) {
  51.     register SCM tmp, car = CAR(form);
  52.     
  53.     if (SYMBOLP(car) && MACROP(tmp = *STk_varlookup(car, env, FALSE))) {
  54.       tmp = Apply(tmp->storage_as.macro.code, form);
  55.       return just_1 ? tmp : expand(tmp, env, FALSE);
  56.     }
  57.   }
  58.   return form;
  59. }
  60.  
  61. PRIMITIVE STk_macro_expand_1(SCM form, SCM env, int len)
  62. {
  63.   if (len != 1) Err("macro-expand-1: bad number of parameters", form);
  64.   return expand(EVAL(CAR(form)), env, TRUE);
  65. }
  66.  
  67. PRIMITIVE STk_macro_expand(SCM form, SCM env, int len)
  68. {
  69.   if (len != 1) Err("macro-expand: bad number of parameters", form);
  70.   return expand(EVAL(CAR(form)), env, FALSE);
  71. }
  72.  
  73. PRIMITIVE STk_macro_body(SCM form)
  74. {
  75.   if (NMACROP(form)) Err("macro-body: bad macro", form);
  76.   return Cons(Intern("macro"), CDR(form->storage_as.macro.code));
  77. }
  78.  
  79. PRIMITIVE STk_macrop(SCM obj)
  80. {
  81.   return MACROP(obj)? Truth: Ntruth;
  82. }
  83.  
  84.