diff options
Diffstat (limited to 'mwdenote.scm')
-rw-r--r-- | mwdenote.scm | 50 |
1 files changed, 33 insertions, 17 deletions
diff --git a/mwdenote.scm b/mwdenote.scm index c3fe5f3..def1d4d 100644 --- a/mwdenote.scm +++ b/mwdenote.scm @@ -42,6 +42,7 @@ (set! . (special set!)) (begin . (special begin)) (define . (special define)) + (case . (special case)) ;; @@ added wdc (let . (special let)) ;; @@ added KAD (let* . (special let*)) ;; @@ " (letrec . (special letrec)) ;; @@ " @@ -150,6 +151,9 @@ (define mw:denote-of-::: (mw:syntax-lookup mw:standard-syntax-environment ':::)) +(define mw:denote-of-case + (mw:syntax-lookup mw:standard-syntax-environment 'case)) ;; @@ wdc + (define mw:denote-of-let (mw:syntax-lookup mw:standard-syntax-environment 'let)) ;; @@ KenD @@ -200,23 +204,35 @@ ; Given a datum, strips the suffixes from any symbols that appear within ; the datum, trying not to copy any more of the datum than necessary. -; Well, right now I'm just copying the datum, but I need to fix that! - -(define (mw:strip x) - (cond ((symbol? x) - (let ((chars (memv mw:suffix-character - (reverse (string->list - (symbol->string x)))))) - (if chars - (string->symbol - (list->string (reverse (cdr chars)))) - x))) - ((pair? x) - (cons (mw:strip (car x)) - (mw:strip (cdr x)))) - ((vector? x) - (list->vector (map mw:strip (vector->list x)))) - (else x))) + +; @@ rewrote to strip *all* suffixes -- wdc + +(define mw:strip + (letrec ((original-symbol + (lambda (x) + (let ((s (symbol->string x))) + (loop x s 0 (string-length s))))) + (loop + (lambda (sym s i n) + (cond ((= i n) sym) + ((char=? (string-ref s i) + mw:suffix-character) + (string->symbol (substring s 0 i))) + (else + (loop sym s (+ i 1) n)))))) + (lambda (x) + (cond ((symbol? x) + (original-symbol x)) + ((pair? x) + (let ((y (mw:strip (car x))) + (z (mw:strip (cdr x)))) + (if (and (eq? y (car x)) + (eq? z (cdr x))) + x + (cons y z)))) + ((vector? x) + (list->vector (map mw:strip (vector->list x)))) + (else x))))) ; Given a list of identifiers, returns an alist that associates each ; identifier with a fresh identifier. |