Commit | Line | Data |
---|---|---|
17e90c5e KN |
1 | ;;; Guile Low Intermediate Language |
2 | ||
66d3e9a3 | 3 | ;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. |
17e90c5e | 4 | |
53befeb7 NJ |
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 | |
17e90c5e KN |
18 | |
19 | ;;; Code: | |
20 | ||
9ff56d9e | 21 | (define-module (language glil) |
b0b180d5 AW |
22 | #:use-module (system base syntax) |
23 | #:use-module (system base pmatch) | |
53e28ed9 | 24 | #:use-module ((srfi srfi-1) #:select (fold)) |
1a1a10d3 | 25 | #:export |
c850030f | 26 | (<glil-program> make-glil-program glil-program? |
476e3572 AW |
27 | glil-program-nargs glil-program-nrest glil-program-nlocs |
28 | glil-program-meta glil-program-body | |
29 | ||
01967b69 | 30 | <glil-bind> make-glil-bind glil-bind? |
bdaffda2 | 31 | glil-bind-vars |
01967b69 | 32 | |
d51406fe AW |
33 | <glil-mv-bind> make-glil-mv-bind glil-mv-bind? |
34 | glil-mv-bind-vars glil-mv-bind-rest | |
35 | ||
01967b69 AW |
36 | <glil-unbind> make-glil-unbind glil-unbind? |
37 | ||
38 | <glil-source> make-glil-source glil-source? | |
028e3d06 | 39 | glil-source-props |
17e90c5e | 40 | |
01967b69 AW |
41 | <glil-void> make-glil-void glil-void? |
42 | ||
43 | <glil-const> make-glil-const glil-const? | |
bdaffda2 | 44 | glil-const-obj |
17e90c5e | 45 | |
66d3e9a3 AW |
46 | <glil-lexical> make-glil-lexical glil-lexical? |
47 | glil-lexical-local? glil-lexical-boxed? glil-lexical-op glil-lexical-index | |
48 | ||
a1122f8c AW |
49 | <glil-toplevel> make-glil-toplevel glil-toplevel? |
50 | glil-toplevel-op glil-toplevel-name | |
9cc649b8 | 51 | |
fd358575 AW |
52 | <glil-module> make-glil-module glil-module? |
53 | glil-module-op glil-module-mod glil-module-name glil-module-public? | |
54 | ||
01967b69 | 55 | <glil-label> make-glil-label glil-label? |
bdaffda2 | 56 | glil-label-label |
01967b69 AW |
57 | |
58 | <glil-branch> make-glil-branch glil-branch? | |
efbd5892 | 59 | glil-branch-inst glil-branch-label |
01967b69 AW |
60 | |
61 | <glil-call> make-glil-call glil-call? | |
efbd5892 AW |
62 | glil-call-inst glil-call-nargs |
63 | ||
64 | <glil-mv-call> make-glil-mv-call glil-mv-call? | |
b0b180d5 | 65 | glil-mv-call-nargs glil-mv-call-ra |
17e90c5e | 66 | |
b0b180d5 | 67 | parse-glil unparse-glil)) |
ac99cb0c | 68 | |
b0b180d5 AW |
69 | (define (print-glil x port) |
70 | (format port "#<glil ~s>" (unparse-glil x))) | |
71 | ||
72 | (define-type (<glil> #:printer print-glil) | |
1086fabd | 73 | ;; Meta operations |
476e3572 | 74 | (<glil-program> nargs nrest nlocs meta body) |
1086fabd AW |
75 | (<glil-bind> vars) |
76 | (<glil-mv-bind> vars rest) | |
77 | (<glil-unbind>) | |
028e3d06 | 78 | (<glil-source> props) |
1086fabd AW |
79 | ;; Objects |
80 | (<glil-void>) | |
81 | (<glil-const> obj) | |
82 | ;; Variables | |
66d3e9a3 | 83 | (<glil-lexical> local? boxed? op index) |
1086fabd AW |
84 | (<glil-toplevel> op name) |
85 | (<glil-module> op mod name public?) | |
86 | ;; Controls | |
87 | (<glil-label> label) | |
88 | (<glil-branch> inst label) | |
89 | (<glil-call> inst nargs) | |
90 | (<glil-mv-call> nargs ra)) | |
17e90c5e KN |
91 | |
92 | \f | |
476e3572 | 93 | |
b0b180d5 AW |
94 | (define (parse-glil x) |
95 | (pmatch x | |
476e3572 AW |
96 | ((program ,nargs ,nrest ,nlocs ,meta . ,body) |
97 | (make-glil-program nargs nrest nlocs meta (map parse-glil body))) | |
b0b180d5 | 98 | ((bind . ,vars) (make-glil-bind vars)) |
594d9d4c | 99 | ((mv-bind ,vars ,rest) (make-glil-mv-bind vars rest)) |
b0b180d5 | 100 | ((unbind) (make-glil-unbind)) |
028e3d06 | 101 | ((source ,props) (make-glil-source props)) |
b0b180d5 AW |
102 | ((void) (make-glil-void)) |
103 | ((const ,obj) (make-glil-const obj)) | |
66d3e9a3 | 104 | ((lexical ,local? ,boxed? ,op ,index) (make-glil-lexical local? boxed? op index)) |
b0b180d5 AW |
105 | ((toplevel ,op ,name) (make-glil-toplevel op name)) |
106 | ((module public ,op ,mod ,name) (make-glil-module op mod name #t)) | |
107 | ((module private ,op ,mod ,name) (make-glil-module op mod name #f)) | |
01c161ca | 108 | ((label ,label) (make-label label)) |
b0b180d5 AW |
109 | ((branch ,inst ,label) (make-glil-branch inst label)) |
110 | ((call ,inst ,nargs) (make-glil-call inst nargs)) | |
111 | ((mv-call ,nargs ,ra) (make-glil-mv-call nargs ra)) | |
112 | (else (error "invalid glil" x)))) | |
113 | ||
114 | (define (unparse-glil glil) | |
67169b29 | 115 | (record-case glil |
17e90c5e | 116 | ;; meta |
476e3572 AW |
117 | ((<glil-program> nargs nrest nlocs meta body) |
118 | `(program ,nargs ,nrest ,nlocs ,meta ,@(map unparse-glil body))) | |
b0b180d5 | 119 | ((<glil-bind> vars) `(bind ,@vars)) |
594d9d4c | 120 | ((<glil-mv-bind> vars rest) `(mv-bind ,vars ,rest)) |
b0b180d5 | 121 | ((<glil-unbind>) `(unbind)) |
028e3d06 | 122 | ((<glil-source> props) `(source ,props)) |
17e90c5e | 123 | ;; constants |
67169b29 AW |
124 | ((<glil-void>) `(void)) |
125 | ((<glil-const> obj) `(const ,obj)) | |
17e90c5e | 126 | ;; variables |
66d3e9a3 AW |
127 | ((<glil-lexical> local? boxed? op index) |
128 | `(lexical ,local? ,boxed? ,op ,index)) | |
a1122f8c | 129 | ((<glil-toplevel> op name) |
b0b180d5 | 130 | `(toplevel ,op ,name)) |
fd358575 | 131 | ((<glil-module> op mod name public?) |
b0b180d5 | 132 | `(module ,(if public? 'public 'private) ,op ,mod ,name)) |
17e90c5e | 133 | ;; controls |
53e28ed9 | 134 | ((<glil-label> label) `(label ,label)) |
b0b180d5 AW |
135 | ((<glil-branch> inst label) `(branch ,inst ,label)) |
136 | ((<glil-call> inst nargs) `(call ,inst ,nargs)) | |
594d9d4c | 137 | ((<glil-mv-call> nargs ra) `(mv-call ,nargs ,ra)))) |