Commit | Line | Data |
---|---|---|
17e90c5e KN |
1 | ;;; Guile Low Intermediate Language |
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 | ||
9ff56d9e | 22 | (define-module (language glil) |
b0b180d5 AW |
23 | #:use-module (system base syntax) |
24 | #:use-module (system base pmatch) | |
1a1a10d3 | 25 | #:export |
c2c82b62 AW |
26 | (<glil-asm> make-glil-asm glil-asm? |
27 | glil-asm-nargs glil-asm-nrest glil-asm-nlocs glil-asm-nexts | |
28 | glil-asm-meta glil-asm-body | |
01967b69 AW |
29 | |
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? | |
bdaffda2 | 39 | glil-source-loc |
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 | |
01967b69 | 46 | <glil-argument> make-glil-argument glil-argument? |
bdaffda2 | 47 | glil-argument-op glil-argument-index |
01967b69 AW |
48 | |
49 | <glil-local> make-glil-local glil-local? | |
bdaffda2 | 50 | glil-local-op glil-local-index |
01967b69 AW |
51 | |
52 | <glil-external> make-glil-external glil-external? | |
bdaffda2 | 53 | glil-external-op glil-external-depth glil-external-index |
01967b69 | 54 | |
a1122f8c AW |
55 | <glil-toplevel> make-glil-toplevel glil-toplevel? |
56 | glil-toplevel-op glil-toplevel-name | |
9cc649b8 | 57 | |
fd358575 AW |
58 | <glil-module> make-glil-module glil-module? |
59 | glil-module-op glil-module-mod glil-module-name glil-module-public? | |
60 | ||
01967b69 | 61 | <glil-label> make-glil-label glil-label? |
bdaffda2 | 62 | glil-label-label |
01967b69 AW |
63 | |
64 | <glil-branch> make-glil-branch glil-branch? | |
efbd5892 | 65 | glil-branch-inst glil-branch-label |
01967b69 AW |
66 | |
67 | <glil-call> make-glil-call glil-call? | |
efbd5892 AW |
68 | glil-call-inst glil-call-nargs |
69 | ||
70 | <glil-mv-call> make-glil-mv-call glil-mv-call? | |
b0b180d5 | 71 | glil-mv-call-nargs glil-mv-call-ra |
17e90c5e | 72 | |
b0b180d5 | 73 | parse-glil unparse-glil)) |
ac99cb0c | 74 | |
b0b180d5 AW |
75 | (define (print-glil x port) |
76 | (format port "#<glil ~s>" (unparse-glil x))) | |
77 | ||
78 | (define-type (<glil> #:printer print-glil) | |
1086fabd | 79 | ;; Meta operations |
c2c82b62 | 80 | (<glil-asm> nargs nrest nlocs nexts meta body) |
1086fabd AW |
81 | (<glil-bind> vars) |
82 | (<glil-mv-bind> vars rest) | |
83 | (<glil-unbind>) | |
84 | (<glil-source> loc) | |
85 | ;; Objects | |
86 | (<glil-void>) | |
87 | (<glil-const> obj) | |
88 | ;; Variables | |
89 | (<glil-argument> op index) | |
90 | (<glil-local> op index) | |
91 | (<glil-external> op depth index) | |
92 | (<glil-toplevel> op name) | |
93 | (<glil-module> op mod name public?) | |
94 | ;; Controls | |
95 | (<glil-label> label) | |
96 | (<glil-branch> inst label) | |
97 | (<glil-call> inst nargs) | |
98 | (<glil-mv-call> nargs ra)) | |
17e90c5e KN |
99 | |
100 | \f | |
b0b180d5 AW |
101 | (define (parse-glil x) |
102 | (pmatch x | |
c2c82b62 AW |
103 | ((asm ,nargs ,nrest ,nlocs ,nexts ,meta . ,body) |
104 | (make-glil-asm nargs nrest nlocs nexts meta (map parse-glil body))) | |
b0b180d5 AW |
105 | ((bind . ,vars) (make-glil-bind vars)) |
106 | ((mv-bind ,vars . ,rest) (make-glil-mv-bind vars (map parse-glil rest))) | |
107 | ((unbind) (make-glil-unbind)) | |
108 | ((source ,loc) (make-glil-source loc)) | |
109 | ((void) (make-glil-void)) | |
110 | ((const ,obj) (make-glil-const obj)) | |
111 | ((argument ,op ,index) (make-glil-argument op index)) | |
112 | ((local ,op ,index) (make-glil-local op index)) | |
113 | ((external ,op ,depth ,index) (make-glil-external op depth index)) | |
114 | ((toplevel ,op ,name) (make-glil-toplevel op name)) | |
115 | ((module public ,op ,mod ,name) (make-glil-module op mod name #t)) | |
116 | ((module private ,op ,mod ,name) (make-glil-module op mod name #f)) | |
117 | ((label ,label) (make-label ,label)) | |
118 | ((branch ,inst ,label) (make-glil-branch inst label)) | |
119 | ((call ,inst ,nargs) (make-glil-call inst nargs)) | |
120 | ((mv-call ,nargs ,ra) (make-glil-mv-call nargs ra)) | |
121 | (else (error "invalid glil" x)))) | |
122 | ||
123 | (define (unparse-glil glil) | |
67169b29 | 124 | (record-case glil |
17e90c5e | 125 | ;; meta |
c2c82b62 AW |
126 | ((<glil-asm> nargs nrest nlocs nexts meta body) |
127 | `(asm ,nargs ,nrest ,nlocs ,nexts ,meta ,@(map unparse-glil body))) | |
b0b180d5 AW |
128 | ((<glil-bind> vars) `(bind ,@vars)) |
129 | ((<glil-mv-bind> vars rest) `(mv-bind ,vars ,@rest)) | |
130 | ((<glil-unbind>) `(unbind)) | |
131 | ((<glil-source> loc) `(source ,loc)) | |
17e90c5e | 132 | ;; constants |
67169b29 AW |
133 | ((<glil-void>) `(void)) |
134 | ((<glil-const> obj) `(const ,obj)) | |
17e90c5e | 135 | ;; variables |
67169b29 | 136 | ((<glil-argument> op index) |
b0b180d5 | 137 | `(argument ,op ,index)) |
67169b29 | 138 | ((<glil-local> op index) |
b0b180d5 | 139 | `(local ,op ,index)) |
67169b29 | 140 | ((<glil-external> op depth index) |
b0b180d5 | 141 | `(external ,op ,depth ,index)) |
a1122f8c | 142 | ((<glil-toplevel> op name) |
b0b180d5 | 143 | `(toplevel ,op ,name)) |
fd358575 | 144 | ((<glil-module> op mod name public?) |
b0b180d5 | 145 | `(module ,(if public? 'public 'private) ,op ,mod ,name)) |
17e90c5e | 146 | ;; controls |
b0b180d5 AW |
147 | ((<glil-label> label) (label ,label)) |
148 | ((<glil-branch> inst label) `(branch ,inst ,label)) | |
149 | ((<glil-call> inst nargs) `(call ,inst ,nargs)) | |
150 | ((<glil-mv-call> nargs ra) `(mv-call ,nargs ,(unparse-glil ra))))) |