From 99d16538987d667496c0b1a49008dfefabbe6bf2 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Wed, 29 May 2013 22:23:45 -0700
Subject: [PATCH] Add opt-expr and define-literal-syntax-class in utils.

original commit: 10ffb52968b4394c136bbc1e77fdc8fbe2b1ce9e
---
 .../typed-racket/optimizer/optimizer.rkt      | 10 ++++---
 .../typed-racket/optimizer/utils.rkt          | 28 ++++++++++++++++++-
 2 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt
index 908b00b2..9d01965f 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt
@@ -5,10 +5,12 @@
          (for-template racket/base)
          "../utils/utils.rkt"
          (private syntax-properties)
-         (optimizer utils
-                    number fixnum float float-complex vector string list pair
-                    sequence box struct dead-code apply unboxed-let
-                    hidden-costs))
+         (except-in
+           (optimizer utils
+                      number fixnum float float-complex vector string list pair
+                      sequence box struct dead-code apply unboxed-let
+                      hidden-costs)
+           opt-expr))
 
 (provide optimize-top)
 
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/utils.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/utils.rkt
index 6fd22ae4..427a1c52 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/utils.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/utils.rkt
@@ -2,7 +2,11 @@
 
 (require racket/match unstable/sequence
          racket/dict syntax/id-table racket/syntax syntax/stx
+         syntax/parse
+         racket/promise
+         (for-syntax racket/base syntax/parse racket/syntax)
          "../utils/utils.rkt"
+         (utils tc-utils)
          (for-template racket/base)
          (types type-table utils subtype)
          (rep type-rep))
@@ -11,7 +15,8 @@
          subtypeof? isoftype?
          mk-unsafe-tbl
          n-ary->binary n-ary-comp->binary
-         optimize
+         opt-expr optimize
+         define-literal-syntax-class
          syntax/loc/origin quasisyntax/loc/origin)
 
 ;; for tracking both origin and source location information
@@ -68,3 +73,24 @@
 ;; will be set to the actual optimization function at the entry point
 ;; of the optimizer
 (define optimize (make-parameter #f))
+
+(define-syntax-class opt-expr
+  #:commit
+  #:attributes (opt)
+  (pattern e:expr #:attr opt (delay ((optimize) #'e))))
+
+(define-syntax (define-literal-syntax-class stx)
+  (define-splicing-syntax-class spec
+    #:attributes (name (literals 1))
+    (pattern (~seq name:id (literals:id ...)))
+    (pattern literal:id
+             #:with (literals ...) #'(literal)
+             #:with name (format-id #'literal "~a^" #'literal)))
+  (syntax-parse stx
+    ((_ :spec)
+     #'(begin
+         (define-syntax-class name
+           #:commit
+           #:literals (literals ...)
+           (pattern (~and op (~or literals ...))
+                    #:do [(add-disappeared-use (syntax-local-introduce #'op))]))))))