allow object literals without values jcubic#185

Author: jcubic

dist/std.min.scm

@@ -18,7 +18,7 @@
 (define (alist->object alist) "(alist->object alist)\u000A\u000AFunction convert alist pairs to JavaScript object." (if (pair? alist) (alist.to_object) (alist->object (new lips.Pair #<undefined> ()))))
 (define (parent.frames) "(parent.frames)\u000A\u000AFuncion return list of environments from parent frames (lambda function calls)" (let iter ((result (quote ())) (frame (parent.frame 1))) (if (eq? frame (interaction-environment)) (cons frame result) (if (null? frame) result (let ((parent.frame (--> frame (get (quote parent.frame) (object :throwError #f))))) (if (function? parent.frame) (iter (cons frame result) (parent.frame 0)) result))))))
 (define (pair-map fn seq-list) "(pair-map fn list)\u000A\u000AFunction call fn argument for pairs in a list and return combined list with\u000Avalues returned from function fn. It work like the map but take two items from list" (let iter ((seq-list seq-list) (result (quote ()))) (if (null? seq-list) result (if (and (pair? seq-list) (pair? (cdr seq-list))) (let* ((first (car seq-list)) (second (cadr seq-list)) (value (fn first second))) (if (null? value) (iter (cddr seq-list) result) (iter (cddr seq-list) (cons value result))))))))
-(define (object-expander readonly expr . rest) "(object-expander reaonly '(:foo (:bar 10) (:baz (1 2 3))))\u000A\u000ARecursive function helper for defining LIPS code for create objects\u000Ausing key like syntax." (let ((name (gensym "name")) (quot (if (null? rest) #f (car rest)))) (if (null? expr) (quasiquote (alist->object ())) (quasiquote (let (((unquote name) (alist->object (quote ())))) (unquote-splicing (pair-map (lambda (key value) (if (not (key? key)) (let ((msg (string-append (type key) " " (repr key) " is not a symbol!"))) (throw msg)) (let ((prop (key->string key))) (if (and (pair? value) (key? (car value))) (quasiquote (set-obj! (unquote name) (unquote prop) (unquote (object-expander readonly value)))) (if quot (quasiquote (set-obj! (unquote name) (unquote prop) (quote (unquote value)))) (quasiquote (set-obj! (unquote name) (unquote prop) (unquote value)))))))) expr)) (unquote (if readonly (quasiquote (Object.freeze (unquote name))))) (unquote name))))))
+(define (object-expander readonly expr . rest) "(object-expander reaonly '(:foo (:bar 10) (:baz (1 2 3))))\u000A(object-expander reaonly '(:foo :bar))\u000A\u000A\u000ARecursive function helper for defining LIPS code for create objects\u000Ausing key like syntax. if no values are used it will create JavaScript\u000Ashorthand objects where keys are used for keys and values" (let ((name (gensym "name")) (quot (if (null? rest) #f (car rest)))) (if (null? expr) (quasiquote (alist->object ())) (quasiquote (let (((unquote name) (alist->object (quote ())))) (unquote-splicing (let loop ((lst expr) (result ())) (if (null? lst) (reverse result) (let ((first (car lst)) (second (if (null? (cdr lst)) () (cadr lst)))) (if (not (key? first)) (let ((msg (string-append (type first) " " (repr first) " is not a symbol!"))) (throw msg)) (let ((prop (key->string first))) (if (or (key? second) (null? second)) (let ((code (quasiquote (set-obj! (unquote name) (unquote prop) #<undefined>)))) (loop (cdr lst) (cons code result))) (let ((code (if (and (pair? second) (key? (car second))) (quasiquote (set-obj! (unquote name) (unquote prop) (unquote (object-expander readonly second)))) (if quot (quasiquote (set-obj! (unquote name) (unquote prop) (quote (unquote second)))) (quasiquote (set-obj! (unquote name) (unquote prop) (unquote second))))))) (loop (cddr lst) (cons code result)))))))))) (unquote (if readonly (quasiquote (Object.freeze (unquote name))))) (unquote name))))))
 (define-macro (object . expr) "(object :name value)\u000A\u000AMacro that create JavaScript object using key like syntax." (try (object-expander #f expr) (catch (e) (error e.message))))
 (define-macro (object-literal . expr) "(object-literal :name value)\u000A\u000AMacro that create JavaScript object using key like syntax. This is similar,\u000Ato object but all values are quoted. This macro is used with & object literal." (try (object-expander #t expr #t) (catch (e) (error e.message))))
 (define (alist->assign desc . sources) "(alist->assign alist . list-of-alists)\u000A\u000AFunction that work like Object.assign but for LIPS alist." (for-each (lambda (source) (for-each (lambda (pair) (let* ((key (car pair)) (value (cdr pair)) (d-pair (assoc key desc))) (if (pair? d-pair) (set-cdr! d-pair value) (append! desc (list pair))))) source)) sources) desc)

dist/std.scm

@@ -265,31 +265,41 @@
 ;; -----------------------------------------------------------------------------
 (define (object-expander readonly expr . rest)
   "(object-expander reaonly '(:foo (:bar 10) (:baz (1 2 3))))
+   (object-expander reaonly '(:foo :bar))
+
 
    Recursive function helper for defining LIPS code for create objects
-   using key like syntax."
+   using key like syntax. if no values are used it will create JavaScript
+   shorthand objects where keys are used for keys and values"
   (let ((name (gensym "name")) (quot (if (null? rest) false (car rest))))
     (if (null? expr)
         `(alist->object ())
         `(let ((,name (alist->object '())))
-           ,@(pair-map (lambda (key value)
-                         (if (not (key? key))
-                             (let ((msg (string-append (type key)
-                                                       " "
-                                                       (repr key)
-                                                       " is not a symbol!")))
-                               (throw msg))
-                             (let ((prop (key->string key)))
-                               (if (and (pair? value) (key? (car value)))
-                                   `(set-obj! ,name
-                                              ,prop
-                                              ,(object-expander readonly value))
-                                    (if quot
-                                        `(set-obj! ,name ,prop ',value)
-                                        `(set-obj! ,name ,prop ,value))))))
-                       expr)
+           ,@(let loop ((lst expr) (result nil))
+               (if (null? lst)
+                   (reverse result)
+                   (let ((first (car lst))
+                         (second (if (null? (cdr lst)) nil (cadr lst))))
+                     (if (not (key? first))
+                         (let ((msg (string-append (type first)
+                                                   " "
+                                                   (repr first)
+                                                   " is not a symbol!")))
+                           (throw msg))
+                         (let ((prop (key->string first)))
+                           (if (or (key? second) (null? second))
+                               (let ((code `(set-obj! ,name ,prop undefined)))
+                                 (loop (cdr lst) (cons code result)))
+                               (let ((code (if (and (pair? second) (key? (car second)))
+                                               `(set-obj! ,name
+                                                          ,prop
+                                                          ,(object-expander readonly second))
+                                               (if quot
+                                                   `(set-obj! ,name ,prop ',second)
+                                                   `(set-obj! ,name ,prop ,second)))))
+                                 (loop (cddr lst) (cons code result)))))))))
            ,(if readonly
-               `(Object.freeze ,name))
+                `(Object.freeze ,name))
            ,name))))
 
 ;; -----------------------------------------------------------------------------

dist/std.xcb

@@ -265,31 +265,41 @@
 ;; -----------------------------------------------------------------------------
 (define (object-expander readonly expr . rest)
   "(object-expander reaonly '(:foo (:bar 10) (:baz (1 2 3))))
+   (object-expander reaonly '(:foo :bar))
+
 
    Recursive function helper for defining LIPS code for create objects
-   using key like syntax."
+   using key like syntax. if no values are used it will create JavaScript
+   shorthand objects where keys are used for keys and values"
   (let ((name (gensym "name")) (quot (if (null? rest) false (car rest))))
     (if (null? expr)
         `(alist->object ())
         `(let ((,name (alist->object '())))
-           ,@(pair-map (lambda (key value)
-                         (if (not (key? key))
-                             (let ((msg (string-append (type key)
-                                                       " "
-                                                       (repr key)
-                                                       " is not a symbol!")))
-                               (throw msg))
-                             (let ((prop (key->string key)))
-                               (if (and (pair? value) (key? (car value)))
-                                   `(set-obj! ,name
-                                              ,prop
-                                              ,(object-expander readonly value))
-                                    (if quot
-                                        `(set-obj! ,name ,prop ',value)
-                                        `(set-obj! ,name ,prop ,value))))))
-                       expr)
+           ,@(let loop ((lst expr) (result nil))
+               (if (null? lst)
+                   (reverse result)
+                   (let ((first (car lst))
+                         (second (if (null? (cdr lst)) nil (cadr lst))))
+                     (if (not (key? first))
+                         (let ((msg (string-append (type first)
+                                                   " "
+                                                   (repr first)
+                                                   " is not a symbol!")))
+                           (throw msg))
+                         (let ((prop (key->string first)))
+                           (if (or (key? second) (null? second))
+                               (let ((code `(set-obj! ,name ,prop undefined)))
+                                 (loop (cdr lst) (cons code result)))
+                               (let ((code (if (and (pair? second) (key? (car second)))
+                                               `(set-obj! ,name
+                                                          ,prop
+                                                          ,(object-expander readonly second))
+                                               (if quot
+                                                   `(set-obj! ,name ,prop ',second)
+                                                   `(set-obj! ,name ,prop ,second)))))
+                                 (loop (cddr lst) (cons code result)))))))))
            ,(if readonly
-               `(Object.freeze ,name))
+                `(Object.freeze ,name))
            ,name))))
 
 ;; -----------------------------------------------------------------------------