Import Upstream version 2a6upstream/2a6

1 files changed, 93 insertions, 0 deletions

diff --git a/scaoutp.scm b/scaoutp.scm
new file mode 100644
index 0000000..b9730ca
--- /dev/null
+++ b/scaoutp.scm
@@ -0,0 +1,93 @@
+;;; "scaoutp.scm" syntax-case output
+;;; 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.
+
+;;; Written by Robert Hieb & Kent Dybvig
+
+;;; This file was munged by a simple minded sed script since it left
+;;; its original authors' hands.  See syncase.sh for the horrid details.
+
+;;; output.ss
+;;; Robert Hieb & Kent Dybvig
+;;; 92/06/18
+
+; The output routines can be tailored to feed a specific system or compiler.
+; They are set up here to generate the following subset of standard Scheme:
+
+;  <expression> :== <application>
+;                |  <variable>
+;                |  (set! <variable> <expression>)
+;                |  (define <variable> <expression>)
+;                |  (lambda (<variable>*) <expression>)
+;                |  (lambda <variable> <expression>)
+;                |  (lambda (<variable>+ . <variable>) <expression>)
+;                |  (letrec (<binding>+) <expression>)
+;                |  (if <expression> <expression> <expression>)
+;                |  (begin <expression> <expression>)
+;                |  (quote <datum>)
+; <application> :== (<expression>+)
+;     <binding> :== (<variable> <expression>)
+;    <variable> :== <symbol>
+
+; Definitions are generated only at top level.
+
+(define syncase:build-application
+   (lambda (fun-exp arg-exps)
+      `(,fun-exp ,@arg-exps)))
+
+(define syncase:build-conditional
+   (lambda (test-exp then-exp else-exp)
+      `(if ,test-exp ,then-exp ,else-exp)))
+
+(define syncase:build-lexical-reference (lambda (var) var))
+
+(define syncase:build-lexical-assignment
+   (lambda (var exp)
+      `(set! ,var ,exp)))
+
+(define syncase:build-global-reference (lambda (var) var))
+
+(define syncase:build-global-assignment
+   (lambda (var exp)
+      `(set! ,var ,exp)))
+
+(define syncase:build-lambda
+   (lambda (vars exp)
+      `(lambda ,vars ,exp)))
+
+(define syncase:build-improper-lambda
+   (lambda (vars var exp)
+      `(lambda (,@vars . ,var) ,exp)))
+
+(define syncase:build-data
+   (lambda (exp)
+      `(quote ,exp)))
+
+(define syncase:build-identifier
+   (lambda (id)
+      `(quote ,id)))
+
+(define syncase:build-sequence
+   (lambda (exps)
+      (if (null? (cdr exps))
+          (car exps)
+          `(begin ,(car exps) ,(syncase:build-sequence (cdr exps))))))
+
+(define syncase:build-letrec
+   (lambda (vars val-exps body-exp)
+      (if (null? vars)
+          body-exp
+          `(letrec ,(map list vars val-exps) ,body-exp))))
+
+(define syncase:build-global-definition
+   (lambda (var val)
+      `(define ,var ,val)))