Eliminate the last few differences between bel.bel and Language::Bel::Globals::Source

[masak]

I hardly noticed it happening, but we're at 100% globals implementation now. It's time to think about retiring Globals/Source.pm altogether.

So I did a quick diff:

$ diff -U2 pg/bel.bel lib/Language/Bel/Globals/Source.pm
--- pg/bel.bel	2020-09-25 17:34:10.000000000 +0800
+++ lib/Language/Bel/Globals/Source.pm	2021-04-11 20:16:03.000000000 +0800
@@ -1,5 +1,10 @@
-; Bel in Bel. 9 October 2019, 9:14 GMT
+package Language::Bel::Globals::Source;
 
+use 5.006;
+use strict;
+use warnings;
 
+1;
+__DATA__
 (def no (x)
   (id x nil))
@@ -291,5 +296,5 @@
   (aif (binding 'err s)
        (applyf (cdr it) (list msg) nil s r m)
-       (err 'no-err)))
+       (err msg)))
 
 (mac fu args
@@ -318,9 +323,8 @@
          ps (parameters (car parms)))
     `(fn ,v
-       (eif ,w (apply (fn ,(car parms) (list ,@ps))
+       (let ,w (apply (fn ,(car parms) (list ,@ps))
                       (car ,v))
-               (apply sigerr 'bad-form (cddr ,v))
-               (let ,ps ,w
-                 (let ,(cdr parms) (cdr ,v) ,@body))))))
+         (let ,ps ,w
+           (let ,(cdr parms) (cdr ,v) ,@body))))))
 
 (def parameters (p)
@@ -507,5 +511,6 @@
            (with (a (car args)
                   b (cadr args))
-             (eif v (case f
+             ; eif v
+             (let v (case f
                       id   (id a b)
                       join (join a b)
@@ -524,5 +529,5 @@
                       coin (coin)
                       sys  (sys a))
-                    (sigerr v s r m)
+                  ; (sigerr v s r m)
                     (mev s (cons v r) m))))
        (sigerr 'unknown-prim s r m)))
@@ -1317,54 +1322,56 @@
 
 (mac bquote (e)
-  (let (sub change) (bqex e nil)
-    (if change sub (list 'quote e))))
+  ((list 'lit 'clo scope '((sub change))
+     '(if change sub (list 'quote e)))
+   (bqex e nil)))
 
 (def bqex (e n)
   (if (no e)   (list nil nil)
       (atom e) (list (list 'quote e) nil)
-               (case (car e)
-                 bquote   (bqthru e (list n) 'bquote)
-                 comma    (if (no n)
-                              (list (cadr e) t)
-                              (bqthru e (car n) 'comma))
-                 comma-at (if (no n)
-                              (list (list 'splice (cadr e)) t)
-                              (bqthru e (car n) 'comma-at))
-                          (bqexpair e n))))
+               (if (id (car e) 'bquote)   (bqthru e (list n) 'bquote)
+                   (id (car e) 'comma)    (if (no n)
+                                              (list (cadr e) t)
+                                              (bqthru e (car n) 'comma))
+                   (id (car e) 'comma-at) (if (no n)
+                                              (list (list 'splice (cadr e)) t)
+                                              (bqthru e (car n) 'comma-at))
+                                          (bqexpair e n))))
 
 (def bqthru (e n op)
-  (let (sub change) (bqex (cadr e) n)
-    (if change
-        (list (if (caris sub 'splice)
-                  `(cons ',op ,(cadr sub))
-                  `(list ',op ,sub))
-              t)
-        (list (list 'quote e) nil))))
+  ((list 'lit 'clo scope '((sub change))
+     '(if change
+          (list (if (caris sub 'splice id)
+                    (list 'cons (list 'quote op) (cadr sub))
+                    (list 'list (list 'quote op) sub))
+                t)
+          (list (list 'quote e) nil)))
+   (bqex (cadr e) n)))
 
 (def bqexpair (e n)
-  (with ((a achange) (bqex (car e) n)
-         (d dchange) (bqex (cdr e) n))
-    (if (or achange dchange)
-        (list (if (caris d 'splice)
-                  (if (caris a 'splice)
-                      `(apply append (spa ,(cadr a)) (spd ,(cadr d)))
-                      `(apply cons ,a (spd ,(cadr d))))
-                  (caris a 'splice)
-                  `(append (spa ,(cadr a)) ,d)
-                  `(cons ,a ,d))
-              t)
-        (list (list 'quote e) nil))))
+  ((list 'lit 'clo scope '((a achange) (d dchange))
+     '(if (if achange t dchange)
+          (list (if (caris d 'splice id)
+                    (if (caris a 'splice id)
+                        (list 'apply 'append (list 'spa (cadr a))
+                                             (list 'spd (cadr d)))
+                        (list 'apply 'cons a (list 'spd (cadr d))))
+                    (caris a 'splice id)
+                    (list 'append (list 'spa (cadr a)) d)
+                    (list 'cons a d))
+                t)
+          (list (list 'quote e) nil)))
+   (bqex (car e) n)
+   (bqex (cdr e) n)))
 
 (def spa (x)
-  (if (and x (atom x))
+  (if (if x (atom x))
       (err 'splice-atom)
       x))
 
 (def spd (x)
-  (pcase x
-    no   (err 'splice-empty-cdr)
-    atom (err 'splice-atom)
-    cdr  (err 'splice-multiple-cdrs)
-         x))
+  (if (no x)   (err 'splice-empty-cdr)
+      (atom x) (err 'splice-atom)
+      (cdr x)  (err 'splice-multiple-cdrs)
+               x))
 
 (mac comma args
@@ -1626,7 +1633,8 @@
   (if (<= n 2) 1 (inc:clog2 (/ n 2))))
 
-(def randlen (n)
-  (read (list (nof n (if (coin) \0 \1)))
-        2))
+(def randlen (n)        ; temporary implementation -- missing `read`
+  (foldl (fn (c s) (+ (* 2 s) c))
+         0
+         (nof n (if (coin) 0 1))))
 
 (def rand (n|pint)
@@ -1800,2 +1808,3 @@
                     (err 'inst-nontable))))
 
+(def err args)

What I see there in terms of differences:

• A fix to sigerr (because I believe the original is wrong)
• An old avoidance of eif in formfn (which we should be able to ditch now, and add a test for)
• An old avoidance of eif in applyprim (ditto)
• An old avoidance of sigerr in applyprim (ditto)
• Lots of fixes to the bquote family (which is circular otherwise)
• An old avoidance of read in randlen
• An extra err definition which doesn't really belong in Source at all

I think we should be able to fix these one by one, and then completely decommision the Source module (using pg/bel.bel straight off instead).