Permalink
Browse files

Added Javascript string => Lisp string code

  • Loading branch information...
1 parent 24941ab commit 3b770c364e8187729a5a94f2bd5faae73eb07dac @gonzojive committed Jul 1, 2010
Showing with 69 additions and 10 deletions.
  1. +20 −4 src/spidermonkey-bindings.lisp
  2. +49 −6 src/util.lisp
@@ -625,19 +625,24 @@
"+JSVAL-TAGBITS+"
"+JSVAL-TAGMASK+"
- ;; JSVAL functions
+ ;; JSVAL predicates
"JSVAL-BOOLEANP"
"JSVAL-DOUBLEP"
"JSVAL-INTP"
"JSVAL-NULLP"
+ "JSVAL-STRINGP"
"JSVAL-OBJECTP"
"JSVAL-VOIDP"
-
+
+ ;; JSVAL more advanced
"JSVAL-FOR-INT"
"JSVAL-TAG"
"JSVAL-TO-INT"
"JSVAL-TO-BOOLEAN"
+ "JSVAL-FOR-BOOLEAN"
+
+ "JSVAL-TO-POINTER"
))
@@ -732,8 +737,8 @@
(cl:defun jsval-intp (jsval)
- (cl:and (cl:= +jsval-int+ (jsval-tag jsval))
- (cl:not (cl:= jsval +jsval-void+))))
+ (cl:and (cl:not (cl:= 0 (cl:logand jsval +jsval-int+)))
+ (cl:not (cl:= jsval +jsval-void+))))
(cl:defun jsval-to-int (jsval)
(cl:declare (cl:type (cl:satisfies jsval-intp) jsval))
@@ -746,6 +751,14 @@
(cl:logior (cl:ash x +jsval-tagbits+)
+jsval-boolean+)))
+ (cl:defun jsval-clear-tag (jsval)
+ (cl:logand jsval (cl:lognot +jsval-tagmask+)))
+
+ (cl:defun jsval-to-pointer (jsval)
+ (cl:let ((address (jsval-clear-tag jsval)))
+ ;; aligned every 2^3 bytes to make this magic happen
+ (cffi:make-pointer address)))
+
;;; predicates for jsval types
(cl:defun jsval-voidp (jsval)
(cl:= jsval +jsval-void+))
@@ -759,6 +772,9 @@
(cl:defun jsval-booleanp (jsval)
(cl:= +jsval-boolean+ (jsval-tag jsval)))
+ (cl:defun jsval-stringp (jsval)
+ (cl:= +jsval-string+ (jsval-tag jsval)))
+
(cl:defun jsval-nullp (jsval)
(cl:= jsval +jsval-null+))
View
@@ -18,12 +18,55 @@
(cffi:mem-ref rval 'smlib:jsval)
(error "Error evaluating script.")))))
-(defun js-value-to-lisp (rval)
+(defun js-value-to-lisp (jsval)
"Given some rval, returns the lisp equivalent value if there is one,
otherwise returns the original value."
- (cffi:with-foreign-object (d :double)
- (smlib:js-value-to-number *js-context*
- (cffi:mem-ref rval 'smlib:jsval)
- d)
+ (let ((explicit (js-value-to-lisp-explicit jsval)))
+ (cond
+ ((eql :void explicit) nil)
+ (t explicit))))
- (cffi:mem-ref d :double))
+(defun js-string-to-lisp (js-string)
+ "Converts a spidermonkey string pointer to a lisp string."
+
+ (let* ((char-array (smlib:js-get-string-chars js-string))
+ (len (smlib:js-get-string-length js-string))
+ (native-string (make-string len)))
+ (loop :for i :from 0 :upto (- len 1)
+ :for jschar = (cffi:mem-aref char-array 'smlib:jschar i)
+ :do (setf (elt native-string i)
+ ;; TODO ensure proper unicode translation
+ (code-char jschar)))
+ native-string))
+
+(defun js-value-to-lisp-explicit (jsval)
+ "Given some rval, returns the lisp equivalent value if there is one,
+otherwise returns the original value."
+ (cond
+ ((smlib:jsval-doublep jsval)
+ (cffi:with-foreign-object (d :double)
+ (if (not (= 0 (smlib:js-value-to-number *js-context*
+ jsval
+ d)))
+ (cffi:mem-ref d :double)
+ (error "Somehow failed to convert a double jsval (Spidermonkey representation) to Lisp."))))
+ ((smlib:jsval-intp jsval)
+ (smlib:jsval-to-int jsval))
+
+
+ ((smlib:jsval-booleanp jsval)
+ (if (= smlib:+jsval-true+ jsval)
+ t
+ nil))
+
+ ((smlib:jsval-stringp jsval)
+ (js-string-to-lisp (smlib:jsval-to-pointer jsval)))
+
+ ((smlib:jsval-nullp jsval)
+ nil)
+
+ ((smlib:jsval-voidp jsval)
+ :void)
+
+ ((smlib:jsval-objectp jsval)
+ (smlib:jsval-to-pointer jsval))))

0 comments on commit 3b770c3

Please sign in to comment.