diff --git a/CHANGELOG.md b/CHANGELOG.md index 50cf9d11c..3c8a273ce 100755 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,7 @@ * fix resolving promises inside quoted promise realm * fix undocumented symbol syntax extensions * fix odd? even? on non integers +* fix object literals with null value [#264](https://github.com/jcubic/lips/issues/264) ## 1.0.0-beta.17 ### Breaking diff --git a/dist/std.min.scm b/dist/std.min.scm index c6b7b0a7f..def08e7b5 100644 --- a/dist/std.min.scm +++ b/dist/std.min.scm @@ -19,7 +19,7 @@ (define (object->alist object) "(object->alist object)\u000A\u000AFunction that converts a JavaScript object to Alist" (typecheck "object->alist" object "object") (vector->list (--> (Object.entries object) (map (lambda (arr) (apply cons (vector->list arr))))))) (define (parent.frames) "(parent.frames)\u000A\u000AReturns the 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 that calls fn argument for pairs in a list and returns a combined list with\u000Avalues returned from function fn. It works likes map but take two items from the list each time." (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 readonly '(:foo (:bar 10) (:baz (1 2 3))))\u000A(object-expander readonly '(:foo :bar))\u000A\u000ARecursive function helper for defining LIPS code to create objects\u000Ausing key like syntax. If no values are used it will create a JavaScript\u000Ashorthand objects where keys are used for keys and the values." (let ((name (gensym "name")) (r-only (gensym "r-only")) (quot (if (null? rest) #f (car rest)))) (if (null? expr) (quasiquote (alist->object ())) (quasiquote (let (((unquote name) (unquote (Object.fromEntries (new Array)))) ((unquote r-only) (unquote (Object.fromEntries (new Array (new Array "writable" #f)))))) (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 readonly (if (and (pair? second) (key? (car second))) (quasiquote (set-obj! (unquote name) (unquote prop) (unquote (object-expander readonly second quot)) (unquote r-only))) (if quot (quasiquote (set-obj! (unquote name) (unquote prop) (quote (unquote second)) (unquote r-only))) (quasiquote (set-obj! (unquote name) (unquote prop) (unquote second) (unquote r-only))))) (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.preventExtensions (unquote name))))) (unquote name)))))) +(define (object-expander readonly expr . rest) "(object-expander readonly '(:foo (:bar 10) (:baz (1 2 3))))\u000A(object-expander readonly '(:foo :bar))\u000A\u000ARecursive function helper for defining LIPS code to create objects\u000Ausing key like syntax. If no values are used it will create a JavaScript\u000Ashorthand objects where keys are used for keys and the values." (let ((name (gensym "name")) (r-only (gensym "r-only")) (quot (if (null? rest) #f (car rest)))) (if (null? expr) (quasiquote (alist->object ())) (quasiquote (let (((unquote name) (unquote (Object.fromEntries (new Array)))) ((unquote r-only) (unquote (Object.fromEntries (new Array (new Array "writable" #f)))))) (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 (key? second) (let ((code (quasiquote (set-obj! (unquote name) (unquote prop) undefined)))) (loop (cdr lst) (cons code result))) (let ((code (if readonly (if (and (pair? second) (key? (car second))) (quasiquote (set-obj! (unquote name) (unquote prop) (unquote (object-expander readonly second quot)) (unquote r-only))) (if quot (quasiquote (set-obj! (unquote name) (unquote prop) (quote (unquote second)) (unquote r-only))) (quasiquote (set-obj! (unquote name) (unquote prop) (unquote second) (unquote r-only))))) (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.preventExtensions (unquote name))))) (unquote name)))))) (define-macro (object . expr) "(object :name value)\u000A\u000ACreates a JavaScript object using key like syntax." (try (object-expander #f expr) (catch (e) (try (error e.message) (catch (e) (console.error e.message)))))) (define-macro (object-literal . expr) "(object-literal :name value)\u000A\u000ACreates a JavaScript object using key like syntax. This is similar,\u000Ato object but all values are quoted. This macro is used by the & object literal." (try (object-expander #t expr #t) (catch (e) (try (error e.message) (catch (e) (console.error e.message)))))) (define (alist->assign desc . sources) "(alist->assign alist . list-of-alists)\u000A\u000AFunction that works like Object.assign but for LIPS alists." (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) diff --git a/dist/std.scm b/dist/std.scm index bbdee4f83..fc84755a4 100644 --- a/dist/std.scm +++ b/dist/std.scm @@ -306,7 +306,7 @@ " is not a symbol!"))) (throw msg)) (let ((prop (key->string first))) - (if (or (key? second) (null? second)) + (if (key? second) (let ((code `(set-obj! ,name ,prop undefined))) (loop (cdr lst) (cons code result))) (let ((code (if readonly diff --git a/dist/std.xcb b/dist/std.xcb index a8d7d888d..b0f1e5d54 100644 Binary files a/dist/std.xcb and b/dist/std.xcb differ diff --git a/lib/bootstrap.scm b/lib/bootstrap.scm index 25383cfa8..46f5247e4 100755 --- a/lib/bootstrap.scm +++ b/lib/bootstrap.scm @@ -306,7 +306,7 @@ " is not a symbol!"))) (throw msg)) (let ((prop (key->string first))) - (if (or (key? second) (null? second)) + (if (key? second) (let ((code `(set-obj! ,name ,prop undefined))) (loop (cdr lst) (cons code result))) (let ((code (if readonly