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
  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
  38
  39 (define-class <js-global-object> (<js-object>))
  40 (define-method (pget (o <js-global-object>) (p <string>))
  41   (pget o (string->symbol p)))
  42 (define-method (pget (o <js-global-object>) (p <symbol>))
  43   (let ((v (module-variable (current-module) p)))
  44     (if v
  45         (variable-ref v)
  46         (next-method))))
  47 (define-method (pput (o <js-global-object>) (p <string>) v)
  48   (pput o (string->symbol p) v))
  49 (define-method (pput (o <js-global-object>) (p <symbol>) v)
  50   (module-define! (current-module) p v))
  51 (define-method (prop-attrs (o <js-global-object>) (p <symbol>))
  52   (cond ((module-local-variable (current-module) p)
  53          '())
  54         ((module-variable (current-module) p)
  55          '(DontDelete ReadOnly))
  56         (else (next-method))))
  57 (define-method (prop-attrs (o <js-global-object>) (p <string>))
  58   (prop-attrs o (string->symbol p)))
  59
  60 (define (init-js-bindings! mod)
  61   (module-define! mod 'NaN +nan.0)
  62   (module-define! mod 'Infinity +inf.0)
  63   (module-define! mod 'undefined *undefined*)
  64   ;; isNAN, isFinite, parseFloat, parseInt, eval
  65   ;; decodeURI, decodeURIComponent, encodeURI, encodeURIComponent
  66   ;; Object Function Array String Boolean Number Date RegExp Error EvalError
  67   ;; RangeError ReferenceError SyntaxError TypeError URIError
  68   (module-define! mod 'Object *object-prototype*)
  69   (module-define! mod 'Array *array-prototype*))
  70
  71 (define (js-init)
  72   (cond ((get-this))
  73         (else
  74          (fluid-set! *this* (make <js-global-object>))
  75          (init-js-bindings! (current-module)))))
  76
  77 (define (get-this)
  78   (fluid-ref *this*))
  79
  80 (define (typeof x)
  81   (cond ((eq? x *undefined*) "undefined")
  82         ((null? x) "object")
  83         ((boolean? x) "boolean")
  84         ((number? x) "number")
  85         ((string? x) "string")
  86         ((procedure? x) "function")
  87         ((is-a? x <js-object>) "object")
  88         (else "scm")))
  89
  90 (define bitwise-not lognot)
  91 (define (logical-not x)
  92   (not (->boolean (->primitive x))))
  93
  94 (define shift ash)
  95
  96 (define band logand)
  97 (define bxor logxor)
  98 (define bior logior)
  99
 100 (define mod modulo)
 101
 102 (define-method (+ (a <string>) (b <string>))
 103   (string-append a b))
 104
 105 (define-method (+ (a <string>) b)
 106   (string-append a (->string b)))
 107
 108 (define-method (+ a (b <string>))
 109   (string-append (->string a) b))
 110
 111 (define-method (+ a b)
 112   (+ (->number a) (->number b)))