%%%MAKE-HASH-TABLE is now %%%MAKE-OBJECT.

MAKE-OBJECT: New core function to fill a new object with dynamically generated keys.

NEWS

@@ -2,6 +2,8 @@ Changes of tre-0.4 relative to tre-0.3:
   * PHP: LENGTH returns correct value for wrapped arrays.
   * PHP: Issue an error when trying to convert a cons into
          string.
+  * JavaScript/PHP: %%%MAKE-HASH-TABLE is now %%%MAKE-OBJECT.
+  * JavaScript: MAKE-OBJECT: New function.
 
 RELEASES:
 

environment/transpiler/middle-end/quote-keywords.lisp

@@ -1,7 +1,7 @@
 (define-tree-filter quote-keywords (x)
   (| (quote? x)
      (& (cons? x)
-        (in? x. 'make-hash-table '%%%make-hash-table)))
+        (in? x. 'make-hash-table '%%%make-object)))
 	x
   (keyword? x) 
     `(quote ,x))

environment/transpiler/targets/javascript/class.lisp

@@ -40,7 +40,7 @@
       ,@(js-gen-inherit-methods class-name (!? (class-parent cls)
                                                (class-name !)))
       (hash-merge (slot-value ,class-name 'prototype)
-	              (%%%make-hash-table ,@(apply #'+ (carlist !)))))))
+	              (%%%make-object ,@(apply #'+ (carlist !)))))))
 
 (define-js-std-macro finalize-class (class-name)
   (print-definition `(finalize-class ,class-name))

environment/transpiler/targets/javascript/codegen.lisp

@@ -166,7 +166,7 @@
         name)
      ":" ,value))
 
-(define-js-macro %%%make-hash-table (&rest args)
+(define-js-macro %%%make-object (&rest args)
   (c-list (@ [js-literal-hash-entry _. ._] (group args 2)) :brackets :curly))
 
 (define-js-macro href (arr &rest idx)   ; TODO: WTF?
@@ -188,7 +188,7 @@
   (? x
      `(%%native "new " ,(? (defined-function x.)
                            (compiled-function-name-string x.)
-                           (obfuscated-identifier x.))
+                           x.)
                        ,@(c-list .x))
      `(%%native "{}")))
 

environment/transpiler/targets/javascript/core.lisp

@@ -57,7 +57,8 @@
                                 "dot-expand.lisp"
                                 "math.lisp"
                                 "nanotime.lisp"
-                                "property.lisp")))
+                                "property.lisp"
+                                "make-object.lisp")))
 
 (when *have-compiler?*
   (= *js-core1* (+ *js-core1* ,(js-load-core "" "native-eval.lisp"))))

environment/transpiler/targets/javascript/core/hash.lisp

@@ -1,65 +1,65 @@
-(defvar *obj-id-counter* 0)
+(var *obj-id-counter* 0)
 
