mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

*** empty log message ***

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-05 02:04:26 +00:00
parent ea9b4b29f3
commit ea9c5daba0
14 changed files with 624 additions and 176 deletions
Download patch file Download diff file Expand all files Collapse all files

41
module/language/r5rs/spec.scm
View file

@ -1,30 +1,59 @@
;;; Guile R5RS specification
;;; Guile R5RS
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; This file is part of Guile VM.
;; Guile VM is free software; you can redistribute it and/or modify
;; 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.
;;
;; Guile VM is distributed in the hope that it will be useful,
;; 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 Guile VM; see the file COPYING. If not, write to
;; 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 r5rs spec)
:use-module (system base language)
:use-module (language r5rs expand)
:use-module (language r5rs translate)
:export (r5rs))
;;;
;;; Translator
;;;
(define (translate x) (if (pair? x) (translate-pair x) x))
(define (translate-pair x)
(let ((name (car x)) (args (cdr x)))
(case name
((quote) (cons '@quote args))
((define set! if and or begin)
(cons (symbol-append '@ name) (map translate args)))
((let let* letrec)
(cons* (symbol-append '@ name)
(map (lambda (b)
(cons (car b) (map translate (cdr b))))
(car args))
(map translate (cdr args))))
((lambda)
(cons* '@lambda (car args) (map translate (cdr args))))
(else
(cons (translate name) (map translate args))))))
;;;
;;; Language definition
;;;
(define-language r5rs
:title "Standard Scheme (R5RS + syntax-case)"
:version "0.3"