summaryrefslogtreecommitdiffstats
path: root/scainit.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:25 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:25 -0800
commit8ffbc2df0fde83082610149d24e594c1cd879f4a (patch)
treea2be9aad5101c5e450ad141d15c514bc9c2a2963 /scainit.scm
downloadslib-8ffbc2df0fde83082610149d24e594c1cd879f4a.tar.gz
slib-8ffbc2df0fde83082610149d24e594c1cd879f4a.zip
Import Upstream version 2a6upstream/2a6
Diffstat (limited to 'scainit.scm')
-rw-r--r--scainit.scm103
1 files changed, 103 insertions, 0 deletions
diff --git a/scainit.scm b/scainit.scm
new file mode 100644
index 0000000..1103bc6
--- /dev/null
+++ b/scainit.scm
@@ -0,0 +1,103 @@
+;;; "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) 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)