suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

..

Browse Source 
original commit: 726b2052ab64208d6ce2ca39399a821e57782b7c
This commit is contained in:
Robby Findler 2003-05-28 22:03:00 +00:00
parent 3ae0d37e79
commit 18d58f1106
2 changed files with 39 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/mzlib/match.ss
View File

@ -131,7 +131,8 @@
(require-for-syntax (lib "stx.ss" "syntax") (require-for-syntax (lib "stx.ss" "syntax")
(lib "etc.ss") (lib "etc.ss")
(lib "list.ss") (lib "list.ss")
(lib "include.ss")) (lib "include.ss")
(lib "struct.ss" "syntax"))
(require (lib "etc.ss") (require (lib "etc.ss")
(lib "list.ss")) (lib "list.ss"))

47
collects/mzlib/plt-match.ss
View File

@ -7,10 +7,9 @@
;; ;;
;; Special thanks go out to: ;; Special thanks go out to:
;; Robert Bruce Findler for support and bug detection. ;; Robert Bruce Findler for support and bug detection.
;; Scott Owens for the new constructor grammer.
;; Doug Orleans for pointing out that pairs should be reused while ;; Doug Orleans for pointing out that pairs should be reused while
;; matching lists. ;; matching lists.
;; ;;
;; ;;
;; Originally written by Andrew K. Wright, 1993 (wright@research.nj.nec.com) ;; Originally written by Andrew K. Wright, 1993 (wright@research.nj.nec.com)
;; which in turn was adapted from code written by Bruce F. Duba, 1991. ;; which in turn was adapted from code written by Bruce F. Duba, 1991.
@ -44,7 +43,7 @@
;; ;;
;; pat ::= ;; pat ::=
;; identifier this binds an identifier if it ;; identifier this binds an identifier if it
;; doesn't conflict with ..k or _ ;; doesn't conflict with ..k, __k or _
;; | _ anything ;; | _ anything
;; | #t #t ;; | #t #t
;; | #f #f ;; | #f #f
@ -53,7 +52,8 @@
;; | character a character ;; | character a character
;; | 'sexp an s-expression ;; | 'sexp an s-expression
;; | 'symbol a symbol (special case of s-expr) ;; | 'symbol a symbol (special case of s-expr)
;; | (var id) allows one to use ..k or _ as identifiers ;; | (var id) allows one to use ..k or _ as
;; identifiers
;; | (list lvp_1 ... lvp_n) list of n elements ;; | (list lvp_1 ... lvp_n) list of n elements
;; | (list-rest lvp_1 ... lvp_n pat) an improper list of n elements ;; | (list-rest lvp_1 ... lvp_n pat) an improper list of n elements
;; plus a last element which represents ;; plus a last element which represents
@ -66,9 +66,12 @@
;; items in the list ;; items in the list
;; | (list-no-order pat ... pat_n ooo) pat_n matches the remaining ;; | (list-no-order pat ... pat_n ooo) pat_n matches the remaining
;; unmatched items ;; unmatched items
;; | (hash-table pat ...) matches the elements of a hash table ;; | (hash-table (pat_k pat_v) ...) matches the elements of a hash table
;; | (hash-table pat ... pat_n ooo) pat_n must match the remaining ;; | (hash-table (pat_k pat_v) ... (pat_kn pat_vn) ooo)
;; unmatched elements ;; pat_kn must match the remaining
;; unmatched key elements
;; pat_vn must match the remaining
;; unmatched value elements
;; | (app field pat) a field of a structure (field is ;; | (app field pat) a field of a structure (field is
;; an accessor) ;; an accessor)
;; Actually field can be any function ;; Actually field can be any function
@ -120,7 +123,7 @@
;; ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; extra
(module plt-match mzscheme (module plt-match mzscheme
(provide (provide
@ -131,14 +134,15 @@
match-let* match-let*
match-letrec match-letrec
match-define match-define
match-test
match:test-no-order match:test-no-order
) )
(require-for-syntax (lib "stx.ss" "syntax") (require-for-syntax (lib "stx.ss" "syntax")
(lib "etc.ss") (lib "etc.ss")
(lib "list.ss") (lib "list.ss")
(lib "include.ss")) (lib "include.ss")
(lib "struct.ss" "syntax"))
(require (lib "etc.ss") (require (lib "etc.ss")
(lib "list.ss")) (lib "list.ss"))
@ -166,12 +170,35 @@
match-let* match-let*
match-letrec match-letrec
match-define match-define
match-test
) )
(include "private/plt-match/match-inc.scm") (include "private/plt-match/match-inc.scm")
(define node-count 0) (define node-count 0)
;;!(syntax match-test)
;; This macro only returns a list of two numbers.
;; The first number represents the
;; number of nodes generated in the process of compiling the match
;; expression. This gives one and idea as to the size of the
;; compiled expression.
;; The second number is the amount of "real" time in milliseconds
;; it took to compile the patterns.
(define match-test/proc
(lambda (stx)
(syntax-case stx (=>)
((_ clause ...)
(begin
(set! node-count 0)
(let-values (((stx t rt gc) (time-apply gen-match
(list (syntax x)
'()
(syntax (clause ...))
stx))))
#`(list #,node-count
#,rt)))))))
(define match/proc (define match/proc
(lambda (stx) (lambda (stx)
(syntax-case stx (=>) (syntax-case stx (=>)