mips-cc

A little C compiler
git clone git@git.mpah.dev/mips-cc.git
Log | Files | Refs | README

simplifier.ml (2462B)

      1 open Ast
      2 
      3 module Env = Map.Make(String)
      4 
      5 let collect_constant_strings code =
      6   let counter = ref 0 in
      7   let env = ref Env.empty in
      8   let rec ccs_expr = function
      9     | IR.Bool b -> IR2.Bool b, []
     10     | IR.Void    -> IR2.Nil, []
     11     | IR.Int n  -> IR2.Int n, []
     12     | IR.Char c -> IR2.Char c.[0], []
     13     | IR.Float f -> IR2.Float f, []
     14     | IR.Str s  -> 
     15             (match  Env.find_opt s !env with
     16             | Some l -> 
     17                 IR2.Data l, []
     18             | None   ->
     19                 incr counter ;
     20                 let l = "str" ^ (string_of_int !counter) in
     21                 env := Env.add s l !env ;
     22                 IR2.Data l, [ (l, s) ])
     23     | IR.Var v ->
     24        IR2.Var v, []
     25     | IR.Call (f, args) ->
     26        let args2 = List.map ccs_expr args in
     27        let ccs = List.flatten (List.map (fun (_, s) -> s) args2) in
     28        IR2.Call (f, List.map (fun (e, _) -> e) args2), ccs
     29   in
     30   (* let ccs_lvalue = function *)
     31   (*   | IR.LVar v  -> *)
     32   (*      IR2.LVar v, [] *)
     33   (*   | IR.LAddr a -> *)
     34   (*      let a2, ccs = ccs_expr a in *)
     35   (*      IR2.LAddr a2, ccs *)
     36   (* in *)
     37   let rec ccs_instr = function
     38     | IR.Decl v ->
     39        IR2.Decl v, []
     40     | IR.Return e ->
     41        let e2, ccs = ccs_expr e in
     42        IR2.Return e2, ccs
     43     | IR.Expr e ->
     44        let e2, ccs = ccs_expr e in
     45        IR2.Expr e2, ccs
     46 
     47     | IR.Assign (lv, e) ->
     48       let lv2, ccs_lv = ccs_expr (IR.Var lv) in
     49       let e2, ccs_e = ccs_expr e in
     50       IR2.Assign (lv2, e2), List.flatten [ ccs_lv; ccs_e ]
     51 
     52     | IR.Cond (t, y, n) ->
     53        let t2, ccs_t = ccs_expr t in
     54        let y2, ccs_y = ccs_block y in
     55        let n2, ccs_n = ccs_block n in
     56        IR2.Cond (t2, y2, n2), List.flatten [ ccs_t ; ccs_y ; ccs_n ]
     57 
     58     | IR.Loop (t, y) ->
     59        let t2, ccs_t = ccs_expr t in
     60        let y2, ccs_y = ccs_block y in
     61        IR2.Loop (t2, y2), List.flatten [ ccs_t ; ccs_y ]
     62 
     63   and ccs_block = function
     64     | [] -> [], []
     65     | i :: r ->
     66        let i2, ccs_i = ccs_instr i in
     67        let r2, ccs_r = ccs_block r in
     68        i2 :: r2, List.flatten [ ccs_i ; ccs_r ]
     69   in
     70   let ccs_def = function
     71     | IR.Func (name, args,  body) ->
     72        let body2, ccs = ccs_block body in
     73        IR2.Func (name, args, body2), ccs
     74   in
     75   let rec ccs_prog = function
     76     | [] -> [], []
     77     | d :: r ->
     78        let d2, ccs_d = ccs_def d in
     79        let r2, ccs_r = ccs_prog r in
     80        d2 :: r2, List.flatten [ ccs_d ; ccs_r ]
     81   in ccs_prog code
     82 
     83 let simplify code =
     84   collect_constant_strings code