Getting ready for globals

Author: superbobry

_oasis

@@ -19,6 +19,7 @@ Library llama_man
   Path:              lib_src
   CompiledObject:    best
   Modules:           Gcc_types,
+                     Gcc_internals,
                      Gcc_compiler
   if flag(strict)
     NativeOpt:       -w @a-4 -warn-error -a

bin_src/gcc.ml

@@ -3,10 +3,11 @@ open Sexplib.Std
 
 open Gcc_types
 
+
 let () =
   try
     let sexp = Sexp.input_sexp stdin in
-    let expr = expr_of_sexp sexp in
+    let (globals, expr) = program_of_sexp sexp in
     let open Gcc_compiler in
-    compile expr |> assemble |> print_endline
+    compile ~globals expr |> assemble |> print_endline
   with e -> sexp_of_exn e |> Sexp.to_string |> print_endline

lib_src/gcc_compiler.ml

@@ -3,7 +3,7 @@ open Core_kernel.Std
 open Gcc_types
 
 type env = {
-  vars   : var list;
+  vars   : ident list;
   parent : env option;
 }
 
@@ -22,15 +22,12 @@ let rec lookup {vars; parent} v =
       let (e, i) = lookup env v in
       (succ e, i)
 
+
 type state = {
   functions : code list;
-  env : env;
+  env       : env
 }
 
-let initial_state = {
-  functions = [];
-  env = {vars = ["world"; "undocumented"]; parent = None}
-}
 
 let add_fn label code ret {functions; env} =
   let wrapped_code = LABEL label :: code @ [ret] in
@@ -104,7 +101,12 @@ and compile_func id formals expr {functions; env} =
   let code, {functions = fns1; _} = compile_expr expr e_state in
   add_fn id code RTN {functions = fns1; env=env}
 
-let compile expr =
+let compile ?(globals=[]) expr =
+  let initial_state = {
+    functions = [];
+    env = {vars = ["world"; "undocumented"]; parent = None}
+  } in
+
   let (code, state) = compile_expr expr initial_state in
   code @ [RTN] @ List.concat state.functions
 

lib_src/gcc_internals.ml

@@ -0,0 +1,3 @@
+open Gcc_types
+
+let scope ~name ~var expr = Call (Fn ([name], expr), [var])

lib_src/gcc_types.ml

@@ -36,7 +36,7 @@ with sexp_of
 
 type code = instruction list
 
-type var = string with sexp
+type ident = string with sexp
 
 type expr =
   | Const of int
@@ -45,14 +45,16 @@ type expr =
   | Mul of expr * expr
   | Div of expr * expr
   | Cons of expr * expr
-  | Fn of var list * expr
+  | Fn of ident list * expr
   | Call of expr * expr list
-  | Letrec of (var * expr) list * expr
+  | Letrec of (ident * expr) list * expr
   | If of expr * expr * expr
   | Eq of expr * expr
   | Gt of expr * expr
   | Gte of expr * expr
-  | Var of var
+  | Var of ident
   | Car of expr
   | Cdr of expr
 with sexp
+
+type program = ((ident * expr) list) * expr with sexp

lib_test/gcc_test.ml

@@ -3,9 +3,7 @@ open Core_kernel.Std
 open OUnit2
 
 open Gcc_types
-
-
-let scope name var expr = Call (Fn ([name], expr), [var])
+open Gcc_internals
 
 
 let test_gcc ~ast ~path =