module/language/ecmascript/impl.scm

   1 ;;; ECMAScript for Guile
   2
   3 ;; Copyright (C) 2009 Free Software Foundation, Inc.
   4
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 ;;; Code:
  20
  21 (define-module (language ecmascript impl)
  22   #:use-module (oop goops)
  23   #:use-module (language ecmascript base)
  24   #:use-module (language ecmascript function)
  25   #:use-module (language ecmascript array)
  26   #:re-export (*undefined* *this* call/this*
  27                pget pput pdel has-property?
  28                ->boolean ->number
  29                new-object new new-array)
  30   #:export (js-init get-this
  31             typeof
  32             bitwise-not logical-not
  33             shift
  34             mod
  35             band bxor bior
  36             make-enumerator))
  37
  38
  39 (define-class <js-module-object> (<js-object>)
  40   (module #:init-form (current-module) #:init-keyword #:module
  41           #:getter js-module))
  42 (define-method (pget (o <js-module-object>) (p <string>))
  43   (pget o (string->symbol p)))
  44 (define-method (pget (o <js-module-object>) (p <symbol>))
  45   (let ((v (module-variable (js-module o) p)))
  46     (if v
  47         (variable-ref v)
  48         (next-method))))
  49 (define-method (pput (o <js-module-object>) (p <string>) v)
  50   (pput o (string->symbol p) v))
  51 (define-method (pput (o <js-module-object>) (p <symbol>) v)
  52   (module-define! (js-module o) p v))
  53 (define-method (prop-attrs (o <js-module-object>) (p <symbol>))
  54   (cond ((module-local-variable (js-module o) p) '())
  55         ((module-variable (js-module o) p) '(DontDelete ReadOnly))
  56         (else (next-method))))
  57 (define-method (prop-attrs (o <js-module-object>) (p <string>))
  58   (prop-attrs o (string->symbol p)))
  59 (define-method (prop-keys (o <js-module-object>))
  60   (append (hash-map->list (lambda (k v) k) (module-obarray (js-module o)))
  61           (next-method)))
  62
  63 ;; we could make a renamer, but having obj['foo-bar'] should be enough
  64 (define (js-require modstr)
  65   (make <js-module-object> #:module
  66         (resolve-interface (map string->symbol (string-split modstr #\.)))))
  67
  68 (define-class <js-global-object> (<js-module-object>))
  69 (define-method (js-module (o <js-global-object>))
  70   (current-module))
  71
  72 (define (init-js-bindings! mod)
  73   (module-define! mod 'NaN +nan.0)
  74   (module-define! mod 'Infinity +inf.0)
  75   (module-define! mod 'undefined *undefined*)
  76   (module-define! mod 'require js-require)
  77   ;; isNAN, isFinite, parseFloat, parseInt, eval
  78   ;; decodeURI, decodeURIComponent, encodeURI, encodeURIComponent
  79   ;; Object Function Array String Boolean Number Date RegExp Error EvalError
  80   ;; RangeError ReferenceError SyntaxError TypeError URIError
  81   (module-define! mod 'Object *object-prototype*)
  82   (module-define! mod 'Array *array-prototype*))
  83
  84 (define (js-init)
  85   (cond ((get-this))
  86         (else
  87          (fluid-set! *this* (make <js-global-object>))
  88          (init-js-bindings! (current-module)))))
  89
  90 (define (get-this)
  91   (fluid-ref *this*))
  92
  93 (define (typeof x)
  94   (cond ((eq? x *undefined*) "undefined")
  95         ((null? x) "object")
  96         ((boolean? x) "boolean")
  97         ((number? x) "number")
  98         ((string? x) "string")
  99         ((procedure? x) "function")
 100         ((is-a? x <js-object>) "object")
 101         (else "scm")))
 102
 103 (define bitwise-not lognot)
 104 (define (logical-not x)
 105   (not (->boolean (->primitive x))))
 106
 107 (define shift ash)
 108
 109 (define band logand)
 110 (define bxor logxor)
 111 (define bior logior)
 112
 113 (define mod modulo)
 114
 115 (define-method (+ (a <string>) (b <string>))
 116   (string-append a b))
 117
 118 (define-method (+ (a <string>) b)
 119   (string-append a (->string b)))
 120
 121 (define-method (+ a (b <string>))
 122   (string-append (->string a) b))
 123
 124 (define-method (+ a b)
 125   (+ (->number a) (->number b)))
 126
 127 (define-method (- a b)
 128   (- (->number a) (->number b)))
 129
 130 (define-method (* a b)
 131   (* (->number a) (->number b)))
 132
 133 (define-method (/ a b)
 134   (/ (->number a) (->number b)))
 135
 136 (define-method (< a b)
 137   (< (->number a) (->number b)))
 138 (define-method (< (a <string>) (b <string>))
 139   (string< a b))
 140
 141 (define-method (<= a b)
 142   (<= (->number a) (->number b)))
 143 (define-method (<= (a <string>) (b <string>))
 144   (string<= a b))
 145
 146 (define-method (>= a b)
 147   (>= (->number a) (->number b)))
 148 (define-method (>= (a <string>) (b <string>))
 149   (string>= a b))
 150
 151 (define-method (> a b)
 152   (> (->number a) (->number b)))
 153 (define-method (> (a <string>) (b <string>))
 154   (string> a b))
 155
 156 (define (obj-and-prototypes o)
 157   (if o
 158       (cons o (obj-and-prototypes (js-prototype o)))
 159       '()))
 160
 161 (define (make-enumerator obj)
 162   (let ((props (make-hash-table 23)))
 163     (for-each (lambda (o)
 164                 (for-each (lambda (k) (hashq-set! props k #t))
 165                           (prop-keys o)))
 166               (obj-and-prototypes obj))
 167     (apply new-array (filter (lambda (p)
 168                                (not (prop-has-attr? obj p 'DontEnum)))
 169                              (hash-map->list (lambda (k v) k) props)))))