(local Sqlog (require :sqlog))
(import-macros {: $ : specify : query} :sqlog.macros)

(fn nextval [varname] ($ (+ (coalesce (max ,[:var varname]) 0) 1)))

(local Cpu {})
(fn Cpu.new [self ?filename]
  (set self.sqlog (Sqlog ?filename))
  (set self.instructions [])
  (self:init-new-db))

(fn Cpu.init-new-db [self]
  "Initialize a fresh database with the necessary tables and rules."
  (specify self.sqlog
  ; cpu layout:
    (table cpu.running process-id)
    [cpu.running 0] ; 0 means nothing
    (table cpu.fp process-id frame-id)
    (table cpu.frame frame-id var-id value)
    (table cpu.program program-id instruction-id instruction)
  ; special frame variables:
  ; $result - the anonymous result of the most recent computation (useful?)
  ; $fp-return - the frame-id to return to when finished
  ; $program - the id of the program that the frame is referencing
  ; $ip - the id of the instruction within the program that the process is executing

  ; function calls create a new frame by incrementing cpu.next-fp and populating cpu.frame.
  ; returning from a function call sets the $result of $fp-return to the $result of the current frame,
  ; sets cpu.fp for the current process to $fp-return, and removes all data from cpu.frame with the current frame ID.
    (table compiler.sourcemap program-id instruction-id filename position)

    (* [cpu.next-process ,(nextval :process-id)] [cpu.fp process-id _])
    (* [cpu.next-fp ,(nextval :frame-id)] [cpu.frame frame-id _ _])
    (* [cpu.next-program-id ,(nextval :program-id)] [cpu.program program-id _ _ _])
    (* [cpu.next-instruction-id program-id ,(nextval :instruction-id)] [cpu.program program-id instruction-id _ _])
    (* [cpu.next-instruction-id next-program-id 1] [cpu.next-program-id next-program-id])
    (* [cpu.frame-var var-id value] [cpu.running process-id] [cpu.fp process-id frame-id] [cpu.frame frame-id var-id value])
    (* [cpu.my-fp fp] [cpu.running pid] [cpu.fp pid fp])
    (* [cpu.ip program-id ip] [cpu.frame-var :$ip ip] [cpu.frame-var :$program program-id])
    (* [cpu.instruction instruction] [cpu.ip program-id ip] [cpu.program program-id ip instruction])
    (* [cpu.return-fp fp] [cpu.frame-var :$fp-return fp])

  ; frame 1 destroys all processes that enter it (program 1 will implement this logic)
    [cpu.frame 1 :$ip 1]
    [cpu.frame 1 :$program 1])

  ; define program 1 for frame 1
  (self:insert-program ($
    (!- [cpu.fp _ 1])
    (!= [cpu.frame _ _ 0] [cpu.frame 1 :$ip _])))  ; this shouldn't be needed

  (set self.ret
       (self:def-instruction
         ($ (!= [cpu.fp _ fp-return] [cpu.fp pid _] [cpu.running pid] [cpu.return-fp fp-return])))))

(fn Cpu.def-instruction [self ...]
  "Creates a new reusable instruction and returns its ID"
  (let [analysis (self.sqlog:compile-action [:do ...])]
    (table.insert self.instructions analysis)
    (length self.instructions)))

(fn Cpu.insert-program [self ...]
  "Creates a new program with the specified instructions"
  (let [[{: program-id}] (query self.sqlog [cpu.next-program-id program-id])]
    (each [ip action (ipairs [...])]
      (let [instruction (if (not= (type action) :table) action (self:def-instruction action))]
        (specify self.sqlog [cpu.program #program-id #ip #instruction])))
    program-id))

(fn Cpu.initialize-process [self program-id]
  "Creates a new process, starting at the beginning of the specified program"
  (let [[{: process-id : fp}] (query self.sqlog [cpu.next-process process-id] [cpu.next-fp fp])]
    (specify self.sqlog
      (!+ [cpu.fp #process-id #fp])
      (!+ [cpu.frame #fp :$program #program-id])
      (!+ [cpu.frame #fp :$ip 1])
      (!+ [cpu.frame #fp :$fp-return 1]))))

(fn Cpu.process-round [self]
  "Executes each currently-active process until it hits a suspend instruction or is removed."
  (let [process-ids (query self.sqlog [cpu.fp process-id _])]
    (each [_ {: process-id} (ipairs process-ids)]
      (specify self.sqlog (!= [cpu.running #process-id] [cpu.running _]))
      (var done false)
      (while (not done)
        (let [[instruction-result] (query self.sqlog [cpu.instruction instruction])
              {: instruction}      (or instruction-result {})
              action               (and instruction (. self.instructions instruction))]
          (if (= action nil)              (set done true)
              (= (type action) :function) (action self)
            (self.sqlog:execute action))
          (specify self.sqlog (!= [cpu.frame _ _ (+ ip 1)] [cpu.frame fp :$ip ip] [cpu.fp #process-id fp])))))
    (specify self.sqlog (!= [cpu.running 0] [cpu.running _]))
    process-ids))

(fn Cpu.run [self] (while (> (length (self:process-round)) 0)))

(setmetatable Cpu {:__call (fn [cls ...] (doto (setmetatable {} {:__index cls}) (: :new ...)))})