+ for strings, global js object, new Foo() works

* module/language/ecmascript/array.scm (*array-prototype*): Declare the
  constructor.

* module/language/ecmascript/base.scm (pput, pdel): Remove some needless
  checks.
  (new): Move definition of new here, and use the constructor.

* module/language/ecmascript/compile-ghil.scm (compile-ghil): Add a stub
  so that when we load a compiled JS program, we make sure the runtime
  has been booted.

* module/language/ecmascript/function.scm (js-constructor): Export a
  js-constructor method instead of a new method.

* module/language/ecmascript/impl.scm (<js-global-object>): Define a new
  class for the global "this" object, wrapping bindings from the current
  module.
  (init-js-bindings!): Define the dozen or so global properties, in the
  current module.
  (+): Define addition operations for non-numbers. This is efficient
  because the generics are only dispatched if the fast-path fails.

module/language/ecmascript/array.scm

@@ -41,7 +41,8 @@
               (else o))))))
 
 (define *array-prototype* (make <js-object> #:class "Array"
-                                #:value new-array))
+                                #:value new-array
+                                #:constructor new-array))
 
 (hashq-set! *program-wrappers* new-array *array-prototype*)
 

module/language/ecmascript/base.scm

@@ -34,7 +34,7 @@
 
             call/this* call/this lambda/this define-js-method
 
-            new-object))
+            new-object new))
 
 (define *undefined* ((@@ (oop goops) make-unbound)))
 (define *this* (make-fluid))
