commit 5920708c4778915dbe5f116dee7a79564d397d93
parent c80d896fcd8a5ad35377c4f2a8c055c68dd2deb8
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Tue, 14 Mar 2017 20:30:58 +0100
Disable contracts for performance (a bit too aggressive, need to rollback some of these)
Diffstat:
9 files changed, 62 insertions(+), 8 deletions(-)
diff --git a/private/ddd-forms.rkt b/private/ddd-forms.rkt
@@ -118,14 +118,20 @@
{~not (_ _ {~literal …} . _)}} ;; not fn directly followed by a …
;#'(#%app apply fn (#%app append arg.expanded …))
(syntax/top-loc this-syntax
- (#%app apply fn (#%app splice-append arg.expanded … #:rest rest.v)))]
+ (#%plain-app apply fn (#%plain-app splice-append-nokw rest.v arg.expanded …)))]
[(_ arg:arg … . rest:not-stx-pair) ;; shorthand for list creation
;#'(#%app apply list (#%app append arg.expanded …))
+ #;(syntax/top-loc this-syntax
+ (#%plain-app apply list
+ (#%plain-app splice-append-nokw rest.v arg.expanded …)))
+ ;; (apply list v) is a no-op asside from error handling.
(syntax/top-loc this-syntax
- (#%app apply list (#%app splice-append arg.expanded … #:rest rest.v)))]))
+ (#%plain-app splice-append-nokw rest.v arg.expanded …))]))
(define (splice-append #:rest [rest '()] . l*)
(splice-append* (if (null? rest) l* (append l* rest))))
+(define (splice-append-nokw rest . l*)
+ (splice-append* (if (null? rest) l* (append l* rest))))
(define (splice-append* l*)
(cond
[(pair? l*)
diff --git a/private/ddd.rkt b/private/ddd.rkt
@@ -9,7 +9,7 @@
(prefix-in - syntax/parse/private/residual)
racket/stxparam
"lifted-variables-communication.rkt"
- (for-syntax racket/contract
+ (for-syntax "optcontract.rkt";racket/contract
racket/syntax
phc-toolkit/untyped
racket/function
@@ -256,6 +256,7 @@
;;; pvar outside of the body.
(define-syntax/case (ddd body) ()
(define/with-syntax (pvar …) (current-pvars-shadowers))
+ (displayln (stx-map syntax-e (current-pvars-shadowers)))
(define-temp-ids "~aᵢ" (pvar …))
(define/with-syntax f
diff --git a/private/fully-expanded-grammar-extract-bindings.rkt b/private/fully-expanded-grammar-extract-bindings.rkt
@@ -4,7 +4,7 @@
(require syntax/parse
phc-toolkit/untyped
- racket/contract
+ "optcontract.rkt";racket/contract
racket/list
(for-template '#%kernel))
diff --git a/private/lifted-variables-communication.rkt b/private/lifted-variables-communication.rkt
@@ -8,7 +8,8 @@
(require racket/stxparam
(for-syntax racket/base
racket/syntax
- racket/contract))
+ "optcontract.rkt";racket/contract
+ ))
(define-syntax-parameter lift-late-pvars-param #f)
diff --git a/private/optcontract.rkt b/private/optcontract.rkt
@@ -0,0 +1,13 @@
+#lang racket
+
+(require racket/contract)
+
+(provide (except-out (all-from-out racket/contract)
+ define-struct/contract
+ ;define/contract
+ provide/contract
+ invariant-assertion)
+ define/contract)
+
+(define-syntax-rule (define/contract sig c . rest)
+ (define sig . rest))
+\ No newline at end of file
diff --git a/private/subscripts.rkt b/private/subscripts.rkt
@@ -10,7 +10,7 @@
racket/function
racket/list
phc-toolkit/untyped
- racket/contract
+ "optcontract.rkt";racket/contract
racket/string
racket/syntax)
diff --git a/private/template-subscripts.rkt b/private/template-subscripts.rkt
@@ -4,7 +4,7 @@
racket/list
racket/string
racket/function
- racket/contract
+ "optcontract.rkt";racket/contract
phc-toolkit/untyped
phc-toolkit/untyped-only/syntax-parse
racket/stxparam
@@ -32,7 +32,8 @@
srfi/13
(subtract-in racket/string srfi/13)
syntax/contract
- racket/contract))
+ "optcontract.rkt";racket/contract
+ ))
(provide subtemplate
quasisubtemplate
diff --git a/test/test-copy-attribute-template-problem.rkt b/test/test-copy-attribute-template-problem.rkt
@@ -0,0 +1,11 @@
+#lang racket
+(require subtemplate/private/copy-attribute
+ stxparse-info/parse
+ stxparse-info/parse/experimental/template
+ phc-toolkit/untyped)
+
+(syntax->datum
+ (syntax-parse #'([1 2 3] #:kw [4 5])
+ [({~and {~or #:kw (x …)}} …)
+ (copy-raw-syntax-attribute y (attribute* x) 2 #t)
+ (template [(?? (?@ y …) empty) …])]))
+\ No newline at end of file
diff --git a/test/test-performance.rkt b/test/test-performance.rkt
@@ -0,0 +1,18 @@
+#lang racket
+
+(require subtemplate/override)
+
+#;(time
+ (syntax-case #'((((0 1 2 3 4 5 6 7 8 9)))) ()
+ [((((a b c d e f g h i j) …) …) …)
+ #'(a … … …)]))
+
+#;(time
+ (syntax-case #'((((0 1 2 3 4 5 6 7 8 9)))) ()
+ [((((a b c d e f g h i j) …) …) …)
+ (list #'a … … …)]))
+
+(time
+ (syntax-case #'(((0 1 2 3 4 5 6 7 8 9))) ()
+ [(((a b c d e f g h i j) …) …)
+ (list #'a … …)]))
+\ No newline at end of file
