shithub: femtolisp

Info  •  Files  •  Log  •  Branches

implement (define x "doc string" ...) and (define (f p ...) "doc string" ...)

Doc strings added as props to the symbols.

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

--- a/flisp.boot

+++ b/flisp.boot

@@ -218,11 +218,10 @@

   #fn("7000n10H3600e1:0<B3?070051A<0=51P:0<A<0=51P:" #(caar) l-vars)

   #fn("?000n20T7005171051A<0T5122237489521522225e1F<868:52e192<888:528764:" #(lastcdr cddr #fn(nconc)

 									      #fn(map) list λ) expand-lambda)

-  #fn("?000n20=V;I6040TH3M070051J400:210TA<72051152e3:730517405170051F<730515125267789521522521e18792<868:52Pe193<888:5263:" #(cddr

-  define caddr cdadr caadr #fn(nconc) #fn(map) list) expand-define)

-  #fn("=000n20T20A<71051222324F1>2865215252P:" #(begin cddr #fn(nconc)

-						 #fn(map)

-						 #fn("9000n10<70A<0TF525150Fe3:" #(compile-thunk))) expand-let-syntax)

+  #fn("D000n20=V;I6040TH3{070051J400:0T2172051513P073051B3G0740T25720515340=?0@30O42686A<72051152e3:770517805170051F<7705151292:7;89521522188<513[088=B3T07487252<88<2=8777051P5353488=?8@30O42926e18792<868:52Pe193<888:5263:" #(cddr

+  #fn(string?) caddr cdddr putprop *doc* define cdadr caadr #fn(nconc)

+  #fn(map) list #fn(string) "\n\n") expand-define) #fn("=000n20T20A<71051222324F1>2865215252P:" #(begin

+  cddr #fn(nconc) #fn(map) #fn("9000n10<70A<0TF525150Fe3:" #(compile-thunk))) expand-let-syntax)

   #fn("5000n20:" #() local-expansion-env) #fn("<000n20H3400:0<208615221A10>3873P087=B3I0A<87T0=f2F<72875115262:87;I?0486RS;I60486Z3708860:73051893>0A<890=f2162:8624C400:8625C:092<0162:8625C:092<0162:8626C:093<0162:8627C:094<0162:8860:" #(#fn(assq)

   #fn(":000n0D\x8a48420AF84>3_484<^19261:" #(#fn("8000n10H3400:0<H3700<@90A<0<F5292<0=51P:" #())))

   caddr macrocall? quote λ define let-syntax) expand-in)) expand)

@@ -234,7 +233,10 @@

 	    #fn("9000n382J401:700082<15282=63:" #(foldl) foldl) foldr #fn(":000n382J401:082<700182=5362:" #(foldr) foldr)

 	    get-defined-vars #fn("7000n170A<05161:" #(delete-duplicates) #(#0=(#fn("8000n10H340q:0<20Cj00=B3d00TR;37040Te1;IS040TB;3E0471051R;3:0471051e1;I404q:0<22C?07324A<0=52}2:q:" #(define

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

-	    getprop #fn(":000\x8720003000\x882000I60O?2420A1825387;3<04208708263:" #(#fn(get)) #(#1=#table()))

+	    getprop #fn(":000\x8720003000\x882000I60O?2420A1O5387;3<04208708253;I50482:" #(#fn(get)) #(#1=#table()))

+	    help #fn("=000n10\\3:020051@300717285232425052532662:" #(#fn(function:name) princ

+								     getprop *doc* #fn(string) "no help for "

+								     "\n") 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/flisp.c

+++ b/flisp.c

@@ -2043,9 +2043,17 @@

 {

 	argcount(nargs, 1);

 	value_t v = args[0];

-	if(__unlikely(!isclosure(v)))

-		type_error("function", v);

-	return fn_name(v);

+	if(isclosure(v))

+		return fn_name(v);

+	if(isbuiltin(v))

+		return symbol(builtins[uintval(v)].name, false);

+	if(iscbuiltin(v)){

+		v = (value_t)ptrhash_get(&FL(reverse_dlsym_lookup_table), (cvalue_t*)ptr(v));

+		if(v == (value_t)HT_NOTFOUND)

+			return FL_f;

+		return v;

+	}

+	type_error("function", v);

 }

 BUILTIN("copy-list", copy_list)

--- a/system.lsp

+++ b/system.lsp

@@ -714,8 +714,8 @@

             val)))

   (set! getprop

         (λ (sym key (def #f))

-          (let ((kt (get *properties* key def)))

-            (and kt (get kt sym def)))))

+          (let ((kt (get *properties* key #f)))

+            (or (and kt (get kt sym def)) def))))

   (set! remprop

         (λ (sym key)

           (let ((kt (get *properties* key #f)))

@@ -723,6 +723,12 @@

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

+(define (help e)

+  (let ((name (if (function? e)

+                  (function:name e)

+                  e)))

+  (princ (getprop name '*doc* (string "no help for " e)) "\n")))

+

 (define (macrocall? e) (and (symbol? (car e))

                             (symbol-syntax (car e))))

@@ -806,12 +812,19 @@

     (if (or (null? (cdr e)) (atom? (cadr e)))

         (if (null? (cddr e))

             e

-            `(define ,(cadr e) ,(expand-in (caddr e) env)))

+            (let ((name (cadr e)))

+              (when (and (string? (caddr e)) (cons? (cdddr e)))

+                     (putprop (cadr e) '*doc* (caddr e))

+                     (set! e (cdr e)))

+                   `(define ,name ,(expand-in (caddr e) env))))

         (let ((formals (cdadr e))

               (name    (caadr e))

               (body    (cddr e))

               (vars    (l-vars (cdadr e))))

           (let ((env   (nconc (map list vars) env)))

+            (when (and (string? (car body)) (cons? (cdr body)))

+              (putprop name '*doc* (string (car body) "\n\n" (cons name (cdadr e))))

+              (set! body (cdr body)))

             `(define ,(cons name (expand-lambda-list formals env))

                ,.(expand-body body env))))))