# 09sep25 Software Lab. Alexander Burger

(symbols '(llvm))

# (apply 'fun 'lst ['any ..]) -> any
(de _Apply (Exe)
   (let
      (X (cdr Exe)
         E (push NIL $Nil ZERO (eval (++ X)) NIL) )  # [car cdr name fun link]
      (set E (link (ofs E 3) T))
      (let (L (save (eval (car X)))  P E)
         (while (pair (shift X))
            (setq P
               (set 2 P
                  (push NIL $Nil ZERO (eval (car X)) NIL) ) )  # [car cdr name val link]
            (set P (link (ofs P 3))) )
         (while (pair L)
            (stkChk Exe)
            (setq P
               (set 2 P (push NIL $Nil ZERO (++ L) NIL)) )
            (set P (link (ofs P 3))) )
         (evList E) ) ) )

# (pass 'fun ['any ..]) -> any
(de _Pass (Exe)
   (let
      (X (cdr Exe)
         E (push NIL $Nil ZERO (eval (++ X)) NIL) )
      (set E (link (ofs E 3) T))
      (let P E
         (while (pair X)
            (setq P
               (set 2 P
                  (push NIL $Nil ZERO (eval (++ X)) NIL) ) )
            (set P (link (ofs P 3))) )
         (let L (val $Next)
            (while (pair L)
               (setq P
                  (set 2 P (push NIL $Nil ZERO (cdr L) NIL)) )
               (set P (link (ofs P 3)))
               (setq L (car L)) ) ) )
      (evList E) ) )

# (fun 'fun ['any ..]) -> any
(de _Fun (Exe)
   (evList (cdr Exe)) )

# (maps 'fun 'sym ['lst ..]) -> any
(de _Maps (Exe)
   (let
      (X (cdr Exe)
         R $Nil
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3) T))
      (let
         (P E
            Q A
            Sym (save (needSymb Exe (eval (car X))))
            V Sym )
         (set Q V)
         (loop
            (setq P
               (set 2 P (push NIL $Nil ZERO V NIL)) )
            (set P (link (ofs P 3)))
            (? (atom (shift X)))
            (setq
               Q (set 2 Q (push NIL NIL))
               V (save (eval (car X))) )
            (set Q V)
            (when (pair V)
               (setq V (car V)) ) )
         (when (sym? (setq V (val (tail Sym))))
            (dbFetch Exe Sym)
            (setq V (& (val (tail Sym)) -9)) )
         (set 4 (val 2 E)
            (if (pair V) (car V) V) )
         (set A V) )
      (when (pair (car A))
         (loop
            (setq R (evList E))
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      R ) )

# (map 'fun 'lst ..) -> lst
(de _Map (Exe)
   (let
      (X (cdr Exe)
         R $Nil
         E (push NIL $Nil ZERO (eval (car X)) NIL) )
      (set E (link (ofs E 3) T))
      (let P E
         (while (pair (shift X))
            (setq P
               (set 2 P
                  (push NIL $Nil ZERO (eval (car X)) NIL) ) )
            (set P (link (ofs P 3))) ) )
      (loop
         (let P (val 2 E)
            (? (atom (val 4 P)))
            (setq R (evList E))
            (loop
               (when (pair (val 4 P))
                  (set 4 P (cdr @)) )
               (? (atom (shift P))) ) ) )
      R ) )

# (mapc 'fun 'lst ..) -> lst
(de _Mapc (Exe)
   (let
      (X (cdr Exe)
         R $Nil
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3) T))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (setq R (evList E))
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      R ) )

# (maplist 'fun 'lst ..) -> lst
(de _Maplist (Exe)
   (let
      (X (cdr Exe)
         R (save $Nil)
         L 0
         E (push NIL $Nil ZERO (eval (car X)) NIL) )
      (set E (link (ofs E 3)))
      (let P E
         (while (pair (shift X))
            (setq P
               (set 2 P
                  (push NIL $Nil ZERO (eval (car X)) NIL) ) )
            (set P (link (ofs P 3))) ) )
      (loop
         (let P (val 2 E)
            (? (atom (val 4 P)))
            (let Y (cons (evList E) $Nil)
               (setq L
                  (if L
                     (set 2 L Y)
                     (setq R (safe Y)) ) ) )
            (loop
               (when (pair (val 4 P))
                  (set 4 P (cdr @)) )
               (? (atom (shift P))) ) ) )
      R ) )