-(defun make-hash-table (&key (test #'eql) (size nil))
-  (aprog1 (%%%make-hash-table)
+(fn make-hash-table (&key (test #'eql) (size nil))
+  (aprog1 (%%%make-object)
     (= !.__tre-test test)
     (unless (%href-==? test)
-      (= !.__tre-keys (%%%make-hash-table)))))
+      (= !.__tre-keys (%%%make-object)))))
 
-(defun hash-table? (x)
+(fn hash-table? (x)
   (& (object? x)
      (undefined? x.__class)))
 
-(defun %htest (x)
+(fn %htest (x)
   (& (defined? x.__tre-test)
      x.__tre-test))
 
-(defun %%objkey ()
+(fn %%objkey ()
   (setq *obj-id-counter* (%%%+ 1 *obj-id-counter*))
   (%%%string+ "~~O" *obj-id-counter*))
 
-(defun %%numkey (x)
+(fn %%numkey (x)
   (%%%string+ "~~N" x))
 
-(defun hashkeys (hash)
+(fn hashkeys (hash)
   (? (& (hash-table? hash)
         (defined? hash.__tre-keys))
      (cdrlist (%property-list hash.__tre-keys))
      (carlist (%property-list hash))))
 
-(defun %make-href-object-key (hash key)
+(fn %make-href-object-key (hash key)
   (unless (defined? key.__tre-object-id)
     (= key.__tre-object-id (%%objkey)))
   (%%%=-aref key hash.__tre-keys key.__tre-object-id)
   key.__tre-object-id)
 
-(defun %href-key (hash key)
+(fn %href-key (hash key)
   (? (object? key)
      (%make-href-object-key hash key)
      (aprog1 (%%numkey key)
        (%%%=-aref key hash.__tre-keys !))))
 
-(defun =-href-obj (value hash key)
+(fn =-href-obj (value hash key)
   (%%%=-aref value hash (%href-key hash key)))
 
-(defun %href-==? (x)
+(fn %href-==? (x)
   (| (eq x #'==)
      (eq x #'string==)
      (eq x #'number==)))
 
-(defun =-href (value hash key)
+(fn =-href (value hash key)
   (!? (%htest hash)
       (? (%href-==? !)
          (%%%=-aref value hash key)
          (=-href-obj value hash key))
       (%%%=-aref value hash key)))
 
-(defun %href-user (hash key)
+(fn %href-user (hash key)
   (@ (k (hashkeys hash))
     (& (funcall hash.__tre-test k key)
        (return (%%%aref hash (%href-key hash k))))))
 
-(defun href (hash key)
+(fn href (hash key)
   (!? (%htest hash)
       (?
         (eq #'eq !)   (%%%aref hash (? (object? key)
@@ -69,7 +69,7 @@
         (%href-user hash key))
       (%%%aref hash key)))
 
-(defun hash-merge (a b)
+(fn hash-merge (a b)
   (when (| a b)
     (| a (= a (make-hash-table :test b.__tre-test)))
     (? (defined? b.__tre-keys)
@@ -80,5 +80,5 @@
                         a "[k] = " b "[k];"))
     a))
 
-(defun copy-hash-table (x)
+(fn copy-hash-table (x)
   (hash-merge nil x))

environment/transpiler/targets/javascript/core/make-object.lisp

@@ -0,0 +1,4 @@
+(fn make-object (&rest x)
+  (!= (%%%make-object)
+    (@ (i (group x 2) !)
+      (%%%=-aref .i ! i.))))

environment/transpiler/targets/javascript/core/symbol.lisp

@@ -1,5 +1,5 @@
-(defvar *symbols* (%%%make-hash-table))
-(defvar *package* nil)
+(var *symbols* (%%%make-object))
+(var *package* nil)
 
 (defnative %symbol (name pkg)
   (= this.__class ,(obfuscated-identifier 'symbol)
@@ -18,13 +18,13 @@
                                    !.n
                                    "NIL"))
               symbol-table  (| (%%%aref *symbols* pkg-name)
-   				               (%%%=-aref (%%%make-hash-table) *symbols* pkg-name)))
+   				               (%%%=-aref (%%%make-object) *symbols* pkg-name)))
          (| (%%%aref symbol-table name)
             (%%%=-aref (new %symbol name pkg) symbol-table name))))))
 
 (setq *package* (symbol "TRE" nil))
 
-(defvar *keyword-package* (symbol "KEYWORD" nil))
+(var *keyword-package* (symbol "KEYWORD" nil))
 
 (defnative =-symbol-function (v x)
   (setq x.f v))

environment/transpiler/targets/javascript/expand.lisp

@@ -74,9 +74,9 @@
   (? x
      (? (| (keyword? x.)
 	       (string? x.))
-        `(%%%make-hash-table ,@x)
+        `(%%%make-object ,@x)
         `(%new ,@x))
-     `(%%%make-hash-table)))
+     `(%%%make-object)))
 
 (define-js-std-macro js-type-predicate (name &rest types)
   `(fn ,name (x)

environment/transpiler/targets/php/codegen.lisp

@@ -215,7 +215,7 @@
 (fn php-literal-array-elements (x)
   (pad (@ #'php-literal-array-element x) ", "))
 
-(define-php-macro %%%make-hash-table (&rest elements)
+(define-php-macro %%%make-object (&rest elements)
   `(%%native "Array (" ,@(php-literal-array-elements (group elements 2)) ")"))
 
 (define-php-macro make-array (&rest elements)

environment/transpiler/targets/php/core/array.lisp

@@ -1,33 +1,33 @@
-(defun array? (x)
+(fn array? (x)
   (| (is_a x "__array")
      (is_array x)))
 
-(defun %array-push (arr x)
+(fn %array-push (arr x)
   (%= (%%native "$" arr "[]") x)
   x)
 
-(defun array-push (arr x)
+(fn array-push (arr x)
   (? (is_a x "__array")
      (arr.p x)
      (%array-push arr x))
   x)
 
-(defun list-array (x)
+(fn list-array (x)
   (let a (make-array)
     (@ (i x a)
       (a.p i))))
 
-(defun list-phphash (x)
-  (let a (%%%make-hash-table)
-    (@ (i x a)
-      (%= (%%native "$" a "[]") i))))
+(fn list-phphash (x)
+  (!= (%%%make-object)
+    (@ (i x !)
+      (%= (%%native "$" ! "[]") i))))
 
-(defun aref (a k)
+(fn aref (a k)
   (? (is_array a)
      (php-aref a k)
      (href a k)))
 
-(defun (= aref) (v a k)
+(fn (= aref) (v a k)
   (? (is_array a)
      (=-php-aref v a k)
      (=-href v a k)))

environment/transpiler/targets/php/core/hash.lisp

@@ -1,7 +1,7 @@
-(defun hash-table? (x)
+(fn hash-table? (x)
   (is_a x "__array"))
 
-(defun %%key (x)
+(fn %%key (x)
   (?
     (is_a x "__symbol")    (%%%string+ "~%S" x.n "~%P" (? (keyword? x)
                                                           "_kw"
@@ -11,7 +11,7 @@
     (is_a x "__character") (%%%string+ "~%C" x.v)
     x))
 
-(defun %%unkey (x)
+(fn %%unkey (x)
   (? (%%%== "~%" (substr x 0 2))
      (alet (substr x 3)
        (case (substr x 2 1) :test #'%%%==
@@ -27,37 +27,37 @@
          (error "Illegal index ~A." x)))
      x))
 
-(defun hashkeys (x)
+(fn hashkeys (x)
   (? (hash-table? x)
      (@ #'%%unkey (x.keys))
      (maparray #'identity (phphash-hashkeys x))))
 
-(defun hash-merge (a b)
+(fn hash-merge (a b)
   (| a (= a (make-hash-table)))
   (@ (k (hashkeys b) a)
     (= (href a k) (href b k))))
 
-(defun alist-phphash (x)
-  (let a (%%%make-hash-table)
-    (@ (i x a)
-      (%%%href-set .i a i.))))
+(fn alist-phphash (x)
+  (!= (%%%make-object)
+    (@ (i x !)
+      (%%%href-set .i ! i.))))
 
-(defun phphash-alist (x)
+(fn phphash-alist (x)
   (with-queue q
     (@ (i (hashkeys x) (queue-list q))
       (enqueue q (. i (aref x i))))))
 
-(defun %href-error (h)
+(fn %href-error (h)
   (error "HREF expects an hash table instead of ~A." h))
 
-(defun href (h k)
+(fn href (h k)
   (alet (%%key k)
     (? (is_a h "__array")
        (h.g !)
        (& (php-aref-defined? h !)
           (php-aref h !)))))
 
-(defun (= href) (v h k)
+(fn (= href) (v h k)
   (alet (%%key k)
     (?  (is_a h "__array")
         (h.s (%%key !) v)