diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-04-19 14:46:01 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-04-19 14:46:01 +0000 |
commit | 726d810a75c140442032ddb1daa6422a104e272f (patch) | |
tree | 063679caa69ab538ad6624bdada60759f999700f /libguile/macros.c | |
parent | e038c04203e77522ba59c8181df4601ed15621a1 (diff) | |
download | guile-726d810a75c140442032ddb1daa6422a104e272f.tar.gz |
* Fixed scm_thunk_p's results when applied to closures.
* Extracted macro printing code from print.c to macros.c.
* Minor cleanups.
Diffstat (limited to 'libguile/macros.c')
-rw-r--r-- | libguile/macros.c | 50 |
1 files changed, 48 insertions, 2 deletions
diff --git a/libguile/macros.c b/libguile/macros.c index 44eac33d8..734cd6d5d 100644 --- a/libguile/macros.c +++ b/libguile/macros.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. * * 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 @@ -45,6 +45,10 @@ #include "libguile/_scm.h" +#include "libguile/alist.h" /* for SCM_EXTEND_ENV (well...) */ +#include "libguile/eval.h" +#include "libguile/ports.h" +#include "libguile/print.h" #include "libguile/root.h" #include "libguile/smob.h" @@ -53,6 +57,47 @@ scm_bits_t scm_tc16_macro; + +static int +macro_print (SCM macro, SCM port, scm_print_state *pstate) +{ + SCM code = SCM_MACRO_CODE (macro); + if (!SCM_CLOSUREP (code) + || SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE)) + || SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE, + macro, port, pstate))) + { + if (!SCM_CLOSUREP (code)) + scm_puts ("#<primitive-", port); + else + scm_puts ("#<", port); + + if (SCM_MACRO_TYPE (macro) == 0) + scm_puts ("syntax", port); + else if (SCM_MACRO_TYPE (macro) == 1) + scm_puts ("macro", port); + if (SCM_MACRO_TYPE (macro) == 2) + scm_puts ("macro!", port); + scm_putc (' ', port); + scm_iprin1 (scm_macro_name (macro), port, pstate); + + if (SCM_CLOSUREP (code) && SCM_PRINT_SOURCE_P) + { + SCM formals = SCM_CLOSURE_FORMALS (code); + SCM env = SCM_ENV (code); + SCM xenv = SCM_EXTEND_ENV (formals, SCM_EOL, env); + SCM src = scm_unmemocopy (SCM_CODE (code), xenv); + scm_putc (' ', port); + scm_iprin1 (src, port, pstate); + } + + scm_putc ('>', port); + } + + return 1; +} + + SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0, (SCM code), "Return a @dfn{macro} which, when a symbol defined to this value\n" @@ -139,7 +184,7 @@ SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, { if (!SCM_TYP16_PREDICATE (scm_tc16_macro, m)) return SCM_BOOL_F; - switch (SCM_CELL_WORD_0 (m) >> 16) + switch (SCM_MACRO_TYPE (m)) { case 0: return scm_sym_syntax; case 1: return scm_sym_macro; @@ -186,6 +231,7 @@ scm_init_macros () { scm_tc16_macro = scm_make_smob_type ("macro", 0); scm_set_smob_mark (scm_tc16_macro, scm_markcdr); + scm_set_smob_print (scm_tc16_macro, macro_print); #ifndef SCM_MAGIC_SNARFER #include "libguile/macros.x" #endif |