From add2ae999cdb34f723d6afe066faf3c08c20bfe3 Mon Sep 17 00:00:00 2001 From: Mylloon Date: Sat, 10 Dec 2022 17:51:31 +0100 Subject: [PATCH] init: simplifier --- ast.ml | 22 +++++++++++++++++++--- compiler.ml | 9 +++++---- main.ml | 3 ++- semantics.ml | 3 ++- simplifier.ml | 44 ++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 72 insertions(+), 9 deletions(-) create mode 100644 simplifier.ml diff --git a/ast.ml b/ast.ml index 727457f..36bc23b 100644 --- a/ast.ml +++ b/ast.ml @@ -70,16 +70,29 @@ module Syntax = struct type prog = def list end -module IR = struct - type ident = string +module type Parameters = sig + type value +end +module V1 = struct type value = | Void | Int of int | Bool of bool +end + +module V2 = struct + type value = + | Void + | Int of int + | Bool of bool +end + +module IR (P : Parameters) = struct + type ident = string type expr = - | Val of value + | Val of P.value | Var of ident | Call of ident * expr list @@ -93,3 +106,6 @@ module IR = struct type def = Func of ident * ident list * block type prog = def list end + +module IR1 = IR (V1) +module IR2 = IR (V2) diff --git a/compiler.ml b/compiler.ml index 2c7bb95..078396a 100644 --- a/compiler.ml +++ b/compiler.ml @@ -1,6 +1,7 @@ -open Ast.IR +open Ast.IR2 +open Ast.V2 open Mips -module Env = Map.Make (String) +open Baselib type info = { asm : instr list @@ -86,7 +87,7 @@ let rec compile_prog counter = function cd @ compile_prog new_counter r ;; -let compile ir = +let compile (ir, data) = let asm = compile_prog 0 ir in - { text = asm; data = [] } + { text = asm; data } ;; diff --git a/main.ml b/main.ml index 847b70d..591e5b3 100644 --- a/main.ml +++ b/main.ml @@ -1,4 +1,5 @@ open Errors +open Simplifier let () = if Array.length Sys.argv != 2 @@ -13,7 +14,7 @@ let () = (* Test.debug_parser Stdlib.stderr parsed; *) let ast = Semantics.analyze parsed in (* Test.debug_semantics Stdlib.stderr ast; *) - let asm = Compiler.compile ast in + let asm = Compiler.compile (simplify ast) in Mips.emit Stdlib.stdout asm with | LexerError c -> diff --git a/semantics.ml b/semantics.ml index 76e157d..3e7bd37 100644 --- a/semantics.ml +++ b/semantics.ml @@ -1,5 +1,6 @@ open Ast -open Ast.IR +open Ast.IR1 +open Ast.V1 open Baselib open Errors diff --git a/simplifier.ml b/simplifier.ml new file mode 100644 index 0000000..94de7f5 --- /dev/null +++ b/simplifier.ml @@ -0,0 +1,44 @@ +open Ast + +let collect_constant_strings code = + let ccs_value = function + | V1.Void -> V2.Void, [] + | V1.Bool b -> V2.Bool b, [] + | V1.Int n -> V2.Int n, [] + in + let rec ccs_expr = function + | IR1.Val v -> + let v2, cs = ccs_value v in + IR2.Val v2, cs + | IR1.Var v -> IR2.Var v, [] + | IR1.Call (fn, args) -> + let a2 = List.map ccs_expr args in + IR2.Call (fn, List.map fst a2), List.flatten (List.map snd a2) + in + let ccs_instr = function + | IR1.Decl v -> IR2.Decl v, [] + | IR1.Assign (lv, e) -> + let e2, cs = ccs_expr e in + IR2.Assign (lv, e2), cs + | IR1.Do e -> + let e2, cs = ccs_expr e in + IR2.Do e2, cs + | IR1.Return e -> + let e2, cs = ccs_expr e in + IR2.Do e2, cs + in + let rec ccs_block acc_b acc_cs = function + | i :: b -> + let i2, cs = ccs_instr i in + ccs_block (i2 :: acc_b) (cs @ acc_cs) b + | [] -> List.rev acc_b, acc_cs + in + let ccs_def (IR1.Func (name, args, body)) = + let body2, cs = ccs_block [] [] body in + IR2.Func (name, args, body2), cs + in + let code2 = List.map ccs_def code in + List.map fst code2, List.flatten (List.map snd code2) +;; + +let simplify ir = collect_constant_strings ir