summaryrefslogtreecommitdiffstats
path: root/scaoutp.scm
diff options
context:
space:
mode:
Diffstat (limited to 'scaoutp.scm')
-rw-r--r--scaoutp.scm93
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)))