mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-11 00:00:49 +02:00
104 lines
3.3 KiB
Scheme
104 lines
3.3 KiB
Scheme
;;; "scainit.scm" Syntax-case macros port to SLIB -*- Scheme -*-
|
|
;;; Copyright (C) 1992 R. Kent Dybvig
|
|
;;;
|
|
;;; Permission to copy this software, in whole or in part, to use this
|
|
;;; software for any lawful purpose, and to redistribute this software
|
|
;;; is granted subject to the restriction that all copies made of this
|
|
;;; software must include this copyright notice in full. This software
|
|
;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
|
|
;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
|
|
;;; OR FITNESS FOR ANY PARTICULAR PURPOSE. IN NO EVENT SHALL THE
|
|
;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
|
|
;;; NATURE WHATSOEVER.
|
|
|
|
;;; From: Harald Hanche-Olsen <hanche@imf.unit.no>
|
|
|
|
;;; compat.ss
|
|
;;; Robert Hieb & Kent Dybvig
|
|
;;; 92/06/18
|
|
|
|
(require 'common-list-functions) ;to pick up EVERY
|
|
(define syncase:andmap comlist:every)
|
|
|
|
; In Chez Scheme "(syncase:void)" returns an object that is ignored by the
|
|
; REP loop. It is returned whenever a "nonspecified" value is specified
|
|
; by the standard. The following should pick up an appropriate value.
|
|
|
|
(define syncase:void
|
|
(let ((syncase:void-object (if #f #f)))
|
|
(lambda () syncase:void-object)))
|
|
|
|
(define syncase:eval-hook slib:eval)
|
|
|
|
(define syncase:error-hook slib:error)
|
|
|
|
(define syncase:new-symbol-hook
|
|
(let ((c 0))
|
|
(lambda (string)
|
|
(set! c (+ c 1))
|
|
(string->symbol
|
|
(string-append string ":Sca" (number->string c))))))
|
|
|
|
(define syncase:put-global-definition-hook #f)
|
|
(define syncase:get-global-definition-hook #f)
|
|
(let ((*macros* '()))
|
|
(set! syncase:put-global-definition-hook
|
|
(lambda (symbol binding)
|
|
(let ((pair (assq symbol *macros*)))
|
|
(if pair
|
|
(set-cdr! pair binding)
|
|
(set! *macros* (cons (cons symbol binding) *macros*))))))
|
|
(set! syncase:get-global-definition-hook
|
|
(lambda (symbol)
|
|
(let ((pair (assq symbol *macros*)))
|
|
(and pair (cdr pair))))))
|
|
|
|
|
|
;;;! expand.pp requires list*
|
|
(define (syncase:list* . args)
|
|
(if (null? args)
|
|
'()
|
|
(let ((r (reverse args)))
|
|
(append (reverse (cdr r))
|
|
(car r) ; Last arg
|
|
'())))) ; Make sure the last arg is copied
|
|
|
|
(define syntax-error syncase:error-hook)
|
|
(define impl-error slib:error)
|
|
|
|
(define base:eval slib:eval)
|
|
(define syncase:eval base:eval)
|
|
(define macro:eval base:eval)
|
|
(define syncase:expand #f)
|
|
(define macro:expand #f)
|
|
(define (syncase:expand-install-hook expand)
|
|
(set! syncase:eval (lambda (x) (base:eval (expand x))))
|
|
(set! macro:eval syncase:eval)
|
|
(set! syncase:expand expand)
|
|
(set! macro:expand syncase:expand))
|
|
;;; We Need This for bootstrapping purposes:
|
|
(define (syncase:load <pathname>)
|
|
(slib:eval-load <pathname> syncase:eval))
|
|
(define macro:load syncase:load)
|
|
|
|
(define syncase:sanity-check #f)
|
|
;;; LOADING THE SYSTEM ITSELF:
|
|
(let ((here (lambda (file)
|
|
(in-vicinity (library-vicinity) file)))
|
|
(scmhere (lambda (file)
|
|
(in-vicinity (library-vicinity)
|
|
(string-append file (scheme-file-suffix))))))
|
|
(for-each (lambda (file) (slib:load (here file)))
|
|
'("scaoutp"
|
|
"scaglob"
|
|
"scaexpp"))
|
|
(syncase:expand-install-hook expand-syntax)
|
|
(syncase:load (here "scamacr"))
|
|
(set! syncase:sanity-check
|
|
(lambda ()
|
|
(syncase:load (scmhere "sca-exp"))
|
|
(syncase:expand-install-hook expand-syntax)
|
|
(syncase:load (scmhere "sca-macr")))))
|
|
|
|
(provide 'syntax-case)
|
|
(provide 'macro)
|