summaryrefslogtreecommitdiff
path: root/libguile/eval.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/eval.c')
-rw-r--r--libguile/eval.c84
1 files changed, 60 insertions, 24 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index 2bb5487df..43dfa8644 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -2925,30 +2925,69 @@ scm_makmmacro (code)
}
+SCM_PROC (s_macro_p, "macro?", 1, 0, 0, scm_macro_p);
-static int prinmacro SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
+SCM
+scm_macro_p (obj)
+ SCM obj;
+{
+ return (SCM_NIMP (obj) && SCM_TYP16 (obj) == scm_tc16_macro
+ ? SCM_BOOL_T
+ : SCM_BOOL_F);
+}
-static int
-prinmacro (exp, port, pstate)
- SCM exp;
- SCM port;
- scm_print_state *pstate;
+
+SCM_SYMBOL (scm_sym_syntax, "syntax");
+SCM_SYMBOL (scm_sym_macro, "macro");
+SCM_SYMBOL (scm_sym_mmacro, "macro!");
+
+SCM_PROC (s_macro_type, "macro-type", 1, 0, 0, scm_macro_type);
+
+SCM
+scm_macro_type (m)
+ SCM m;
{
- int writingp = SCM_WRITINGP (pstate);
- if (SCM_CAR (exp) & (3L << 16))
- scm_gen_puts (scm_regular_string, "#<macro", port);
- else
- scm_gen_puts (scm_regular_string, "#<syntax", port);
- if (SCM_CAR (exp) & (2L << 16))
- scm_gen_putc ('!', port);
- scm_gen_putc (' ', port);
- SCM_SET_WRITINGP (pstate, 1);
- scm_iprin1 (SCM_CDR (exp), port, pstate);
- SCM_SET_WRITINGP (pstate, writingp);
- scm_gen_putc ('>', port);
- return !0;
+ if (!(SCM_NIMP (m) && SCM_TYP16 (m) == scm_tc16_macro))
+ return SCM_BOOL_F;
+ switch ((int) (SCM_CAR (m) >> 16))
+ {
+ case 0: return scm_sym_syntax;
+ case 1: return scm_sym_macro;
+ case 2: return scm_sym_mmacro;
+ default: scm_wrong_type_arg (s_macro_type, 1, m);
+ }
+}
+
+
+SCM_PROC (s_macro_name, "macro-name", 1, 0, 0, scm_macro_name);
+
+SCM
+scm_macro_name (m)
+ SCM m;
+{
+ SCM_ASSERT (SCM_NIMP (m) && SCM_TYP16 (m) == scm_tc16_macro,
+ m,
+ SCM_ARG1,
+ s_macro_name);
+ return scm_procedure_name (SCM_CDR (m));
}
+
+SCM_PROC (s_macro_transformer, "macro-transformer", 1, 0, 0, scm_macro_transformer);
+
+SCM
+scm_macro_transformer (m)
+ SCM m;
+{
+ SCM_ASSERT (SCM_NIMP (m) && SCM_TYP16 (m) == scm_tc16_macro,
+ m,
+ SCM_ARG1,
+ s_macro_transformer);
+ return SCM_NFALSEP (scm_closure_p (SCM_CDR (m))) ? SCM_CDR (m) : SCM_BOOL_F;
+}
+
+
+
SCM_PROC(s_force, "force", 1, 0, 0, scm_force);
SCM
@@ -3100,12 +3139,9 @@ scm_definedp (sym)
SCM_BOOL_F : SCM_BOOL_T;
}
-static scm_smobfuns promsmob =
-{scm_markcdr, scm_free0, prinprom};
-
-static scm_smobfuns macrosmob =
-{scm_markcdr, scm_free0, prinmacro};
+static scm_smobfuns promsmob = {scm_markcdr, scm_free0, prinprom};
+static scm_smobfuns macrosmob = {scm_markcdr, scm_free0};
SCM
scm_make_synt (name, macroizer, fcn)