Commit | Line | Data |
---|---|---|
51248e6e DK |
1 | ;;; Guile Emac Lisp |
2 | ||
3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ||
5 | ;; This program is free software; you can redistribute it and/or modify | |
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 | ;; | |
10 | ;; This program is distributed in the hope that it will be useful, | |
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 | |
16 | ;; along with this program; see the file COPYING. If not, write to | |
17 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
18 | ;; Boston, MA 02111-1307, USA. | |
19 | ||
20 | ;;; Code: | |
21 | ||
22 | (define-module (language elisp compile-tree-il) | |
23 | #:use-module (language tree-il) | |
24 | #:use-module (system base pmatch) | |
25 | #:export (compile-tree-il)) | |
26 | ||
27 | ||
28 | ; Find the source properties of some parsed expression if there are any | |
29 | ; associated with it. | |
30 | ||
31 | (define (location x) | |
32 | (and (pair? x) | |
33 | (let ((props (source-properties x))) | |
34 | (and (not (null? props)) | |
35 | props)))) | |
36 | ||
37 | ||
38 | ; Compile a symbol expression. This is a variable reference or maybe some | |
39 | ; special value like nil. | |
40 | ||
41 | (define (compile-symbol loc sym) | |
42 | (case sym | |
43 | ||
44 | ((nil) | |
45 | (make-const loc #f)) | |
46 | ||
47 | ((t) | |
48 | (make-const loc #t)) | |
49 | ||
50 | ; FIXME: Use fluids. | |
51 | (else | |
52 | (make-module-ref loc '(language elisp variables) sym #f)))) | |
53 | ||
54 | ||
55 | ; Compile a pair-expression (that is, any structure-like construct). | |
56 | ||
57 | (define (compile-pair loc expr) | |
58 | (pmatch expr | |
59 | ||
60 | ((progn . ,forms) | |
61 | (make-sequence loc (map compile-expr forms))) | |
62 | ||
63 | ((if ,condition ,ifclause) | |
64 | (make-conditional loc (compile-expr condition) | |
65 | (compile-expr ifclause) | |
66 | (make-const loc #f))) | |
67 | ((if ,condition ,ifclause ,elseclause) | |
68 | (make-conditional loc (compile-expr condition) | |
69 | (compile-expr ifclause) | |
70 | (compile-expr elseclause))) | |
71 | ((if ,condition ,ifclause . ,elses) | |
72 | (make-conditional loc (compile-expr condition) | |
73 | (compile-expr ifclause) | |
74 | (make-sequence loc (map compile-expr elses)))) | |
75 | ||
76 | ; FIXME: Handle returning of condition value for empty clauses! | |
77 | ((cond . ,clauses) (guard (and-map (lambda (el) | |
78 | (and (list? el) (not (null? el)))) | |
79 | clauses)) | |
80 | (let iterate ((tail clauses)) | |
81 | (if (null? tail) | |
82 | (make-const loc #f) | |
83 | (let ((cur (car tail))) | |
84 | (make-conditional loc | |
85 | (compile-expr (car cur)) | |
86 | (make-sequence loc (map compile-expr (cdr cur))) | |
87 | (iterate (cdr tail))))))) | |
88 | ||
89 | ((and) (make-const loc #t)) | |
90 | ((and . ,expressions) | |
91 | (let iterate ((tail expressions)) | |
92 | (if (null? (cdr tail)) | |
93 | (compile-expr (car tail)) | |
94 | (make-conditional loc | |
95 | (compile-expr (car tail)) | |
96 | (iterate (cdr tail)) | |
97 | (make-const loc #f))))) | |
98 | ||
99 | (('quote ,val) | |
100 | (make-const loc val)) | |
101 | ||
102 | (else | |
103 | (error "unrecognized elisp" expr)))) | |
104 | ||
105 | ||
106 | ; Compile a single expression to TreeIL. | |
107 | ||
108 | (define (compile-expr expr) | |
109 | (let ((loc (location expr))) | |
110 | (cond | |
111 | ((symbol? expr) | |
112 | (compile-symbol loc expr)) | |
113 | ((pair? expr) | |
114 | (compile-pair loc expr)) | |
115 | (else (make-const loc expr))))) | |
116 | ||
117 | ||
118 | ; Entry point for compilation to TreeIL. | |
119 | ||
120 | (define (compile-tree-il expr env opts) | |
121 | (values | |
122 | (compile-expr expr) | |
123 | env | |
124 | env)) |