| 123456789101112131415161718192021222324252627282930313233343536373839404142434445 |
- ;;; Guile-GCC --- Guile extension to GCC. -*- coding: utf-8 -*-
- ;;; Copyright (C) 2012 Ludovic Courtès
- ;;;
- ;;; 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/>.
- (define-module (birthday)
- #:use-module (gcc)
- #:use-module (gcc cpp))
- ;;;
- ;;; Welcome, this is the `birthday' GCC plug-in! It extends C with a
- ;;; `#pragma guile birthday' construct, which says happy birthday Guile!
- ;;;
- (define (register-funny-pragmas)
- (register-c-pragma "guile" "birthday"
- (lambda (cpp)
- (let ((fn (current-function-decl)))
- (inform (token-source-location (peek-token cpp 0))
- "Happy Birthday Guile 2.0~:[ from function ~s~;~]!"
- (null-tree? fn)
- (identifier-string (decl-name fn)))
- (let* ((puts (built-in-decl BUILT_IN_PUTS))
- (str (build-string-literal
- "Happy Birthday, Guile 2.0!"))
- (call (build-call-expr %unknown-location
- puts (list str))))
- (add-statement call))))))
- (format #t "Welcome! You've just loaded the incredible birthday plug-in!~%")
- (register-callback "guile" PLUGIN_PRAGMAS register-funny-pragmas)
|
