From 736783c607681c188e9975ef97ff7b6149f9213d Mon Sep 17 00:00:00 2001 From: Cor Legemaat Date: Fri, 17 Oct 2025 13:18:09 +0200 Subject: [PATCH] Fix alter. Prevent select from returning illegal alist if association not found. Change source folder and update live make target. --- Makefile.am | 6 ++++-- configure.ac | 2 +- dql/Makefile.am | 2 +- dql/dql.scm | 47 +++++++++++++++++++++++------------------------ 4 files changed, 29 insertions(+), 28 deletions(-) diff --git a/Makefile.am b/Makefile.am index 4993ec7..5104dd7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -25,6 +25,7 @@ dist_doc_DATA = \ INSTALL \ NEWS +# To use README.org instead of README. README: README.org AUTHORS: @@ -40,8 +41,9 @@ release-tag: $(shell git push origin "v$(VERSION)") live: - mkdir -p /usr/share/guile/site/dql - mount --bind -o ro dql /usr/share/guile/site/dql/ + sudo mkdir -p $(datadir)/guile/site/$(GUILE_EFFECTIVE_VERSION)/dql + sudo mount --bind -o ro dql \ + $(datadir)/guile/site/$(GUILE_EFFECTIVE_VERSION)/dql/ # Remove doc directory on uninstall uninstall-local: diff --git a/configure.ac b/configure.ac index 98429f3..81c2ee6 100644 --- a/configure.ac +++ b/configure.ac @@ -16,7 +16,7 @@ scheme-dql. If not, see . m4_define([version_major], [0]) m4_define([version_minor], [0]) -m4_define([version_revision], [0]) +m4_define([version_revision], [1]) AC_PACKAGE_URL([http://www.cor.za.net/code/scheme-dql]) AC_INIT(scheme-dql, diff --git a/dql/Makefile.am b/dql/Makefile.am index 4143f08..855db3f 100644 --- a/dql/Makefile.am +++ b/dql/Makefile.am @@ -37,7 +37,7 @@ EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) CLEANFILES = $(GOBJECTS) GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat -GUILE_OPTS = -L $(abs_top_builddir)/src +GUILE_OPTS = -L $(abs_top_builddir)/dql SUFFIXES = .scm .go .scm.go: $(GUILD) compile $(GUILE_TARGET) $(GUILE_OPTS) $(GUILE_WARNINGS) -o "$@" "$<" diff --git a/dql/dql.scm b/dql/dql.scm index b9d2dac..6c5ad93 100644 --- a/dql/dql.scm +++ b/dql/dql.scm @@ -270,6 +270,7 @@ syntax is fixed from SQL like how irregex fixed regular expressions. `(set! ,entry (assoc-remove! ,entry ,(second parm)))) + ((eq? (car parm) 'where) #f) (else (error (string-append "Illegal parameter \"" (symbol->string (car parm)) "\" for alter"))))))) @@ -279,19 +280,19 @@ syntax is fixed from SQL like how irregex fixed regular expressions. (if (first-parm-other (cdr query) 'where) #t - (dql-boolean-where 'where + (dql-boolean-where 'and (cadr query) entry)) (if (first-parm-other query 'where) #t - (dql-boolean-where 'where - (car query) + (dql-boolean-where 'and + (list (car query)) entry)))) (list (append (list 'begin) - (map parm->code - (if fpo - (cdr query) - query)))))) + (filter-map parm->code + (if fpo + (cdr query) + query)))))) (list entry)) (dql-data->list ,(if fpo (map-query-symbols (car query) data) @@ -301,7 +302,7 @@ syntax is fixed from SQL like how irregex fixed regular expressions. (lambda (query data) "Function to return the code that will select a subsections of the associations of the alist data entries based on the @code{parm}, - @code{parm-as} and @code{parm-val} rules of the query. + and @code{parm-as} rules of the query. @strong{query} (dql-query): The query to generate the code for. @@ -312,7 +313,9 @@ syntax is fixed from SQL like how irregex fixed regular expressions. @strong{return} (code): The code that will process the data according to the query." (let* ((fpo (first-parm-other query 'parm 'parm-as 'parm-val)) - (entry (gensym)) + (entry (gensym)) + (answ (gensym)) + (responce (gensym)) (parm->code (lambda (parm) (cond ((eq? (car parm) 'parm) @@ -322,25 +325,21 @@ syntax is fixed from SQL like how irregex fixed regular expressions. ,(if (null? rest-parms) entry (path-val rest-parms - entry))))) + entry))))) ((eq? (car parm) 'parm-as) - `(cons ,(car (cdr parm)) - ,(path-val (cdr (cdr parm)) - entry))) - ((eq? (car parm) 'parm-val) - (let ((last-parm (last parm)) - (rest-parms (drop-right (cdr parm) 1))) - `(assoc-ref ,(if (null? rest-parms) - entry - (path-val rest-parms - entry)) - ,last-parm))) + `(let ((,answ ,(path-val (cdr (cdr parm)) + entry))) + (if ,answ + (cons ,(car (cdr parm)) + ,answ) + #f))) (else (error "Illegal parameter for select.")))))) `(map (lambda (,entry) - ,(append (list 'list) - (map parm->code - (if fpo (cdr query) query)))) + (filter-map (lambda (,responce) ,responce) + ,(append (list 'list) + (map parm->code + (if fpo (cdr query) query))))) (dql-data->list ,(if fpo (map-query-symbols (car query) data) data))))))