diff --git a/Makefile b/Makefile index d84ea29..b41f7c6 100644 --- a/Makefile +++ b/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 diff --git a/retropikzel/docstring.scm b/retropikzel/docstring.scm index 917874a..5d367db 100644 --- a/retropikzel/docstring.scm +++ b/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))))) + diff --git a/retropikzel/docstring.sld b/retropikzel/docstring.sld index 4847503..c479723 100644 --- a/retropikzel/docstring.sld +++ b/retropikzel/docstring.sld @@ -3,7 +3,8 @@ (import (scheme base) (scheme write) (srfi 39)) - (export docstring - doc) + (export doc-string + doc + ) (include "docstring.scm")) diff --git a/retropikzel/docstring/test.scm b/retropikzel/docstring/test.scm index 4ee6392..eb5375c 100644 --- a/retropikzel/docstring/test.scm +++ b/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")