about summary refs log tree commit diff
diff options
context:
space:
mode:
authorPjotr Prins2023-08-06 10:51:13 +0200
committerPjotr Prins2023-08-06 10:51:13 +0200
commita00edcbc54026ea956ca41029474ff0e6a838616 (patch)
treebe37fe002c23b59626391657a6c56e9665f4e0bd
parentdedcfeee0ce72539f0789923229c54b00f23605d (diff)
downloadgn-guile-a00edcbc54026ea956ca41029474ff0e6a838616.tar.gz
memoize: created separate module
-rw-r--r--gn/cache/memoize.scm33
-rw-r--r--web/.guix-shell2
-rwxr-xr-xweb/webserver.scm37
3 files changed, 41 insertions, 31 deletions
diff --git a/gn/cache/memoize.scm b/gn/cache/memoize.scm
new file mode 100644
index 0000000..e7ccc33
--- /dev/null
+++ b/gn/cache/memoize.scm
@@ -0,0 +1,33 @@
+;; Defines simple memoization functions. Currently it uses an alist -
+;; we should change that to a hash. Also we want the cache to expire
+;; after some time. memoize2 is now a separate function to deal
+;; specifically with two return values. That is not ideal either.
+
+;; Basically lifted from
+;; https://lispdreams.wordpress.com/2016/04/08/lisp-memoization-techniques/
+
+(define-module (gn cache memoize)
+  #:export (memoize
+            memoize2))
+
+(define (memoize f)
+  "Simple memoize just uses alists at this point and does not expire"
+  (let ((result-table '()))
+    (lambda (. args)
+      (let ((cache-value (assoc args (pk result-table))))
+	(if (pk cache-value)
+	    (cdr cache-value)
+	    (let ((result (apply f args)))
+	      (set! result-table
+                    (alist-cons args result result-table)) result))))))
+
+(define (memoize2 f)
+  "Simple memoize functions that returns values pair and uses alists at this point and does not expire"
+  (let ((result-table '()))
+    (lambda (. args)
+      (let ((c (assoc args (pk result-table))))
+	(if (pk c)
+	    (values (car (cdr c)) (car (cdr (cdr c))))
+	    (let-values (((r1 r2) (apply f args)))
+	      (set! result-table
+                    (alist-cons args (list r1 r2) result-table)) (values r1 r2)))))))
diff --git a/web/.guix-shell b/web/.guix-shell
index 2be81ce..7a2f30a 100644
--- a/web/.guix-shell
+++ b/web/.guix-shell
@@ -1,7 +1,7 @@
 #!/bin/bash
 #
 #  run with options '-- ./webserver.scm 8091' e.g.
-#  . .guix-shell -- guile --listen=1970 -e main ./webserver.scm 8091
+#  . .guix-shell -- guile -L .. --listen=1970 -e main ./webserver.scm 8091
 
 echo "Note run: running web-server"
 
diff --git a/web/webserver.scm b/web/webserver.scm
index ce754d8..910024f 100755
--- a/web/webserver.scm
+++ b/web/webserver.scm
@@ -25,31 +25,8 @@
  (web request)
  (web response)
  (web uri)
- (fibers web server))
-
-;; basically lifted from https://lispdreams.wordpress.com/2016/04/08/lisp-memoization-techniques/
-
-(define (memoize f)
-  "Simple memoize just uses alists at this point and does not expire"
-  (let ((result-table '()))
-    (lambda (. args)
-      (let ((cache-value (assoc args (pk result-table))))
-	(if (pk cache-value)
-	    (cdr cache-value)
-	    (let ((result (apply f args)))
-	      (set! result-table 
-                    (alist-cons args result result-table)) result))))))
-
-(define (memoize2 f)
-  "Simple memoize functions that returns values pair and uses alists at this point and does not expire"
-  (let ((result-table '()))
-    (lambda (. args)
-      (let ((c (assoc args (pk result-table))))
-	(if (pk c)
-	    (values (car (cdr c)) (car (cdr (cdr c))))
-	    (let-values (((r1 r2) (apply f args)))
-	      (set! result-table 
-                    (alist-cons args (list r1 r2) result-table)) (values r1 r2)))))))
+ (fibers web server)
+ (gn cache memoize))
 
 (define get-version
   "2.0")
@@ -107,7 +84,7 @@
   ("prefix" . ,(prefix))
   ("links". (("species" . ,(mk-meta "species"))))))
 
-(define info-meta `(		    
+(define info-meta `(
    ("doc" . ,(mk-html "info"))
    ("API" .
     ((,(mk-url "species")."Get a list of all species")
@@ -119,7 +96,7 @@
   "Execute raw SPARQL query returning response as a UTF8 string"
   (bytevector->string (receive (response-status response-body)
                           (http-request (string-append endpoint-url "?default-graph-uri=&query=" (uri-encode query) "&format=application%2Fsparql-results%2Bjson"))
-                         
+
                          response-body) "UTF-8"))
 
 (define (sparql-tsv endpoint-url query)
@@ -201,7 +178,7 @@ SELECT DISTINCT * where {  wd:Q158695 wdt:P225 ?o . } limit 10
 
 "
   (sparql-tsv (wd-sparql-endpoint-url) (string-append "
-SELECT DISTINCT ?taxon ?ncbi ?descr where {  
+SELECT DISTINCT ?taxon ?ncbi ?descr where {
     wd:" species " " (wdt-taxon-name) " ?taxon ;
                wdt:P685 ?ncbi ;
       schema:description ?descr .
@@ -263,7 +240,7 @@ SELECT ?species ?p ?o WHERE {
 (define (get-rows names results)
   "Format results as a list of values ordered by names"
   (map (lambda (row) (get-values names row)) (array->list results)))
-  
+
 ;; from the triples first harvest the species URIs, followed by creating records of information
 
 (define (compile-species recs rows)
@@ -406,7 +383,7 @@ SELECT ?species ?p ?o WHERE {
 	  ;; (display "ThthxST" port)
 	  (format port "~a" "foo")
 	  )))
-  
+
 (define (controller request body)
   (match-lambda
     (('GET)