diff options
Diffstat (limited to 'minijazz/src/global/printer.ml')
| -rw-r--r-- | minijazz/src/global/printer.ml | 156 |
1 files changed, 156 insertions, 0 deletions
diff --git a/minijazz/src/global/printer.ml b/minijazz/src/global/printer.ml new file mode 100644 index 0000000..747541d --- /dev/null +++ b/minijazz/src/global/printer.ml @@ -0,0 +1,156 @@ +open Ident +open Ast +open Static +open Format +open Misc + +let print_name ff n = fprintf ff "%s" n + +let rec print_list_r print lp sep rp ff = function + | [] -> () + | x :: l -> + fprintf ff "%s%a" lp print x; + List.iter (fprintf ff "%s %a" sep print) l; + fprintf ff "%s" rp + +let rec print_list_nlr print lp sep rp ff = function + | [] -> () + | x :: l -> + fprintf ff "%s%a" lp print x; + List.iter (fprintf ff "%s@ %a" sep print) l; + fprintf ff "%s" rp + +let print_bool ff b = + if b then + fprintf ff "1" + else + fprintf ff "0" + +let rec print_const ff v = match v with + | VBit b -> print_bool ff b + | VBitArray a when Array.length a = 0 -> fprintf ff "[]" + | VBitArray l -> Array.iter (print_bool ff) l + +let rec print_static_exp ff se = match se.se_desc with + | SInt i -> fprintf ff "%d" i + | SBool b -> print_bool ff b + | SVar n -> print_name ff n + | SBinOp(op, se1, se2) -> + let op_str = match op with + | SAdd -> "+" | SMinus -> "-" + | SMult -> "*" | SDiv -> "/" + | SPower -> "^" | SEqual -> "=" + | SLess -> "<" | SLeq -> "<=" + | SGreater -> ">" | SGeq -> ">=" in + fprintf ff "(%a %s %a)" print_static_exp se1 op_str print_static_exp se2 + | SIf (c, se1, se2) -> + fprintf ff "(%a ? %a : %a)" + print_static_exp c print_static_exp se1 print_static_exp se2 + +let rec print_static_type ff sty = match sty with + | STInt -> fprintf ff "int" + | STBool -> fprintf ff "bool" + +let rec print_type ff ty = match ty with + | TUnit -> fprintf ff "()" + | TBit -> fprintf ff "bit" + | TBitArray se -> fprintf ff "bit[%a]" print_static_exp se + | TProd l -> print_list_r print_type "" "*" "" ff l + | TVar _ -> fprintf ff "<var>" + +let print_call_params ff params = match params with + | [] -> () + | _ -> print_list_r print_static_exp "<<"","">>" ff params + +let rec print_exp ff e = + if !Cli_options.print_types then + fprintf ff "(%a : %a)" print_edesc e.e_desc print_type e.e_ty + else + fprintf ff "%a" print_edesc e.e_desc + +and print_edesc ff ed = match ed with + | Econst v -> print_const ff v + | Evar n -> print_ident ff n + | Ereg e -> fprintf ff "reg %a" print_exp e + | Ecall("select", idx::_, args) -> + let e1 = assert_1 args in + fprintf ff "%a[%a]" print_exp e1 print_static_exp idx + | Ecall("slice", low::high::_, args) -> + let e1 = assert_1 args in + fprintf ff "%a[%a..%a]" + print_exp e1 print_static_exp low print_static_exp high + | Ecall("concat", _, args) -> + let e1, e2 = assert_2 args in + fprintf ff "%a . %a" print_exp e1 print_exp e2 + | Ecall(fn, params, args) -> + fprintf ff "%a%a%a" print_name fn print_call_params params print_args args + | Emem(MRom, addr_size, word_size, _, args) -> + fprintf ff "rom<%a,%a>%a" + print_static_exp addr_size print_static_exp word_size print_args args + | Emem(MRam, addr_size, word_size, _, args) -> + fprintf ff "ram<%a,%a>%a" + print_static_exp addr_size print_static_exp word_size print_args args + +and print_args ff args = + print_list_r print_exp "(" "," ")" ff args + +let rec print_pat ff pat = match pat with + | Evarpat id -> print_ident ff id + | Etuplepat l -> print_list_r print_ident "(" "," ")" ff l + +let print_eq ff (pat, e) = + fprintf ff "%a = %a" print_pat pat print_exp e + +let print_eqs ff eqs = + print_list_nlr print_eq """;""" ff eqs + +let print_var_dec ff vd = match vd.v_ty with + | TUnit -> fprintf ff "@[%a : .@]" print_ident vd.v_ident + | TBit -> fprintf ff "@[%a@]" print_ident vd.v_ident + | TBitArray se -> + fprintf ff "@[%a : [%a]@]" print_ident vd.v_ident print_static_exp se + | TProd _ -> assert false + | TVar _ -> fprintf ff "%a : <var>" print_ident vd.v_ident + +let print_var_decs ff vds = + print_list_r print_var_dec "("","")" ff vds + +let rec print_block ff b = match b with + | BEqs (eqs, []) -> print_eqs ff eqs + | BEqs (eqs, vds) -> + fprintf ff "@[<v 2>var %a@] in@,%a" print_var_decs vds print_eqs eqs + | BIf(se, thenb, elseb) -> + fprintf ff "@[<v 2>if %a then@,%a@]@,@[<v 2>else@,%a@]" + print_static_exp se + print_block thenb + print_block elseb + +let print_param ff p = + print_name ff p.p_name + +let print_params ff params = match params with + | [] -> () + | _ -> print_list_r print_param "<<"","">>" ff params + +let print_constraints ff cl = + if !Cli_options.print_types then + fprintf ff " with %a" (print_list_r print_static_exp "" " and " "") cl + +let print_node ff n = + fprintf ff "@[<v2>@[%a%a%a = %a@] where@ %a@.end where%a;@]@\n@." + print_name n.n_name + print_params n.n_params + print_var_decs n.n_inputs + print_var_decs n.n_outputs + print_block n.n_body + print_constraints n.n_constraints + +let print_const_dec ff cd = + fprintf ff "const %a = %a@\n@." + print_name cd.c_name print_static_exp cd.c_value + +let print_program oc p = + let ff = formatter_of_out_channel oc in + List.iter (print_const_dec ff) p.p_consts; + List.iter (print_node ff) p.p_nodes + |