# (mapcar 'fun 'lst ..) -> lst
(de _Mapcar (Exe)
   (let
      (X (cdr Exe)
         R (save $Nil)
         L 0
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3)))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (let Y (cons (evList E) $Nil)
               (setq L
                  (if L
                     (set 2 L Y)
                     (setq R (safe Y)) ) ) )
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      R ) )

# (mapcon 'fun 'lst ..) -> lst
(de _Mapcon (Exe)
   (let
      (X (cdr Exe)
         R (save $Nil)
         L 0
         E (push NIL $Nil ZERO (eval (car X)) NIL) )
      (set E (link (ofs E 3)))
      (let P E
         (while (pair (shift X))
            (setq P
               (set 2 P
                  (push NIL $Nil ZERO (eval (car X)) NIL) ) )
            (set P (link (ofs P 3))) ) )
      (loop
         (let P (val 2 E)
            (? (atom (val 4 P)))
            (let Y (evList E)
               (when (pair Y)
                  (setq L
                     (if L
                        (let Z L
                           (while (pair (cdr Z))
                              (setq Z @) )
                           (set 2 Z Y) )
                        (setq R (safe Y)) ) ) ) )
            (loop
               (when (pair (val 4 P))
                  (set 4 P (cdr @)) )
               (? (atom (shift P))) ) ) )
      R ) )

# (mapcan 'fun 'lst ..) -> lst
(de _Mapcan (Exe)
   (let
      (X (cdr Exe)
         R (save $Nil)
         L 0
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3)))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (let Y (evList E)
               (when (pair Y)
                  (setq L
                     (if L
                        (let Z L
                           (while (pair (cdr Z))
                              (setq Z @) )
                           (set 2 Z Y) )
                        (setq R (safe Y)) ) ) ) )
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      R ) )

# (filter 'fun 'lst ..) -> lst
(de _Filter (Exe)
   (let
      (X (cdr Exe)
         R (save $Nil)
         L 0
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3)))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (unless (nil? (evList E))
               (let Y (cons (caar A) $Nil)
                  (setq L
                     (if L
                        (set 2 L Y)
                        (setq R (safe Y)) ) ) ) )
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      R ) )

# (extract 'fun 'lst ..) -> lst
(de _Extract (Exe)
   (let
      (X (cdr Exe)
         R (save $Nil)
         L 0
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3)))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (unless (nil? (evList E))
               (let Y (cons @ $Nil)
                  (setq L
                     (if L
                        (set 2 L Y)
                        (setq R (safe Y)) ) ) ) )
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      R ) )

# (seek 'fun 'lst ..) -> lst
(de _Seek (Exe)
   (let
      (X (cdr Exe)
         E (push NIL $Nil ZERO (eval (car X)) NIL) )
      (set E (link (ofs E 3) T))
      (let P E
         (while (pair (shift X))
            (setq P
               (set 2 P
                  (push NIL $Nil ZERO (eval (car X)) NIL) ) )
            (set P (link (ofs P 3))) ) )
      (loop
         (let P (val 2 E)
            (? (atom (val 4 P)) $Nil)
            (? (not (nil? (evList E)))
               (set $At2 @)
               (val 4 P) )
            (loop
               (when (pair (val 4 P))
                  (set 4 P (cdr @)) )
               (? (atom (shift P))) ) ) ) ) )

# (find 'fun 'lst ..) -> any
(de _Find (Exe)
   (let
      (X (cdr Exe)
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3) T))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (if (atom (car A))
         $Nil
         (loop
            (? (not (nil? (evList E)))
               (set $At2 @)
               (caar A) )
            (? (atom (set A (cdar A))) $Nil)
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) ) ) )

# (pick 'fun 'lst ..) -> any
(de _Pick (Exe)
   (let
      (X (cdr Exe)
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3) T))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (if (atom (car A))
         $Nil
         (loop
            (? (not (nil? (evList E))) @)
            (? (atom (set A (cdar A))) $Nil)
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) ) ) )

# (fully 'fun 'lst ..) -> flg
(de _Fully (Exe)
   (let
      (X (cdr Exe)
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3) T))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (if (atom (car A))
         $T
         (loop
            (? (nil? (evList E)) @)
            (? (atom (set A (cdar A))) $T)
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) ) ) )

