symbol table to reduce allocation of symbols

js-assembler/assemble-helpers.rkt

@@ -33,7 +33,11 @@
          assemble-module-variable-ref
          
          block-looks-like-context-expected-values?
-         block-looks-like-pop-multiple-values-and-continue?)
+         block-looks-like-pop-multiple-values-and-continue?
+
+         current-interned-symbol-table
+         assemble-current-interned-symbol-table
+         )
 
 (require/typed typed/racket/base
                [regexp-split (Regexp String -> (Listof String))])
@@ -124,12 +128,36 @@
   (format "M.c[M.c.length-1].~a"
           (ControlFrameTemporary-name t)))
 
+
+(: current-interned-symbol-table (Parameterof (HashTable Symbol Symbol)))
+(define current-interned-symbol-table
+  (make-parameter ((inst make-hasheq Symbol Symbol))))
+
+
+(: assemble-current-interned-symbol-table (-> String))
+(define (assemble-current-interned-symbol-table)
+  (string-join (hash-map
+                  (current-interned-symbol-table)
+                  (lambda: ([a-symbol : Symbol] [variable-name : Symbol]) 
+                    (format "var ~a=RT.makeSymbol(~s);"
+                            variable-name
+                            (symbol->string a-symbol))))
+                 "\n"))
+  
 ;; fixme: use js->string
 (: assemble-const (Const -> String))
 (define (assemble-const stmt)
   (let: loop : String ([val : const-value (Const-const stmt)])
         (cond [(symbol? val)
-               (format "RT.makeSymbol(~s)" (symbol->string val))]
+               (define intern-var (hash-ref (current-interned-symbol-table)
+                                            val
+                                            (lambda ()
+                                              (define fresh (gensym 'sym))
+                                              (hash-set! (current-interned-symbol-table) val fresh)
+                                              fresh)))
+               (symbol->string intern-var)
+               ;;(format "RT.makeSymbol(~s)" (symbol->string val))
+               ]
               [(pair? val)
                (format "RT.makePair(~a,~a)" 
                        (loop (car val))

js-assembler/assemble.rkt

@@ -36,6 +36,7 @@
 ;; What's emitted is a function expression that, when invoked, runs the
 ;; statements.
 (define (assemble/write-invoke stmts op)
+  (parameterize ([current-interned-symbol-table ((inst make-hash Symbol Symbol))])
   (display "(function(M, success, fail, params) {\n" op)
   (display "var param;\n" op)
   (display "var RT = plt.runtime;\n" op)
@@ -56,8 +57,8 @@
                 (list->set entry-points)
                 function-entry-and-exit-names
                 op)
-  
   (write-linked-label-attributes stmts blockht op)
+  (display (assemble-current-interned-symbol-table) op)
   
   (display "M.params.currentErrorHandler = fail;\n" op)
   (display "M.params.currentSuccessHandler = success;\n" op)
@@ -71,7 +72,7 @@ EOF
             op)
   (fprintf op "M.trampoline(~a, true); })"
            (assemble-label (make-Label (BasicBlock-name (first basic-blocks)))
-                           blockht)))
+                           blockht))))
 
 
 

version.rkt

@@ -7,4 +7,4 @@
 (provide version)
 (: version String)
 
-(define version "1.202")
+(define version "1.204")