shithub: femtolisp

Info  •  Files  •  Log  •  Branches

help: cleaner logic; only record doc strings for top level definitions

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

--- a/flisp.boot

+++ b/flisp.boot

@@ -207,7 +207,7 @@

 	    #fn("9000z020210P61:" #(#fn(raise) error) error) eval #fn("7000n170710515160:" #(compile-thunk

   expand) eval)

 	    even? #fn("7000n1200K52El:" #(#fn(logand)) even?) every

-	    #fn("7000n21H;ID0401<51;3:047001=62:" #(every) every) expand #fn("F000n1DDDDDDDDDDD\x8a5\x8a6\x8a7\x8a8\x8a9\x8a:\x8a;\x8a<\x8a=\x8a>\x8a?8520_4862186>1_48722e1_4882385868?87>4_489248?89>2_48:258:>1_48;268:8988>3_48<278?8:8988>4_48=28888?>2_48>29_48?2:8?8>8;8<8=>5_48?<0q62:" #(#fn("7000n20Z;I904200152S:" #(#fn(assq)) top?)

+	    #fn("7000n21H;ID0401<51;3:047001=62:" #(every) every) expand #fn("I000n1DDDDDDDDDDDDD\x8a5\x8a6\x8a7\x8a8\x8a9\x8a:\x8a;\x8a<\x8a=\x8a>\x8a?\x8a@\x8aA8520_4862186>1_48722e1_4882385868A87>4_489248A89>2_48:258:>1_48;268:8988>3_48<27_48=28_48>298=8<8A8:8988>6_48?2:888A>2_48@2;_48A2<8A8@8;8>8?>5_48A<0q62:" #(#fn("7000n20Z;I904200152S:" #(#fn(assq)) top?)

   #fn("8000n10H3400:020d3400:0<B3P07105122CF023A<7405151A<0=5162:0<A<0=51P:" #(((begin)) caar begin

 									       #fn(append) cdar) splice-begin)

   *expanded* #fn("A000n20H3400:A<201523:0F<051@300A<21152873;0728651@30q2324758852152\x8a987IA024269289>28662:D\x8a:8:278:928993>4_48:<^186518:D8;B3c0493<788;51QIC08;92<8;<89<52_@;08;798;51_48;=?;@\xfb/48::" #(begin

@@ -218,10 +218,14 @@

   #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("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("=000\x8730004000\x883000I60O?3482JN070021833@022123083P53@30163:O:" #(putprop *doc* #fn(string)

+									     "\n\n") document)

+  #fn("8000n10<0=208551;3=0486B;350485:" #(#fn(string?)) getdoc)

+  #fn("D000n20=V;I6040TH3q070051J400:0TA<7005151873C0F<868715340=?0@30O4218692<72051152e3:73051740517005193<8651A<885125267789521528:3F0F<878:18654488=?8@30O42521e18794<868;52Pe195<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("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)

--- a/system.lsp

+++ b/system.lsp

@@ -808,25 +808,38 @@

            ,.(expand-body body env)

            . ,name))))

+  (define (document sym doc env (formals #f))

+    (when (null? env)

+      (putprop sym '*doc* (if formals

+                              (string doc "\n\n" (cons sym formals))

+                              doc))))

+

+  (define (getdoc body)

+    (let ((first (car body))

+          (rest  (cdr body)))

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

+

   (define (expand-define e env)

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

         (if (null? (cddr e))

             e

-            (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))))))

+            (let ((name (cadr e))

+                  (doc  (getdoc (cddr e))))

+              (when doc

+                (document name doc env)

+                (set! e (cdr e)))

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

+        (let* ((formals (cdadr e))

+               (name    (caadr e))

+               (body    (cddr e))

+               (vars    (l-vars formals))

+               (doc     (getdoc body))

+               (menv    (nconc (map list vars) env)))

+          (when doc

+            (document name doc env formals)

+            (set! body (cdr body)))

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

+             ,.(expand-body body menv)))))

   (define (expand-let-syntax e env)

     (let ((binds (cadr e)))