From 6b1b4d57b1863981a0b035d21f3c8681fa665299 Mon Sep 17 00:00:00 2001 From: Jakub Jankiewicz Date: Sat, 23 Mar 2024 20:44:20 +0100 Subject: [PATCH] fix scheme-report-environment procedure --- dist/std.min.scm | 2 +- dist/std.scm | 2 +- dist/std.xcb | Bin 103503 -> 103501 bytes lib/bootstrap.scm | 2 +- 4 files changed, 3 insertions(+), 3 deletions(-) diff --git a/dist/std.min.scm b/dist/std.min.scm index 8004c299a..c96dc0074 100644 --- a/dist/std.min.scm +++ b/dist/std.min.scm @@ -101,7 +101,7 @@ (define (promisify fn) "(promisify fn)\u000A\u000ASimple function for adding promises to NodeJS two-callback based functions.\u000AFunction tested only with fs module." (typecheck "promisify" fn "function") (lambda args (new Promise (lambda (resolve reject) (apply fn (append args (list (lambda (err data) (if (null? err) (resolve data) (reject err)))))))))) (define-macro (list* . args) "(list* arg1 ...)\u000A\u000AParallel asynchronous version of list. Like begin* except all values are returned in a list." (let ((result (gensym "result"))) (quasiquote (let (((unquote result) (vector))) (unquote-splicing (map (lambda (arg) (quasiquote (--> (unquote result) (push (quote-promise (unquote arg)))))) args)) (map await (vector->list (unquote result))))))) (define-macro (%not-implemented name) "(%not-implemented name)\u000A\u000AReturns new function that throws an exception with a message that this function is not implemented." (let ((str-name (symbol->string name))) (quasiquote (lambda () (unquote (string-append "(" str-name ")\u000A\u000AThis function is not yet implemented.")) (throw (new Error (unquote (string-append str-name " has not been implemented")))))))) -(define-macro (%make-env name . names) "(%make-env name f1 f2 ...)\u000A\u000ACreates a new Environment with given name and defined symbols in it from the global env.\u000AIf given function name f1 f2 ... don't exist, it will define them as functions that\u000Athrow exception that function is not yet implemented." (quasiquote (new lips.Environment (alist->object (list (unquote-splicing (map (lambda (name) (quasiquote (cons (quote (unquote name)) (unquote (let ((ref (lips.env.ref name))) (if (null? ref) (quasiquote (%not-implemented (unquote name))) (quasiquote (lips.env.get (quote (unquote name)))))))))) names)))) (new lips.Environment (object :interaction-environment interaction-environment :**interaction-environment** **interaction-environment**) null "root") (unquote name)))) +(define-macro (%make-env name . names) "(%make-env name f1 f2 ...)\u000A\u000ACreates a new Environment with given name and defined symbols in it from the global env.\u000AIf given function name f1 f2 ... don't exist, it will define them as functions that\u000Athrow exception that function is not yet implemented." (quasiquote (new lips.Environment (alist->object (list (unquote-splicing (map (lambda (name) (quasiquote (cons (quote (unquote name)) (unquote (let ((ref (lips.env.ref name))) (if (null? ref) (quasiquote (%not-implemented (unquote name))) (quasiquote (lips.env.get (quote (unquote name)))))))))) names)))) (new lips.Environment (object :interaction-environment interaction-environment :**interaction-environment** **interaction-environment**) #null "root") (unquote name)))) (define Y (lambda (h) "(Y f)\u000A\u000A _ __ __ _ _ _ _ __ __ _ _ _\u000A / \\ \\ / / / __ / ____ \\ / \\ \\ / / ____ \\ \\ \\\u000A+ \\ v / + \\ \\ + / ___| + + \\ v / / ___| + + +\u000A| \\ / | \\ \\ | | |__ | | \\ / | |__ | | |\u000A| | | | / \\ | | __| | | | | | __| | | |\u000A| | | | / /\\ \\ | | | | | | | | | | | |\u000A+ |_| + /_/ \\_\\ + |_| + + |_| |_| + + +\u000A \\_ \\_ \\_ _/ \\_ _/ _/ _/" ((lambda (x) (x x)) (lambda (g) (h (lambda args (apply (g g) args))))))) (define (indexed-db?) "(indexed-db?)\u000A\u000AFunction that tests if IndexedDB is available." (let* ((any (lambda args (let iter ((args args)) (if (null? args) false (if (not (null? (car args))) (car args) (iter (cdr args))))))) (indexedDB (any window.indexedDB window.indexedDB window.mozIndexedDB window.webkitIndexedDB))) (if (not (null? indexedDB)) (try (begin (window.indexedDB.open "IndexedDBExistenceCheck" 3) true) (catch (e) false)) false))) (define (environment? obj) "(environment? obj)\u000A\u000AChecks if object is a LIPS environment." (instanceof lips.Environment obj)) diff --git a/dist/std.scm b/dist/std.scm index 409353cce..07d444c83 100644 --- a/dist/std.scm +++ b/dist/std.scm @@ -1361,7 +1361,7 @@ (new lips.Environment (object :interaction-environment interaction-environment :**interaction-environment** **interaction-environment**) - null "root") + #null "root") ,name)) ;; ----------------------------------------------------------------------------- diff --git a/dist/std.xcb b/dist/std.xcb index f637e126903b007a22091f1b12db4f67a3b287ed..df1a2a0550dcca509ff36c4aaf54aa4c00cbbe0d 100644 GIT binary patch delta 95 zcmX@Vg6-@IHclVUfM5j$LuTiVoac)idn%+eR9G(QH+|#LePEJOl%LP!!6V8e^1wK~ zG_R0dR)F7eC8LPGaau}hT4r7`GcTt|VkD0-2d}+FB1^_iY13xu;_cGKj3$Zz!F(Ks delta 97 zcmV-n0G|KNs0Pod1_?|_P*WfvF#}4m3D0sv+;|&kBm~k3!ej;F3^d?0WO8qB0#6hi z2q3U$b#8G7Bn%@nL9hW7FEeIjWoBt^a|09zIbm50GYAboKVbxD*&95A8FRN8a{)9V D7DFAC diff --git a/lib/bootstrap.scm b/lib/bootstrap.scm index 4e2777749..fb4c288f2 100755 --- a/lib/bootstrap.scm +++ b/lib/bootstrap.scm @@ -1361,7 +1361,7 @@ (new lips.Environment (object :interaction-environment interaction-environment :**interaction-environment** **interaction-environment**) - null "root") + #null "root") ,name)) ;; -----------------------------------------------------------------------------