# 20jul24 Software Lab. Alexander Burger
# pil @lib/lifo.l --symbols lifo -go

(symbols 'lifo 'pico)

# Globals (without '*')
(local) (IP SP RP Word)

# Interpreter
(local) (E F X eval exe lifo:)

(de eval (Word)
   (nond
      ((sym? Word) (push 'SP Word))
      ((val Word) (quit (pack Word " is unknown")))
      ((== @ Word) (pico~eval @))
      (NIL (push 'SP Word)) ) )

(de lifo: E
   (push 'RP IP)
   (setq IP E)
   (while IP
      (eval (++ IP)) )
   (setq IP (++ RP)) )

(de exe (E)
   (if (atom E) (eval E) . `(cdr lifo:)) )

# Read/Eval Loop
(local) go

(de go ()
   (while (opt)
      (in @
         (while (read)
            (eval @) ) ) )
   (loop
      (catch '(NIL)
         (eval (prompt "-- " (read))) )
      (when @@
         (tty (prinl *Msg)) ) ) )

# Primitives
(local) (dup swap drop over)

(de dup  # any -- any any
   push 'SP (car SP) )

(de swap  # any1 any2 -- any2 any1
   xchg SP (cdr SP) )

(de drop  # any --
   ++ SP )

(de over  # any1 any2 -- any1 any2 any1
   push 'SP (cadr SP) )

(local) (+ 1+ - 1- * / */)

(de +  # num1 num2 -- num
   inc (cdr SP) (++ SP) )

(de 1+  # num -- num
   inc SP )

(de -  # num1 num2 -- num
   dec (cdr SP) (++ SP) )

(de 1-  # num -- num
   dec SP )

(de *  # num1 num2 -- num
   set (cdr SP) (pico~* (cadr SP) (++ SP)) )

(de /  # num1 num2 -- num
   set (cdr SP) (pico~/ (cadr SP) (++ SP)) )

(de */  # num1 num2 num3 -- num
   prog
      (set (cddr SP)
         (pico~*/  (caddr SP) (cadr SP) (++ SP)) )
      (++ SP) )

(local) (== = <= < >= >)

(de ==  # any1 any2 -- flg
   set (cdr SP) (pico~== (cadr SP) (++ SP)) )

(de =  # any1 any2 -- flg
   set (cdr SP) (pico~= (cadr SP) (++ SP)) )

(de <=  # any1 any2 -- flg
   set (cdr SP) (pico~<= (cadr SP) (++ SP)) )

(de <  # any1 any2 -- flg
   set (cdr SP) (pico~< (cadr SP) (++ SP)) )

(de >=  # any1 any2 -- flg
   set (cdr SP) (pico~>= (cadr SP) (++ SP)) )

(de >  # any1 any2 -- flg
   set (cdr SP) (pico~> (cadr SP) (++ SP)) )

(local) (& |)

(de &  # any any -- flg
   set (cdr SP) (and (cadr SP) (++ SP)) )

(de |  # any any -- flg
   set (cdr SP) (or (cadr SP) (++ SP)) )

(local) (Cond if elif else while until for)

(de if  # flg -- : exe
   pico~ifn (setq Cond (++ SP))
      (or (++ IP) (read))
      (exe (or (++ IP) (read)))
      (on Cond) )

(de elif  # exe -- : exe
   pico~if Cond
      (++ SP)
      (exe (++ SP))
      (pico~ifn (setq Cond (++ SP))
         (or (++ IP) (read))
         (exe (or (++ IP) (read)))
         (on Cond) ) )

(de else  # -- : exe
   pico~if Cond
      (or (++ IP) (read))
      (exe (or (++ IP) (read))) )

(de while  # exe -- : exe
   let (E (++ SP)  F (or (++ IP) (read)))
      (pico~loop
         (exe E)
         (NIL (++ SP))
         (exe F) ) )

(de until  # exe -- : exe
   let (E (++ SP)  F (or (++ IP) (read)))
      (pico~loop
         (exe E)
         (T (++ SP))
         (exe F) ) )

(de for  # num|lst -- : exe
   let E (or (++ IP) (read))
      (pico~for X (++ SP)
         (push 'SP X)
         (exe E) ) )

(local) (mapc mapcar)

(de mapc  # lst -- : exe
   let E (or (++ IP) (read))
      (pico~mapc
         '((X) (push 'SP X) (exe E))
         (++ SP) ) )

(de mapcar  # lst -- lst : exe
   let E (or (++ IP) (read))
      (push 'SP
         (pico~mapcar
            '((X)
               (push 'SP X)
               (exe E)
               (++ SP) )
            (++ SP) ) ) )

(local) (p s : ; see vi load lisp bye)

(de p  # any --
   prog
      (printsp (++ SP))
      (flush) )

(de s  # --
   prog
      (do (length SP)
         (printsp (car (rot SP))) )
      (flush) )

(de :  # -- any : any
   push 'SP (or (++ IP) (read)) )

(de ;  # sym exe --
   prog
      (def (cadr SP) (++ SP))
      (++ SP) )

(de see  # -- : sym
   let X (or (++ IP) (read))
      (println ': X (val X) ';) )

(de vi  # -- : sym
   pico~vi (or (++ IP) (read)) )

(de load  # any --
   pico~in (++ SP)
      (pico~while (read)
         (eval @) ) )

(de lisp  # any -- any
   set SP (pico~eval (car SP)) )

(de bye  # -- <void>
   pico~bye )

# Debug
`*Dbg

(local) bench

(de bench  # any --
   pico~bench
      (exe (++ SP)) )