shithub: femtolisp

Info  •  Files  •  Log  •  Branches

docs: macro documentation, same manner as normal defines

Change (help term) to a macro to get the term as a symbol for free.

References: https://todo.sr.ht/~ft/femtolisp/16

--- a/flisp.boot

+++ b/flisp.boot

@@ -15,9 +15,10 @@

 	      #fn("8000z0700}2:" #(aset!)) 0 0 0 0 0 0 0 0 0 0 0 #fn("9000n3012082>1|:" #(#fn("6000n1A061:" #())))

 	      0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #fn("8000z0700}2:" #(aref)) 0)

 	    *empty-string* "" *properties*

-	    #table(*funvars* #table(help (e))  *doc* #table(help "Display documentation for a function or symbol, if available."))

+	    #table(*funvars* #table(help (term))  *doc* #table(help "Display documentation for the specified term, if available."  *properties* "All properties of symbols recorded with putprop are recorded in this table."))

 	    *runestring-type* (array rune) *string-type* (array byte)

-	    *syntax-environment* #table(when #fn(";000z1200211POe4:" #(if begin))  with-output-to #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)

+	    *syntax-environment* #table(when #fn(";000z1200211POe4:" #(if begin))  help #fn(";000n170021527002252853\\0738551474504863B07450475086P51@30O474504D:73262705152474504O:" #(getprop

+  *doc* *funvars* princ newline print "no help for " #fn(string)))  with-output-to #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)

   with-bindings *output-stream* #fn(copy-list)))  catch #fn("@000n220502112286e123242586e2262786e22829e2e3262:86e20e3e42;86e22<86e2e4e3e3:" #(#fn(gensym)

   trycatch λ if and cons? eq? car quote thrown-value cadr caddr raise))  let* #fn("@000z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)

   λ #fn(copy-list) caar let* cadar))  with-input-from #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)

@@ -33,8 +34,8 @@

   λ #fn(map) #fn("5000n10B3500<:0:" #()) #fn(copy-list)

   #fn("5000n10B3500T:7060:" #(void)) letrec))  with-bindings #fn("G000z12071052207205220230522425e12076888653e12720288687535129242:e12715152242:e127202;8688535152e3e164:" #(#fn(map)

   car cadr #fn("5000n12060:" #(#fn(gensym))) #fn(nconc) let list #fn(copy-list)

-  #fn("7000n22001e3:" #(set!)) unwind-protect begin #fn("7000n22001e3:" #(set!))))  define-macro #fn(">000z120210<e22223e10=e12415153e3:" #(set-syntax!

-  quote #fn(nconc) λ #fn(copy-list)))  receive #fn("?000z22021q1e32221e10e123825153e3:" #(call-with-values

+  #fn("7000n22001e3:" #(set!)) unwind-protect begin #fn("7000n22001e3:" #(set!))))  define-macro #fn("@000z170151863D0710<860=5341=?1@30O422230<e22425e10=e12615153e3:" #(value-get-doc

+  symbol-set-doc set-syntax! quote #fn(nconc) λ #fn(copy-list)))  receive #fn("?000z22021q1e32221e10e123825153e3:" #(call-with-values

   λ #fn(nconc) #fn(copy-list)))  dotimes #fn("A000z10<0T20E2187Ke32223e186e1e12415153e4:" #(for -

   #fn(nconc) λ #fn(copy-list)))  unwind-protect #fn("A000n220502050218722q1e3e2e1232402286e12587e12686e2e3e3e387e1e3e3:" #(#fn(gensym)

   let λ prog1 trycatch begin raise))  throw #fn("9000n220212223e201e4e2:" #(raise list quote

@@ -238,8 +239,6 @@

   caadr begin nconc #fn(map)) #(#0#)))))

 	    getprop #fn(":000\x8720003000\x882000I60O?2420711O5387;3<04208708253;I50482:" #(#fn(get)

   *properties*) getprop)

-	    help #fn("?000n10\\853:020051@3007186225271862352873X0748751475504883C075504768688P51@30O@>074272886515247560:" #(#fn(function:name)

-  getprop *doc* *funvars* princ newline print "no help for " #fn(string)) help)

 	    hex5 #fn("8000n170210r@52r52263:" #(string-lpad #fn(number->string) #\0) hex5) identity

 	    #fn("5000n10:" #() identity) in-env? #fn("7000n21B;3F042001<52;I:047101=62:" #(#fn(assq)

   in-env?) in-env?)

--- a/system.lsp

+++ b/system.lsp

@@ -12,8 +12,12 @@

 (define (symbol-syntax s) (get *syntax-environment* s #f))

 (define-macro (define-macro form . body)

-  `(set-syntax! ',(car form)

-                (λ ,(cdr form) ,@body)))

+  (let ((doc (value-get-doc body)))

+    (when doc

+      (symbol-set-doc (car form) doc (cdr form))

+      (set! body (cdr body)))

+    `(set-syntax! ',(car form)

+                  (λ ,(cdr form) ,@body))))

 (define-macro (letrec binds . body)

   `((λ ,(map car binds)

@@ -727,17 +731,20 @@

   (putprop sym '*doc* doc)

   (if funvars (putprop sym '*funvars* funvars)))

+;; chicken and egg

+(symbol-set-doc

+  '*properties*

+  "All properties of symbols recorded with putprop are recorded in this table.")

+

 (define (value-get-doc body)

   (let ((first (car body))

         (rest  (cdr body)))

     (and (string? first) (cons? rest) first)))

-(define (help e)

-  "Display documentation for a function or symbol, if available."

-  (let* ((func?   (function? e))

-         (name    (if func? (function:name e) e))

-         (doc     (getprop name '*doc*))

-         (funvars (getprop name '*funvars*)))

+(define-macro (help term)

+  "Display documentation for the specified term, if available."

+  (let* ((doc     (getprop term '*doc*))

+         (funvars (getprop term '*funvars*)))

   (if doc

     (begin

       (princ doc)

@@ -744,10 +751,13 @@

       (newline)

       (when funvars

         (newline)

-        (print (cons name funvars))))

+        (print (cons term funvars)))

+      (newline)

+      #t)

     (begin

-      (princ "no help for " (string name))))

-  (newline)))

+      (princ "no help for " (string term))

+      (newline)

+      #f))))

 ; toplevel --------------------------------------------------------------------