summaryrefslogtreecommitdiffstats
path: root/mwexpand.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:28 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:28 -0800
commitbd9733926076885e3417b74de76e4c9c7bc56254 (patch)
tree2c99dced547d48407ad44cb0e45e31bb4d02ce43 /mwexpand.scm
parentfa3f23105ddcf07c5900de47f19af43d1db1b597 (diff)
downloadslib-bd9733926076885e3417b74de76e4c9c7bc56254.tar.gz
slib-bd9733926076885e3417b74de76e4c9c7bc56254.zip
Import Upstream version 2c7upstream/2c7
Diffstat (limited to 'mwexpand.scm')
-rw-r--r--mwexpand.scm46
1 files changed, 23 insertions, 23 deletions
diff --git a/mwexpand.scm b/mwexpand.scm
index a53f0da..9dea34b 100644
--- a/mwexpand.scm
+++ b/mwexpand.scm
@@ -38,8 +38,8 @@
(mw:desugar-definitions def-or-exp mw:global-syntax-environment))))
(define (mw:desugar-definitions exp env)
- (letrec
- ((define-loop
+ (letrec
+ ((define-loop
(lambda (exp rest first)
(cond ((and (pair? exp)
(eq? (mw:syntax-lookup env (car exp))
@@ -70,10 +70,10 @@
(append (reverse first)
(map (lambda (exp) (mw:expand exp env))
(cons exp rest))))))))
-
+
(desugar-define
(lambda (exp env)
- (cond
+ (cond
((null? (cdr exp)) (mw:error "Malformed definition" exp))
; (define foo) syntax is transformed into (define foo (undefined)).
((null? (cddr exp))
@@ -93,8 +93,8 @@
(redefinition id)
(mw:syntax-bind-globally! id (mw:make-identifier-denotation id))
`(,mw:define1 ,id ,(mw:expand (caddr exp) env)))))))
-
- (define-syntax-loop
+
+ (define-syntax-loop
(lambda (exp rest)
(cond ((and (pair? exp)
(eq? (mw:syntax-lookup env (car exp))
@@ -115,7 +115,7 @@
(else (cons mw:begin1
(map (lambda (exp) (mw:expand exp env))
(cons exp rest)))))))
-
+
(redefinition
(lambda (id)
(if (symbol? id)
@@ -123,9 +123,9 @@
(mw:syntax-lookup mw:global-syntax-environment id)))
(mw:warn "Redefining keyword" id))
(mw:error "Malformed variable or keyword" id)))))
-
+
; body of letrec
-
+
(define-loop exp '() '())))
; Given an expression and a syntactic environment,
@@ -157,7 +157,7 @@
((or (eq? keyword mw:denote-of-define)
(eq? keyword mw:denote-of-define-syntax))
;; slight hack to allow expansion into defines -KenD
- (if mw:in-define?
+ (if mw:in-define?
(mw:error "Definition out of context" exp)
(begin
(set! mw:in-define? #t)
@@ -378,10 +378,10 @@
; Clean up alist hacking et cetera.
;;-----------------------------------------------------------------
-;; The following was added to allow expansion without flattening
-;; LETs to LAMBDAs so that the origianl structure of the program
-;; is preserved by macro expansion. I.e. so that usual.scm is not
-;; required. -- added KenD
+;; The following was added to allow expansion without flattening
+;; LETs to LAMBDAs so that the origianl structure of the program
+;; is preserved by macro expansion. I.e. so that usual.scm is not
+;; required. -- added KenD
(define (mw:process-let-bindings alist binding-list env) ;; helper proc
(map (lambda (bind)
@@ -414,7 +414,7 @@
; LET
(define (mw:let exp env)
(let* ( (name (if (or (pair? (cadr exp)) (null? (cadr exp)))
- #f
+ #f
(cadr exp))) ; named let?
(binds (if name (caddr exp) (cadr exp)))
(body (if name (cdddr exp) (cddr exp)))
@@ -460,12 +460,12 @@
(if (null? bindings)
`(let* ,(reverse newbinds) ,(mw:body body newenv))
(let* ( (bind (car bindings))
- (var (car bind))
+ (var (car bind))
(valexp (cdr bind))
(rename (mw:rename-vars (list var)))
(next-newenv (mw:syntax-rename newenv rename))
)
- (bind-loop (cdr bindings)
+ (bind-loop (cdr bindings)
(cons (list (cdr (assq var rename))
(mw:body valexp newenv))
newbinds)
@@ -500,13 +500,13 @@
) )
;
-; Quasiquotation (backquote)
+; Quasiquotation (backquote)
;
; At level 0, unquoted forms are left painted (not mw:strip'ed).
; At higher levels, forms which are unquoted to level 0 are painted.
; This includes forms within quotes. E.g.:
-; (lambda (a)
-; (quasiquote
+; (lambda (a)
+; (quasiquote
; (a (unquote a) b (quasiquote (a (unquote (unquote a)) b)))))
;or equivalently:
; (lambda (a) `(a ,a b `(a ,,a b)))
@@ -551,12 +551,12 @@
((eq? keyword mw:denote-of-quasiquote)
(cons 'quasiquote (quasi (cdr subexp) (+ level 1)))
)
- (else
- (cons (quasi (car subexp) level) (quasi (cdr subexp) level))
+ (else
+ (cons (quasi (car subexp) level) (quasi (cdr subexp) level))
)
)
) ) ; end else, let
- ) ; end cond
+ ) ; end cond
)
(quasi exp 0) ; need to unquote to level 0 to paint