mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 04:40:29 +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

10
module/language/r5rs/core.il
View file

@ -2,23 +2,23 @@
;; 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:
;; Non standard procedures
(@define void (@lambda () (@void)))

38
module/language/r5rs/expand.scm
View file

@ -1,21 +1,23 @@
;;;; Copyright (C) 1997, 2000 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 software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;
;;; R5RS syntax expander
;; 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 r5rs expand)
:export (expand void

8
module/language/r5rs/null.il
View file

@ -2,17 +2,19 @@
;; Copyright (C) 2001 Free Software Foundation, Inc.
;; 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:

38
module/language/r5rs/psyntax.boot
View file

@ -1,21 +1,23 @@
;;;; Copyright (C) 1997, 2000 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 software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;
;;; psyntax.ss -> psyntax.scm
;; 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 sc-expand #f)
(define $sc-put-cte #f)

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"

60
module/language/r5rs/translate.scm
View file

@ -1,60 +0,0 @@
;;; translate.scm --- Scheme to Guile IL translator
;; 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
;; 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,
;; 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
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(define-module (language r5rs translate)
:export (translate))
(define (translate x) (trans x))
(define (trans x) (if (pair? x) (trans-pair x) x))
(define (trans-pair x)
(let ((name (car x)) (args (cdr x)))
(let ((il (case name
((quote) (cons '@quote args))
((define set! if and or begin)
(cons (symbol-append '@ name) (map trans args)))
((let let* letrec)
(cons* (symbol-append '@ name)
(map (lambda (b)
(cons (car b) (map trans (cdr b))))
(car args))
(map trans (cdr args))))
((lambda)
(cons* '@lambda (trans-formals (car args))
(map trans (cdr args))))
(else
(cons (trans name) (map trans args)))))
(props (source-properties x)))
(if (not (null? props))
(set-source-properties! il props))
il)))
(define (trans-formals formals)
(cond ((symbol? formals) `(:rest ,formals))
((or (null? formals) (null? (cdr (last-pair formals)))) formals)
(else
(let* ((list (list-copy formals))
(last (last-pair list)))
(set-cdr! last `(:rest ,(cdr last)))
list))))
;;; translate.scm ends here