# (cnt 'fun 'lst ..) -> cnt
(de _Cnt (Exe)
   (let
      (X (cdr Exe)
         R ZERO
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3) T))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (unless (nil? (evList E))
               (inc 'R (hex "10")) )  # Increment count
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      R ) )

# (sum 'fun 'lst ..) -> num
(de _Sum (Exe)
   (let
      (X (cdr Exe)
         R (save ZERO)
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3)))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (when (num? (evList E))
               (save @
                  (setq R (safe (adds R @))) ) )
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      R ) )

# (maxi 'fun 'lst ..) -> any
(de _Maxi (Exe)
   (let
      (X (cdr Exe)
         R $Nil
         R2 (save $Nil)
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3)))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (let Y (evList E)
               (when (gt0 (compare Y R2))
                  (setq R (caar A))
                  (setq R2 (safe Y)) ) )
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      (set $At2 R2)
      R ) )

# (mini 'fun 'lst ..) -> any
(de _Mini (Exe)
   (let
      (X (cdr Exe)
         R $Nil
         R2 (save $T)
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL) )
      (set E (link (ofs E 3)))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (let Y (evList E)
               (when (lt0 (compare Y R2))
                  (setq R (caar A))
                  (setq R2 (safe Y)) ) )
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) ) )
      (set $At2 R2)
      R ) )

(local) fish

(de void fish (E V P R S)
   (set P V)
   (cond
      ((nil? (evList E))
         (when (pair V)
            (stkChk 0)
            (unless (nil? (cdr V))
               (fish E @ P R S) )
            (fish E (car V) P R S) ) )
      ((<> @ S)
         (set R (cons V (val R))) ) ) )

# (fish 'fun 'any ['any2] ..) -> lst
(de _Fish (Exe)
   (let
      (X (cdr Exe)
         R (link (push $Nil NIL) T)
         P (push NIL $Nil ZERO NIL)
         E (push NIL P ZERO (eval (++ X)) NIL) )
      (set
         P (ofs P 3)
         E (link (ofs E 3)) )
      (let
         (V (save (eval (++ X)))
            S (save (eval (car X)))
            Q P )
         (while (pair (shift X))
            (setq Q
               (set 2 Q
                  (push NIL $Nil ZERO (eval (car X)) NIL) ) )  # [car cdr name val link]
            (set Q (link (ofs Q 3))) )
         (fish E V (ofs P 3) R S)
         (val R) ) ) )

# (by 'fun1 'fun2 'lst ..) -> lst
(de _By (Exe)
   (let
      (X (cdr Exe)
         R (save $Nil)
         L 0
         E (push NIL $Nil ZERO (eval (++ X)) NIL)
         A (push NIL NIL)
         Fun2 (save (eval (++ X)))
         A2 A )
      (set E (link (ofs E 3)))
      (let (P E  Q A)
         (loop
            (let V (set Q (save (eval (car X))))
               (when (pair V)
                  (setq V (car V)) )
               (setq P
                  (set 2 P (push NIL $Nil ZERO V NIL)) )
               (set P (link (ofs P 3))) )
            (? (atom (shift X)))
            (setq Q (set 2 Q (push NIL NIL))) ) )
      (when (pair (car A))
         (loop
            (let Y (cons (cons (evList E) (caar A)) $Nil)
               (setq L
                  (if L
                     (set 2 L Y)
                     (setq R (safe Y)) ) ) )
            (? (atom (set A (cdar A))))
            (let (P (val 2 E)  Q A)
               (set 4 P (car @))
               (while (pair (shift P))
                  (set 4 P
                     (cond
                        ((atom (car (shift Q))) @)
                        ((atom (set Q (cdr @))) @)
                        (T (car @)) ) ) ) ) )
         (set 4 E Fun2  4 (val 2 E) R)
         (let Z (setq R (safe (evList E)))
            (loop
               (set Z (cdar Z))
               (? (atom (shift Z))) ) ) )
      R ) )

# Readline
(local) tabComplete

(de i8* tabComplete ((i8* . Text))
   (cond
      ((nil? (val $Complete)) null)
      ((nil?
            (evExe $Complete
               (nond
                  (Text $Nil)
                  ((val Text) $T)
                  (NIL (mkStr Text)) )
               $Nil ) )
         null )
      (T
         (let Nm (name (val (tail (xSym @))))
            (strdup (bufString Nm (b8 (bufSize Nm)))) ) ) ) )
