apply и call

Sergey ShishkinSergey Shishkin
2 min read

Сканируя определения циклов и условных переходов, наткнулся на определение call, а потом вспомнил про apply, определение которого лежит в библиотеке-модуле … короче, в файле с таким же названием - apply.l … а там целая коллекция определений манипулирования типа ”map”, что тоже любопытно и подумал, что можно акцентировать сразу всю группу, что и сделаю в следующеи посте, а эти две функции классифицирую как продолжение предыдущей цепочки “do-make-made-run-exe-eval” … может позже всплывут ещё какие-то “аналогичные аналогии”.

   (NIL "call" _Call)

glob.l

# (call 'any ..) -> flg
(de _Call (Exe)
   (let
      (X (cdr Exe)
         Av (b8* (inc (length X)))
         Cmd (xName (evSym X)) )
      (set Av (pathString Cmd (b8 (pathSize Cmd))))
      (stkChk Exe)
      (let A Av
         (while (pair (shift X))
            (let Nm (xName (evSym X))
               (set (inc 'A)
                  (bufString Nm (b8 (bufSize Nm))) ) )
            (stkChk Exe) )
         (set (inc 'A) null) )
      (flushAll)
      (let
         (Tc (tcgetpgrp 0)
            Fg (and (val Tio) (== Tc (getpgrp))) )
         (cond
            ((lt0 (fork)) (forkErr Exe))
            ((=0 @)  # In child
               (setpgid 0 0)  # Set process group
               (when Fg
                  (tcsetpgrp 0 (getpid)) )
               (execvp (val Av) Av)  # Execute program
               (execErr (val Av)) ) )  # Error if failed
         # In parent
         (let (Pid @  Res (b32 1))
            (setpgid Pid 0)  # Set process group
            (when Fg
               (tcsetpgrp 0 Pid) )
            (loop
               (while (lt0 (waitWuntraced Pid Res))
                  (unless (== (gErrno) EINTR)
                     (err Exe 0 ($ "wait pid") null) )
                  (sigChk Exe) )
               (when Fg
                  (tcsetpgrp 0 Tc) )
               (? (=0 (wifStopped Res))
                  (set $At2 (cnt (i64 (val Res))))
                  (if (val Res) $Nil $T) )
               (repl 0 ($ "+ ") $Nil)
               (when Fg
                  (tcsetpgrp 0 Pid) )
               (kill Pid (val SIGCONT Sig)) ) ) ) ) )

https://picolisp-manual.tiddlyhost.com/#call

   (NIL "apply" _Apply)

glob.l

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

https://picolisp-manual.tiddlyhost.com/#apply

0
Subscribe to my newsletter

Read articles from Sergey Shishkin directly inside your inbox. Subscribe to the newsletter, and don't miss out.

Written by

Sergey Shishkin
Sergey Shishkin

Всегда чему-то учусь!