From 2822774931ade398654b15f50246971b33650f45 Mon Sep 17 00:00:00 2001
From: Emin Arslan <me@emin.engineer>
Date: Sat, 25 Apr 2026 00:08:54 +0300
Subject: [PATCH] vm: modified the vm to include native procedures, and changed
 the order of some parameters

---
 lib/vm/native.ml | 19 +++++++++++++++++++
 lib/vm/types.ml  | 38 ++++++++++++++++++++++++++++++++++++++
 lib/vm/vm.ml     | 46 ++++++++++------------------------------------
 3 files changed, 67 insertions(+), 36 deletions(-)
 create mode 100644 lib/vm/native.ml
 create mode 100644 lib/vm/types.ml

diff --git a/lib/vm/native.ml b/lib/vm/native.ml
new file mode 100644
index 0000000..4b30927
--- /dev/null
+++ b/lib/vm/native.ml
@@ -0,0 +1,19 @@
+
+(* This file implements native functions of the VM runtime.
+   Stuff like printing to the screen, file I/O etc will be implemented
+   here.
+ *)
+
+open Types
+
+let builtin_print (v : value) =
+  ignore v;
+  Nil
+
+let table = [|
+    builtin_print
+  |]
+
+
+
+  
diff --git a/lib/vm/types.ml b/lib/vm/types.ml
new file mode 100644
index 0000000..58bb0ba
--- /dev/null
+++ b/lib/vm/types.ml
@@ -0,0 +1,38 @@
+
+type value =
+  | Int of int
+  | Double of float
+  | String of string
+  | Nil
+  | Cons of value * value
+  | Symbol of string
+  | Closure of int * value ref list
+  | Native of int (* This is basically a syscall, each ID represents a primitive operation
+                     that should have a well-defined effect. These will be further detailed
+                     in the language documentation
+                   *)
+
+type instr =  
+  | Constant of int
+  | LoadLocal of int
+  | LoadGlobal of int
+  | StoreLocal of int
+  | StoreGlobal of int
+  | MakeCons
+  | Pop (* discards top of stack *)
+  | Apply
+  | MakeClosure of int
+  | Jump of int
+  | JumpF of int (* jump if false. *)
+  | End
+
+type vm_state = {
+    mutable i : int;
+    instrs : instr array;
+    globals : value array;
+    constants : value array;
+    mutable env : value ref list;
+    mutable stack : value list
+  }
+
+(* TODO: add facilities to print the VM state in case of errors. *)
diff --git a/lib/vm/vm.ml b/lib/vm/vm.ml
index a0a3582..676b440 100644
--- a/lib/vm/vm.ml
+++ b/lib/vm/vm.ml
@@ -1,37 +1,7 @@
 
-type value =
-  | Int of int
-  | Double of float
-  | String of string
-  | Nil
-  | Cons of value * value
-  | Symbol of string
-  | Closure of int * value ref list
-  | NativeClosure of (value -> value)
+module Types = Types
+open Types
 
-type instr =  
-  | Constant of int
-  | LoadLocal of int
-  | LoadGlobal of int
-  | StoreLocal of int
-  | StoreGlobal of int
-  | Pop (* discards top of stack *)
-  | Apply
-  | MakeClosure of int
-  | Jump of int
-  | JumpF of int (* jump if false. *)
-  | End
-
-type vm_state = {
-    mutable i : int;
-    instrs : instr array;
-    globals : value array;
-    constants : value array;
-    mutable env : value ref list;
-    mutable stack : value list
-  }
-
-(* TODO: add facilities to print the VM state in case of errors. *)
 
 let do_local state i f =
   match List.nth_opt state.env i with
@@ -53,17 +23,17 @@ let push state v =
 let rec do_apply state =
   let cur_env = state.env in
   let cur_i = state.i in
-  let f = pop_one state in
   let arg = pop_one state in
+  let f = pop_one state in
   match f with
   | Closure (x, e) ->
-     state.env <- e;
+     state.env <- ref arg :: e;
      state.i <- x;
      interpret state;
      state.env <- cur_env;
      state.i <- cur_i
-  | NativeClosure f ->
-     push state (f arg)
+  | Native x ->
+     push state (Native.table.(x) arg)
   | _ -> failwith "Cannot apply non-closure object"
 
 and interpret state =
@@ -75,6 +45,10 @@ and interpret state =
   | LoadGlobal x -> push state state.globals.(x) ; interpret state
   | StoreLocal x -> set_local state x (pop_one state) ; interpret state
   | StoreGlobal x -> Array.set state.globals x (pop_one state) ; interpret state
+  | MakeCons ->
+     let cdr = pop_one state in
+     let car = pop_one state in
+     push state (Cons (car, cdr))
   | Pop -> ignore (pop_one state) ; interpret state
   | Apply -> do_apply state ; interpret state
   | MakeClosure x -> push state (Closure (x, state.env)); interpret state