gneiss: a VM implemented on SQLite, and a working implementation of fizzbuzz for it
This commit is contained in:
parent
6984389fbf
commit
3691299adf
99
gneiss/cpu.fnl
Normal file
99
gneiss/cpu.fnl
Normal 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
34
gneiss/example.fnl
Normal 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])))
|
||||||
|
|
||||||
|
{}
|
Loading…
Reference in a new issue