1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 07:50:20 +02:00
guile/module/language/glil.scm
Andy Wingo 9ff56d9e65 (language ghil def) becomes (language ghil)
* module/language/Makefile.am:
* module/language/ghil/Makefile.am:
* module/language/ghil.scm:
* module/language/ghil/compile-glil.scm:
* module/language/ghil/spec.scm:
* module/language/glil/Makefile.am:
* module/language/glil.scm:
* module/language/glil/compile-objcode.scm:
* module/language/glil/spec.scm:
* module/language/scheme/inline.scm:
* module/language/scheme/translate.scm:
* module/oop/goops.scm: Rename (language ghil def) and (language glil
  def) to not have the "def". They're nicer names.
2009-01-08 19:25:38 +01:00

158 lines
5.1 KiB
Scheme
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; Guile Low Intermediate Language
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Code:
(define-module (language glil)
#:use-module (system base syntax)
#:use-module (system base pmatch)
#:export
(<glil-vars> make-glil-vars
glil-vars-nargs glil-vars-nrest glil-vars-nlocs glil-vars-nexts
<glil-asm> make-glil-asm glil-asm?
glil-asm-vars glil-asm-meta glil-asm-body
<glil-bind> make-glil-bind glil-bind?
glil-bind-vars
<glil-mv-bind> make-glil-mv-bind glil-mv-bind?
glil-mv-bind-vars glil-mv-bind-rest
<glil-unbind> make-glil-unbind glil-unbind?
<glil-source> make-glil-source glil-source?
glil-source-loc
<glil-void> make-glil-void glil-void?
<glil-const> make-glil-const glil-const?
glil-const-obj
<glil-argument> make-glil-argument glil-argument?
glil-argument-op glil-argument-index
<glil-local> make-glil-local glil-local?
glil-local-op glil-local-index
<glil-external> make-glil-external glil-external?
glil-external-op glil-external-depth glil-external-index
<glil-toplevel> make-glil-toplevel glil-toplevel?
glil-toplevel-op glil-toplevel-name
<glil-module> make-glil-module glil-module?
glil-module-op glil-module-mod glil-module-name glil-module-public?
<glil-label> make-glil-label glil-label?
glil-label-label
<glil-branch> make-glil-branch glil-branch?
glil-branch-inst glil-branch-label
<glil-call> make-glil-call glil-call?
glil-call-inst glil-call-nargs
<glil-mv-call> make-glil-mv-call glil-mv-call?
glil-mv-call-nargs glil-mv-call-ra
parse-glil unparse-glil))
(define-record <glil-vars> nargs nrest nlocs nexts)
(define (print-glil x port)
(format port "#<glil ~s>" (unparse-glil x)))
(define-type (<glil> #:printer print-glil)
;; Meta operations
(<glil-asm> vars meta body)
(<glil-bind> vars)
(<glil-mv-bind> vars rest)
(<glil-unbind>)
(<glil-source> loc)
;; Objects
(<glil-void>)
(<glil-const> obj)
;; Variables
(<glil-argument> op index)
(<glil-local> op index)
(<glil-external> op depth index)
(<glil-toplevel> op name)
(<glil-module> op mod name public?)
;; Controls
(<glil-label> label)
(<glil-branch> inst label)
(<glil-call> inst nargs)
(<glil-mv-call> nargs ra))
(define (parse-glil x)
(pmatch x
((asm (,nargs ,nrest ,nlocs ,next) ,meta . ,body)
(make-glil-asm (make-glil-vars nargs nrest nlocs next)
meta (map parse-glil body)))
((bind . ,vars) (make-glil-bind vars))
((mv-bind ,vars . ,rest) (make-glil-mv-bind vars (map parse-glil rest)))
((unbind) (make-glil-unbind))
((source ,loc) (make-glil-source loc))
((void) (make-glil-void))
((const ,obj) (make-glil-const obj))
((argument ,op ,index) (make-glil-argument op index))
((local ,op ,index) (make-glil-local op index))
((external ,op ,depth ,index) (make-glil-external op depth index))
((toplevel ,op ,name) (make-glil-toplevel op name))
((module public ,op ,mod ,name) (make-glil-module op mod name #t))
((module private ,op ,mod ,name) (make-glil-module op mod name #f))
((label ,label) (make-label ,label))
((branch ,inst ,label) (make-glil-branch inst label))
((call ,inst ,nargs) (make-glil-call inst nargs))
((mv-call ,nargs ,ra) (make-glil-mv-call nargs ra))
(else (error "invalid glil" x))))
(define (unparse-glil glil)
(record-case glil
;; meta
((<glil-asm> vars meta body)
`(asm (,(glil-vars-nargs vars) ,(glil-vars-nrest vars)
,(glil-vars-nlocs vars) ,(glil-vars-nexts vars))
,meta
,@(map unparse-glil body)))
((<glil-bind> vars) `(bind ,@vars))
((<glil-mv-bind> vars rest) `(mv-bind ,vars ,@rest))
((<glil-unbind>) `(unbind))
((<glil-source> loc) `(source ,loc))
;; constants
((<glil-void>) `(void))
((<glil-const> obj) `(const ,obj))
;; variables
((<glil-argument> op index)
`(argument ,op ,index))
((<glil-local> op index)
`(local ,op ,index))
((<glil-external> op depth index)
`(external ,op ,depth ,index))
((<glil-toplevel> op name)
`(toplevel ,op ,name))
((<glil-module> op mod name public?)
`(module ,(if public? 'public 'private) ,op ,mod ,name))
;; controls
((<glil-label> label) (label ,label))
((<glil-branch> inst label) `(branch ,inst ,label))
((<glil-call> inst nargs) `(call ,inst ,nargs))
((<glil-mv-call> nargs ra) `(mv-call ,nargs ,(unparse-glil ra)))))