gneiss: a VM implemented on SQLite, and a working implementation of fizzbuzz for it

This commit is contained in:
Jeremy Penner 2022-04-20 23:26:16 -04:00
parent 6984389fbf
commit 3691299adf
2 changed files with 133 additions and 0 deletions

99
gneiss/cpu.fnl Normal file
View file

@ -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 ...)))})

34
gneiss/example.fnl Normal file
View file

@ -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])))
{}