Commit | Line | Data |
---|---|---|
131f7d6c AW |
1 | ;;; ECMAScript for Guile |
2 | ||
3 | ;; Copyright (C) 2009 Free Software Foundation, Inc. | |
4 | ||
53befeb7 NJ |
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 | |
131f7d6c AW |
18 | |
19 | ;;; Code: | |
20 | ||
21 | (define-module (language ecmascript impl) | |
10e1bd27 | 22 | #:use-module (oop goops) |
e80ce73d AW |
23 | #:use-module (language ecmascript base) |
24 | #:use-module (language ecmascript function) | |
25 | #:use-module (language ecmascript array) | |
785fb107 | 26 | #:re-export (*undefined* *this* call/this* |
b358fe65 | 27 | pget pput pdel has-property? |
af6c20b7 | 28 | ->boolean ->number |
3bef3ae4 | 29 | new-object new new-array) |
8c306808 | 30 | #:export (js-init get-this |
b358fe65 AW |
31 | typeof |
32 | bitwise-not logical-not | |
33 | shift | |
34 | mod | |
e05320fa AW |
35 | band bxor bior |
36 | make-enumerator)) | |
b358fe65 | 37 | |
131f7d6c | 38 | |
143177ed | 39 | (define-class <js-module-object> (<js-object>) |
e05320fa | 40 | (module #:init-form (current-module) #:init-keyword #:module |
143177ed AW |
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>)) | |
e05320fa AW |
54 | (cond ((module-local-variable (js-module o) p) '()) |
55 | ((module-variable (js-module o) p) '(DontDelete ReadOnly)) | |
143177ed AW |
56 | (else (next-method)))) |
57 | (define-method (prop-attrs (o <js-module-object>) (p <string>)) | |
58 | (prop-attrs o (string->symbol p))) | |
e05320fa AW |
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))) | |
143177ed AW |
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 | ||
e05320fa AW |
68 | (define-class <js-global-object> (<js-module-object>)) |
69 | (define-method (js-module (o <js-global-object>)) | |
70 | (current-module)) | |
71 | ||
8c306808 AW |
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*) | |
143177ed | 76 | (module-define! mod 'require js-require) |
8c306808 AW |
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 | ||
785fb107 AW |
90 | (define (get-this) |
91 | (fluid-ref *this*)) | |
a2879878 AW |
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"))) | |
b358fe65 AW |
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) | |
8c306808 AW |
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))) | |
af6c20b7 AW |
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)) | |
e05320fa AW |
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))))) |