module/language/ecmascript/impl.scm

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