Disable contracts for performance (a bit too aggressive, need to rollback some of these)

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*)

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

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))
 

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)
 

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))

private/subscripts.rkt

@@ -10,7 +10,7 @@
          racket/function
          racket/list
          phc-toolkit/untyped
-         racket/contract
+         "optcontract.rkt";racket/contract
          racket/string
          racket/syntax)
 

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

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) …])]))

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 … …)]))