Commit | Line | Data |
---|---|---|
adb8f306 LC |
1 | ;;; -*- mode: scheme; coding: utf-8; -*- |
2 | ;;; | |
f9685f43 | 3 | ;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
adb8f306 LC |
4 | ;;; |
5 | ;;; This library is free software; you can redistribute it and/or | |
6 | ;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;; License as published by the Free Software Foundation; either | |
8 | ;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;; | |
10 | ;;; This library 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 GNU | |
13 | ;;; Lesser General Public License for more details. | |
14 | ;;; | |
15 | ;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;; License along with this library; if not, write to the Free Software | |
17 | ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
19 | (use-modules (language tree-il) | |
417ee098 | 20 | (language tree-il optimize) |
014de9e2 | 21 | (language tree-il canonicalize) |
f9685f43 AW |
22 | (ice-9 pretty-print) |
23 | (system syntax)) | |
24 | ||
25 | ;; Avoid gratuitous churn in psyntax-pp.scm due to the marks and labels | |
26 | ;; changing session identifiers. | |
27 | (set! syntax-session-id (lambda () "*")) | |
adb8f306 | 28 | |
9c35c579 AW |
29 | (let ((source (list-ref (command-line) 1)) |
30 | (target (list-ref (command-line) 2))) | |
31 | (let ((in (open-input-file source)) | |
32 | (out (open-output-file (string-append target ".tmp")))) | |
33 | (write '(eval-when (compile) (set-current-module (resolve-module '(guile)))) | |
34 | out) | |
35 | (newline out) | |
36 | (let loop ((x (read in))) | |
37 | (if (eof-object? x) | |
38 | (begin | |
39 | (close-port out) | |
40 | (close-port in)) | |
41 | (begin | |
65dd9e38 | 42 | (pretty-print (tree-il->scheme |
014de9e2 AW |
43 | (canonicalize! |
44 | (optimize! | |
45 | (macroexpand x 'c '(compile load eval)) | |
46 | (current-module) | |
47 | '()))) | |
65dd9e38 | 48 | out) |
9c35c579 AW |
49 | (newline out) |
50 | (loop (read in)))))) | |
51 | (system (format #f "mv -f ~s.tmp ~s" target target))) |