conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Added match/lexical-context and trace-match/lexical-context to match.ss

This commit is contained in:
Abdulaziz Ghuloum 2008-01-03 23:39:16 -05:00
parent 5d2f14c523
commit eb224d3548
1 changed files with 25 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
lib/match.ss
View File

@ -5,6 +5,9 @@
;;; some improvements were suggested by Steve Ganz. Additional ;;; some improvements were suggested by Steve Ganz. Additional
;;; modifications were made by Kent Dybvig. ;;; modifications were made by Kent Dybvig.
;; (Jan 2008)
;; Aziz added match/lexical-context trace-match/lexical-context
;; (Nov 2007) ;; (Nov 2007)
;; Aziz Ghuloum added it to ikarus. ;; Aziz Ghuloum added it to ikarus.
@ -91,8 +94,10 @@
(library (match) (library (match)
(export match trace-match guard ... quasiquote unquote (export match trace-match
unquote-splicing) match/lexical-context trace-match/lexical-context
match-equality-test
guard ... quasiquote unquote unquote-splicing)
(import (ikarus)) (import (ikarus))
(define-syntax rec (define-syntax rec
@ -115,12 +120,19 @@
#'(let f ((ThreadedId ThreadedId) ... (x Exp)) #'(let f ((ThreadedId ThreadedId) ... (x Exp))
(match-help ctxt f x (ThreadedId ...) Clause ...)))))) (match-help ctxt f x (ThreadedId ...) Clause ...))))))
(define-syntax match/lexical-context
(lambda (x)
(syntax-case x ()
((_ ctxt Exp Clause ...)
#'(let f ((x Exp))
(match-help ctxt f x () Clause ...))))))
(define-syntax match (define-syntax match
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
((ctxt Exp Clause ...) ((ctxt Exp Clause ...)
#'(let f ((x Exp)) #'(match/lexical-context ctxt Exp Clause ...)))))
(match-help ctxt f x () Clause ...))))))
(define-syntax trace-match+ (define-syntax trace-match+
(lambda (x) (lambda (x)
@ -130,13 +142,19 @@
(match-help ctxt f x (ThreadedId ...) Clause ...)))) (match-help ctxt f x (ThreadedId ...) Clause ...))))
(f ThreadedId ... Exp)))))) (f ThreadedId ... Exp))))))
(define-syntax trace-match/lexical-context
(lambda (x)
(syntax-case x ()
((_ ctxt Name Exp Clause ...)
#'(letrec ((f (trace-lambda Name (x)
(match-help ctxt f x () Clause ...))))
(f Exp))))))
(define-syntax trace-match (define-syntax trace-match
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
((ctxt Name Exp Clause ...) ((ctxt Name Exp Clause ...)
#'(letrec ((f (trace-lambda Name (x) #'(trace-match/lexical-context ctxt Name Exp Clause ...)))))
(match-help ctxt f x () Clause ...))))
(f Exp))))))
;;; ------------------------------ ;;; ------------------------------