Backup

Makefile

@@ -41,10 +41,9 @@ test: testfiles
 	cd .tmp && ./test-program
 
 test-docker: testfiles
-	cd .tmp && SNOW_PACKAGES="srfi.64 srfi.60 srfi.145 srfi.180 retropikzel.mouth" \
-		APT_PACKAGES="libcurl4-openssl-dev" \
+	cd .tmp && SNOW_PACKAGES="srfi.39 srfi.64 srfi.60 srfi.145 srfi.180 retropikzel.mouth" \
+		APT_PACKAGES="" \
 		COMPILE_R7RS=${SCHEME} \
-		CSC_OPIONS="-L -lcurl" \
 		test-r7rs test.${SFX} ${PKG}
 
 retropikzel/wasm/plus.wasm: retropikzel/wasm/plus.c

retropikzel/docstring.scm

@@ -1,29 +1,22 @@
-(define show-docstring?
-  (make-parameter #f (lambda (x) x)))
+(define return (make-parameter (lambda (x) x) (lambda (x) x)))
 
-(define docstring
+(define doc-string
   (make-parameter
     ""
-    (lambda (str)
-      (if (show-docstring?)
-        (error (string-append "docstring:" str))
-        ""))))
+    (lambda (x)
+      (apply (return) (list x)))))
 
-;; TODO: stop at like 100 arguments, it means the procedure has no docstring
-;; TODO: Change all arguments to procedures that throw errors
-;; TODO: Use eval to run the procedure in empty environment so nothing happens if it does not have docstring?
 (define (doc procedure)
   (letrec*
-    ((looper (lambda (args)
-               (call-with-current-continuation
-                 (lambda (k)
-                   (with-exception-handler
-                     (lambda (x)
-                       (let ((msg (error-object-message x)))
-                         (if (string=? (string-copy msg 0 10) "docstring:")
-                           (k (string-copy msg 10))
-                           (k (looper (cons #t args))))))
-                     (lambda ()
-                       (show-docstring? #t)
-                       (apply procedure args))))))))
-    (looper '())))
+    ((looper
+       (lambda (args cont)
+         (if (> (length args) 100)
+           #f
+           (with-exception-handler
+             (lambda (x)
+               (cont (looper (cons (lambda () (error "" '())) args) cont)))
+             (lambda ()
+               (return cont)
+               (apply procedure args)))))))
+    (call-with-current-continuation (lambda (cont) (looper '() cont)))))
+

retropikzel/docstring.sld

@@ -3,7 +3,8 @@
   (import (scheme base)
           (scheme write)
           (srfi 39))
-  (export docstring
-          doc)
+  (export doc-string
+          doc
+          )
   (include "docstring.scm"))
 

retropikzel/docstring/test.scm

@@ -1,14 +1,21 @@
 ;(test-begin "docstring")
 
-
 (define (plus a b)
-  (docstring "Adds a to b")
+  (doc-string "Add a to b")
   (+ a b))
 
-(plus 1 2)
-(write (doc plus))
+
+(define (minus a b)
+  (- a b))
+
+(write (plus 1 1))
+(newline)
+(display (doc plus))
 (newline)
 
-
+(write (minus 1 1))
+(newline)
+(display (doc minus))
+(newline)
 
 ;(test-end "docstring")