Commit | Line | Data |
---|---|---|
ea9b4b29 KN |
1 | ;;; Guile Scheme specification |
2 | ||
3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ||
ea9c5dab | 5 | ;; This program is free software; you can redistribute it and/or modify |
ea9b4b29 KN |
6 | ;; it under the terms of the GNU General Public License as published by |
7 | ;; the Free Software Foundation; either version 2, or (at your option) | |
8 | ;; any later version. | |
9 | ;; | |
ea9c5dab | 10 | ;; This program is distributed in the hope that it will be useful, |
ea9b4b29 KN |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;; GNU General Public License for more details. | |
14 | ;; | |
15 | ;; You should have received a copy of the GNU General Public License | |
ea9c5dab | 16 | ;; along with this program; see the file COPYING. If not, write to |
ea9b4b29 KN |
17 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
18 | ;; Boston, MA 02111-1307, USA. | |
19 | ||
ea9c5dab KN |
20 | ;;; Code: |
21 | ||
ea9b4b29 KN |
22 | (define-module (language gscheme spec) |
23 | :use-module (system base language) | |
46cd9a34 KN |
24 | :use-module (system il ghil) |
25 | :use-module (language r5rs expand) | |
ea9b4b29 | 26 | :use-module (ice-9 match) |
a80be762 | 27 | :use-module (ice-9 and-let-star) |
ea9b4b29 KN |
28 | :export (gscheme)) |
29 | ||
30 | \f | |
31 | ;;; | |
32 | ;;; Macro expander | |
33 | ;;; | |
34 | ||
46cd9a34 KN |
35 | (define expand-syntax expand) |
36 | ||
37 | (define (expand-macro x m) | |
ea9b4b29 KN |
38 | (if (pair? x) |
39 | (let* ((s (car x)) | |
ea9b4b29 KN |
40 | (v (and (symbol? s) (module-defined? m s) (module-ref m s)))) |
41 | (if (defmacro? v) | |
46cd9a34 KN |
42 | (expand-macro (apply (defmacro-transformer v) (cdr x)) m) |
43 | (cons (expand-macro (car x) m) (expand-macro (cdr x) m)))) | |
ea9b4b29 KN |
44 | x)) |
45 | ||
46cd9a34 KN |
46 | (define (expand x) |
47 | (expand-syntax (expand-macro x (current-module)))) | |
48 | ||
ea9b4b29 KN |
49 | \f |
50 | ;;; | |
51 | ;;; Translator | |
52 | ;;; | |
53 | ||
ea9b4b29 KN |
54 | (define (translate x) (if (pair? x) (translate-pair x) x)) |
55 | ||
56 | (define (translate-pair x) | |
a80be762 KN |
57 | (let ((head (car x)) (rest (cdr x))) |
58 | (case head | |
59 | ((quote) (cons '@quote rest)) | |
46cd9a34 | 60 | ((define set! if and or begin) |
a80be762 | 61 | (cons (symbol-append '@ head) (map translate rest))) |
ea9b4b29 KN |
62 | ((let let* letrec) |
63 | (match x | |
64 | (('let (? symbol? f) ((s v) ...) body ...) | |
65 | `(@letrec ((,f (@lambda ,s ,@(map translate body)))) | |
66 | (,f ,@(map translate v)))) | |
67 | (else | |
a80be762 | 68 | (cons* (symbol-append '@ head) |
ea9b4b29 | 69 | (map (lambda (b) (cons (car b) (map translate (cdr b)))) |
a80be762 KN |
70 | (car rest)) |
71 | (map translate (cdr rest)))))) | |
ea9b4b29 | 72 | ((lambda) |
a80be762 | 73 | (cons* '@lambda (car rest) (map translate (cdr rest)))) |
ea9b4b29 | 74 | (else |
a80be762 KN |
75 | (let ((prim (and (symbol? head) (symbol-append '@ head)))) |
76 | (if (and prim (ghil-primitive? prim)) | |
77 | (cons prim (map translate rest)) | |
78 | (cons (translate head) (map translate rest)))))))) | |
ea9b4b29 KN |
79 | |
80 | \f | |
81 | ;;; | |
82 | ;;; Language definition | |
83 | ;;; | |
84 | ||
85 | (define-language gscheme | |
86 | :title "Guile Scheme" | |
87 | :version "0.3" | |
88 | :reader read | |
89 | :expander expand | |
90 | :translator translate | |
91 | :printer write | |
92 | ) |