@@ -72,21 +72,19 @@
   (memq attr (prop-attrs o p)))
 
 (define-method (pput (o <js-object>) p v)
-  (let ((p (if (string? p) (string->symbol p) p)))
   (if (prop-has-attr? o p 'ReadOnly)
       (throw 'ReferenceError o p)
-        (hashq-set! (js-props o) p v))))
+      (hashq-set! (js-props o) p v)))
 
 (define-method (pput (o <js-object>) (p <string>) v)
   (pput o (string->symbol p) v))
 
 (define-method (pdel (o <js-object>) p)
-  (let ((p (if (string? p) (string->symbol p) p)))
   (if (prop-has-attr? o p 'DontDelete)
       #f
       (begin
         (pput o p *undefined*)
-          #t))))
+        #t)))
 
 (define-method (pdel (o <js-object>) (p <string>) v)
   (pdel o (string->symbol p)))
@@ -236,3 +234,15 @@
            (pput o (car pair) (cdr pair)))
          pairs)
     o))
+(slot-set! *object-prototype* 'constructor new-object)
+
+(define-method (new o . initargs)
+  (let ((ctor (js-constructor o)))
+    (if (not ctor)
+        (throw 'TypeError 'new o)
+        (let ((o (make <js-object>
+                   #:prototype (or (js-prototype o) *object-prototype*))))
+          (let ((new-o (call/this o apply ctor initargs)))
+            (if (is-a? new-o <js-object>)
+                new-o
+                o))))))

module/language/ecmascript/compile-ghil.scm

@@ -25,19 +25,6 @@
   #:use-module (system base pmatch)
   #:export (compile-ghil))
 
-(define (compile-ghil exp env opts)
-  (values
-  (call-with-ghil-environment (make-ghil-toplevel-env) '()
-    (lambda (env vars)
-      (make-ghil-lambda env #f vars #f '() (comp exp env))))
-  env))
-
-(define (location x)
-  (and (pair? x)
-       (let ((props (source-properties x)))
-	 (and (not (null? props))
-              props))))
-
 (define-macro (@implv e l sym)
   `(make-ghil-ref ,e ,l
                   (ghil-var-at-module! ,e '(language ecmascript impl) ',sym #t)))
@@ -46,6 +33,22 @@
                    (@implv ,e ,l ,sym)
                    ,args))
 
+(define (compile-ghil exp env opts)
+  (values
+   (call-with-ghil-environment (make-ghil-toplevel-env) '()
+     (lambda (env vars)
+       (make-ghil-lambda env #f vars #f '()
+                         (make-ghil-begin env #f
+                                          (list (@impl env #f js-init '())
+                                                (comp exp env))))))
+   env))
+
+(define (location x)
+  (and (pair? x)
+       (let ((props (source-properties x)))
+	 (and (not (null? props))
+              props))))
+
 ;; The purpose, you ask? To avoid non-tail recursion when expanding a
 ;; long pmatch sequence.
 (define-macro (ormatch x . clauses)

module/language/ecmascript/function.scm

@@ -22,7 +22,7 @@
 (define-module (language ecmascript function)
   #:use-module (oop goops)
   #:use-module (language ecmascript base)
-  #:export (*function-prototype* *program-wrappers* new))
+  #:export (*function-prototype* *program-wrappers*))
 
 
 (define-class <js-program-wrapper> (<js-object>))
@@ -72,10 +72,8 @@
         (js-prototype wrapper)
         #f)))
 
-(define-method (new (f <applicable>) . initargs)
-  (let ((o (make <js-object>
-             #:prototype (or (js-prototype f) *object-prototype*))))
-    (let ((new-o (with-fluid *this* o (lambda () (apply f initargs)))))
-      (if (is-a? new-o <js-object>)
-          new-o
-          o))))
+(define-method (js-constructor (o <applicable>))
+  (let ((wrapper (hashq-ref *program-wrappers* o)))
+    (if wrapper
+        (js-constructor wrapper)
+        #f)))

module/language/ecmascript/impl.scm

@@ -28,7 +28,7 @@
                pget pput pdel has-property?
                ->boolean
                new-object new new-array)
-  #:export (get-this
+  #:export (js-init get-this
             typeof
             bitwise-not logical-not
             shift
@@ -36,6 +36,44 @@
             band bxor bior))
 
 
+(define-class <js-global-object> (<js-object>))
+(define-method (pget (o <js-global-object>) (p <string>))
+  (pget o (string->symbol p)))
+(define-method (pget (o <js-global-object>) (p <symbol>))
+  (let ((v (module-variable (current-module) p)))
+    (if v
+        (variable-ref v)
+        (next-method))))
+(define-method (pput (o <js-global-object>) (p <string>) v)
+  (pput o (string->symbol p) v))
+(define-method (pput (o <js-global-object>) (p <symbol>) v)
+  (module-define! (current-module) p v))
+(define-method (prop-attrs (o <js-global-object>) (p <symbol>))
+  (cond ((module-local-variable (current-module) p)
+         '())
+        ((module-variable (current-module) p)
+         '(DontDelete ReadOnly))
+        (else (next-method))))
+(define-method (prop-attrs (o <js-global-object>) (p <string>))
+  (prop-attrs o (string->symbol p)))
+
+(define (init-js-bindings! mod)
+  (module-define! mod 'NaN +nan.0)
+  (module-define! mod 'Infinity +inf.0)
+  (module-define! mod 'undefined *undefined*)
+  ;; isNAN, isFinite, parseFloat, parseInt, eval
+  ;; decodeURI, decodeURIComponent, encodeURI, encodeURIComponent
+  ;; Object Function Array String Boolean Number Date RegExp Error EvalError
+  ;; RangeError ReferenceError SyntaxError TypeError URIError
+  (module-define! mod 'Object *object-prototype*)
+  (module-define! mod 'Array *array-prototype*))
+
+(define (js-init)
+  (cond ((get-this))
+        (else
+         (fluid-set! *this* (make <js-global-object>))
+         (init-js-bindings! (current-module)))))
+
 (define (get-this)
   (fluid-ref *this*))
 
@@ -60,3 +98,15 @@
 (define bior logior)
 
 (define mod modulo)
+
+(define-method (+ (a <string>) (b <string>))
+  (string-append a b))
+
+(define-method (+ (a <string>) b)
+  (string-append a (->string b)))
+
+(define-method (+ a (b <string>))
+  (string-append (->string a) b))
+
+(define-method (+ a b)
+  (+ (->number a) (->number b)))

module/language/ecmascript/parse.scm

@@ -212,7 +212,7 @@
                      (new MemberExpression Arguments) -> `(new ,$2 ,$3))
 
    (NewExpression (MemberExpression) -> $1
-                  (new NewExpression) -> `(new ,$2))
+                  (new NewExpression) -> `(new ,$2 ()))
 
    (CallExpression (MemberExpression Arguments) -> `(call ,$1 ,$2)
                    (CallExpression Arguments) -> `(call ,$1 ,$2)