From 3691299adfb288b2a65a5206182fc5de319a9f01 Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Wed, 20 Apr 2022 23:26:16 -0400
Subject: [PATCH] gneiss: a VM implemented on SQLite, and a working
 implementation of fizzbuzz for it

---
 gneiss/cpu.fnl     | 99 ++++++++++++++++++++++++++++++++++++++++++++++
 gneiss/example.fnl | 34 ++++++++++++++++
 2 files changed, 133 insertions(+)
 create mode 100644 gneiss/cpu.fnl
 create mode 100644 gneiss/example.fnl

diff --git a/gneiss/cpu.fnl b/gneiss/cpu.fnl
new file mode 100644
index 0000000..eba7b3c
--- /dev/null
+++ b/gneiss/cpu.fnl
@@ -0,0 +1,99 @@
+(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 ...)))})
+
diff --git a/gneiss/example.fnl b/gneiss/example.fnl
new file mode 100644
index 0000000..a9f09b2
--- /dev/null
+++ b/gneiss/example.fnl
@@ -0,0 +1,34 @@
+(local Cpu (require :gneiss.cpu))
+(local {: show} (require :inspector.debug))
+(local sql (require :diet-sqlite))
+(import-macros {: $ : query : specify} :sqlog.macros)
+
+(sql.shutdown)
+; (sql.register-logger #(print "SQL:" $2 $1))
+
+(local cpu (Cpu))
+
+(macro divisible-by [val denominator]
+  `($ (= (% ,val ,denominator) 0)))
+
+(pp (divisible-by i 3))
+
+(specify cpu.sqlog
+  (table fizzbuzz i fizzbuzz))
+
+(let [pgid (cpu:insert-program ($
+        (do ; 1
+          (!+ [cpu.frame fp :i 1] [cpu.my-fp fp])) ; ideally: (!+ [cpu.frame-var :i 1])
+        (do ;2
+          (!+ [fizzbuzz i (case (when (and ,(divisible-by i 3) ,(divisible-by i 5)) :fizzbuzz)
+                                (when ,(divisible-by i 3) :fizz)
+                                (when ,(divisible-by i 5) :buzz)
+                                (else i))] [cpu.frame-var :i i])
+          (!= [cpu.frame _ _ (+ i 1)] [cpu.frame fp :i i] [cpu.my-fp fp]) ; ideally: (!= [cpu.frame-var :i 1])?
+          (!= [cpu.frame _ _ 1] [cpu.frame fp :$ip _] [cpu.my-fp fp] [cpu.frame-var :i i] (< i 100)))  ; if i < 100 goto 2
+        ,cpu.ret))
+      pid (cpu:initialize-process pgid)]
+  (cpu:run)
+  (show (query cpu.sqlog [fizzbuzz i fizzbuzz])))
+
+{}