guile-gcc/examples/meta.c

/* Guile-GCC
   Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>

   This file is part of Guile-GCC.

   Guile-GCC is free software: you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation, either version 3 of the License, or
   (at your option) any later version.

   Guile-GCC is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with Guile-GCC.  If not, see <http://www.gnu.org/licenses/>.  */

#include <stdlib.h>

/* Define `describe', which generates code that describes the given
   structure.  Note use of the `tree' EDSL, which allows code generation to
   be expressed concisely.  */

#pragma guile define describe "                                         \
  (lambda (x)                                                           \
    (define var (identifier-string (decl-name x)))                      \
    (define (fmt t)                                                     \
      (cond ((integral-type? t) \"%d\")                                 \
            ((and (pointer-type? t)                                     \
                  (integral-type? (tree-type t))                        \
                  (= 1 (int-size-in-bytes (tree-type t))))              \
             \"`%s'\")                                                  \
            ((pointer-type? t) \"%p\")                                  \
            (else \"<unknown-type>\")))                                 \
    (for-each (lambda (f)                                               \
                (let* ((print (built-in-decl BUILT_IN_PRINTF))          \
                       (fname (decl-name f))                            \
                       (str   (string-append \"field `\"                \
                                             (identifier-string fname)  \
                                             \"' of `\" var \"' is \"   \
                                             (fmt (tree-type f))        \
                                             \"\\n\")))                 \
                  (add-statement                                        \
                    (tree %unknown-location                             \
                      (print str (x dot f))))))                         \
              (type-fields (tree-type x))))                             \
"

struct foo { int x; const char *y; };
struct bar { struct bar *next; int x; };

int
main ()
{
  struct foo f = { 42, "hello" };
  struct bar b = { (void *) 0xdeadbeef, 77 };

#pragma guile invoke describe f
#pragma guile invoke describe b

  return EXIT_SUCCESS;
}