From b4bdcab27f845b54b6db3712f80d83525a9efe7a Mon Sep 17 00:00:00 2001 From: Zequn Ma Date: Mon, 22 May 2017 17:35:50 +1000 Subject: [PATCH] reformat --- snick_analyze.ml | 3 +- snick_codegen.ml | 30 ++++++--------- snick_lex.mll | 96 ++++++++++++++++++++++++------------------------ snick_parse.mly | 24 +----------- snick_pprint.ml | 74 +++++++++++++------------------------ 5 files changed, 90 insertions(+), 137 deletions(-) diff --git a/snick_analyze.ml b/snick_analyze.ml index 3a2266e..1ad7047 100644 --- a/snick_analyze.ml +++ b/snick_analyze.ml @@ -314,7 +314,8 @@ and error_detect_call scope id exprs = ) with (* error incorrect number of parameters *) - | Invalid_argument(_) -> error_arg_count_mismatch (get_scope_id scope) id + | Invalid_argument(_) -> + error_arg_count_mismatch (get_scope_id scope) id ) (* error procedure undefined *) else error_undef_proc (get_scope_id scope) id diff --git a/snick_codegen.ml b/snick_codegen.ml index 4aba6e4..92922c2 100644 --- a/snick_codegen.ml +++ b/snick_codegen.ml @@ -77,26 +77,20 @@ and gen_br_program prog = List.iter gen_br_proc prog (* Create a label and instructions for the index out of bound error *) -and gen_br_out_of_bounds = function - | _ -> - ( - gen_label out_of_bounds_label; - gen_string_const 0 "\"ARRAY INDEXING OUT OF BOUND\\n\""; - (* gen_string_const 0 "\"[FATAL]: array element out of bounds!\\n\""; *) - gen_call_builtin "print_string"; - gen_halt "" - ) +and gen_br_out_of_bounds _ = + gen_label out_of_bounds_label; + gen_string_const 0 "\"ARRAY INDEXING OUT OF BOUND\\n\""; + (* gen_string_const 0 "\"[FATAL]: array element out of bounds!\\n\""; *) + gen_call_builtin "print_string"; + gen_halt "" (* Create a label and instructions for the division by zero error *) -and gen_br_div_by_zero = function - | _ -> - ( - gen_label div_by_zero_label; - gen_string_const 0 "\"DIVIDE BY ZERO\\n\""; - (* gen_string_const 0 "\"[FATAL]: division by zero!\\n\""; *) - gen_call_builtin "print_string"; - gen_halt "" - ) +and gen_br_div_by_zero _ = + gen_label div_by_zero_label; + gen_string_const 0 "\"DIVIDE BY ZERO\\n\""; + (* gen_string_const 0 "\"[FATAL]: division by zero!\\n\""; *) + gen_call_builtin "print_string"; + gen_halt "" (* Generate a block of brill instructions for a snick procedure *) and gen_br_proc ((proc_id,params),proc_body) = diff --git a/snick_lex.mll b/snick_lex.mll index 263e376..52bd114 100644 --- a/snick_lex.mll +++ b/snick_lex.mll @@ -29,52 +29,52 @@ let commment = '#' [^'\n']* (* comments *) let string = '"' [^'"']* '"' (* string constant for write statement *) rule token = parse - | commment { token lexbuf } (* skip comments *) - | [' ' '\t' '\r'] { token lexbuf } (* skip blanks*) - | '\n' { Lexing.new_line lexbuf ; token lexbuf } - | '-'? digits as lxm { INT_CONST (int_of_string lxm) } - | '-'? floating as lxm { FLOAT_CONST (float_of_string lxm) } - | eof { EOF } + | commment { token lexbuf } (* skip comments *) + | [' ' '\t' '\r'] { token lexbuf } (* skip blanks*) + | '\n' { Lexing.new_line lexbuf ; token lexbuf } + | '-'? digits as lxm { INT_CONST (int_of_string lxm) } + | '-'? floating as lxm { FLOAT_CONST (float_of_string lxm) } + | eof { EOF } (* keywords *) - | "not" { NOT } - | "and" { AND } - | "or" { OR } - | "float" { FLOAT } - | "int" { INT } - | "bool" { BOOL } - | "false" { BOOL_CONST false } - | "true" { BOOL_CONST true } - | "while" { WHILE } - | "do" { DO } - | "od" { OD } - | "if" { IF } - | "then" { THEN } - | "else" { ELSE } - | "fi" { FI } - | "proc" { PROC } - | "end" { END } - | "read" { READ } - | "write" { WRITE } - | "ref" { REF } - | "val" { VAL } - | ":=" { ASSIGN } - | '(' { LPAREN } - | ')' { RPAREN } - | '[' { LSQBRACK } - | ']' { RSQBRACK } - | '=' { EQ } - | '.' { DOT } - | "!=" { NE } - | ">=" { GE } - | "<=" { LE } - | '>' { GT } - | '<' { LT } - | '+' { PLUS } - | '-' { MINUS } - | '*' { MULTI } - | '/' { DIVID } - | ',' { COMMA } - | ';' { SEMICOLON } - | ident as lxm { IDENT lxm } - | string as lxm { STRING_CONST lxm} - | _ { raise LexErr} + | "not" { NOT } + | "and" { AND } + | "or" { OR } + | "float" { FLOAT } + | "int" { INT } + | "bool" { BOOL } + | "false" { BOOL_CONST false } + | "true" { BOOL_CONST true } + | "while" { WHILE } + | "do" { DO } + | "od" { OD } + | "if" { IF } + | "then" { THEN } + | "else" { ELSE } + | "fi" { FI } + | "proc" { PROC } + | "end" { END } + | "read" { READ } + | "write" { WRITE } + | "ref" { REF } + | "val" { VAL } + | ":=" { ASSIGN } + | '(' { LPAREN } + | ')' { RPAREN } + | '[' { LSQBRACK } + | ']' { RSQBRACK } + | '=' { EQ } + | '.' { DOT } + | "!=" { NE } + | ">=" { GE } + | "<=" { LE } + | '>' { GT } + | '<' { LT } + | '+' { PLUS } + | '-' { MINUS } + | '*' { MULTI } + | '/' { DIVID } + | ',' { COMMA } + | ';' { SEMICOLON } + | ident as lxm { IDENT lxm } + | string as lxm { STRING_CONST lxm} + | _ { raise LexErr} diff --git a/snick_parse.mly b/snick_parse.mly index 5bc0555..dfc2bf7 100644 --- a/snick_parse.mly +++ b/snick_parse.mly @@ -102,8 +102,6 @@ decl: variable: | IDENT { Variable ($1, None) } | IDENT dimension { Variable ($1, Some $2) } -/* | IDENT { Single_variable $1 } */ -/* | IDENT dimension { Array_variable ($1, $2) } */ dimension: LSQBRACK intervals RSQBRACK { List.rev $2 } @@ -121,22 +119,6 @@ stmts: | stmts stmt { $2 :: $1 } | stmt { [$1] } -/* stmt: */ -/* | atom_stmt { Atom_stmt $1 } */ -/* | comps_stmt { Comps_stmt $1 } */ - -/* atom_stmt: */ -/* | elem ASSIGN expr SEMICOLON { Assign ($1, $3) } */ -/* | READ elem SEMICOLON { Read $2 } */ -/* | WRITE STRING_CONST SEMICOLON { Write (String $2) } */ -/* | WRITE expr SEMICOLON { Write (Expr $2) } */ -/* | IDENT LPAREN exprs_emptiable RPAREN SEMICOLON { Call ($1, List.rev $3) } */ - -/* comps_stmt: */ -/* | IF expr THEN stmts FI { If_then ($2, List.rev $4) } */ -/* | IF expr THEN stmts ELSE stmts FI { If_then_else ($2, List.rev $4, List.rev $6) } */ -/* | WHILE expr DO stmts OD { While ($2, List.rev $4) } */ - stmt: | elem ASSIGN expr SEMICOLON { Assign ($1, $3) } | READ elem SEMICOLON { Read $2 } @@ -144,14 +126,13 @@ stmt: | WRITE expr SEMICOLON { Write (Expr $2) } | IDENT LPAREN exprs_emptiable RPAREN SEMICOLON { Call ($1, List.rev $3) } | IF expr THEN stmts FI { If_then ($2, List.rev $4) } - | IF expr THEN stmts ELSE stmts FI { If_then_else ($2, List.rev $4, List.rev $6) } + | IF expr THEN stmts ELSE stmts FI { If_then_else + ($2, List.rev $4, List.rev $6) } | WHILE expr DO stmts OD { While ($2, List.rev $4) } elem: | IDENT { Elem ($1, None) } | IDENT LSQBRACK exprs RSQBRACK { Elem ($1, Some (List.rev $3)) } -/* | IDENT { Single_elem $1 } */ -/* | IDENT LSQBRACK exprs RSQBRACK { Array_elem ($1, List.rev $3) }*/ expr: /* Variable element */ @@ -160,7 +141,6 @@ expr: | BOOL_CONST { Ebool $1 } | INT_CONST { Eint $1 } | FLOAT_CONST { Efloat $1 } - /*| STRING_CONST { Estring $1 }*/ /* Expression inside a pair of parentheses */ | LPAREN expr RPAREN { Eparen $2 } /* Binary operators */ diff --git a/snick_pprint.ml b/snick_pprint.ml index dd22f8a..f4ae7df 100644 --- a/snick_pprint.ml +++ b/snick_pprint.ml @@ -41,7 +41,8 @@ and print_params fmtr = function (* Print a single procedure parameter. *) and print_param fmtr (indicator, param_type, ident) = - fprintf fmtr "%a %a %s" print_param_indc indicator print_type param_type ident + fprintf fmtr "%a %a %s" + print_param_indc indicator print_type param_type ident (* Print the indicator of a procedure parameter. *) and print_param_indc fmtr = function @@ -54,9 +55,11 @@ and print_type fmtr = function | Int -> fprintf fmtr "%s" "int" | Float -> fprintf fmtr "%s" "float" -(* Print procedure body as a list of declarations followed by a list of statements. *) +(* Print procedure body as a list of declarations +** followed by a list of statements. *) and print_proc_body fmtr prog_body = - fprintf fmtr "%a@,%a" print_decls prog_body.decls print_stmts prog_body.stmts + fprintf fmtr "%a@,%a" print_decls prog_body.decls + print_stmts prog_body.stmts (* Print the list of declarations. *) and print_decls fmtr = function @@ -75,11 +78,10 @@ and print_decl fmtr (var_type, variable) = fprintf fmtr "%a %a;" print_type var_type print_var variable (* Print a variable. *) -and print_var fmtr = function(* - | Single_variable ident -> fprintf fmtr "%s" ident - | Array_variable (ident, itvls) -> fprintf fmtr "%s[%a]" ident print_itvls itvls *) +and print_var fmtr = function | Variable (ident, None) -> fprintf fmtr "%s" ident - | Variable (ident, Some itvls) -> fprintf fmtr "%s[%a]" ident print_itvls itvls + | Variable (ident, Some itvls) -> fprintf fmtr "%s[%a]" + ident print_itvls itvls (* Print list of intervals. *) and print_itvls fmtr = function @@ -91,38 +93,10 @@ and print_itvls fmtr = function and print_itvl fmtr (st_pnt, end_pnt) = fprintf fmtr "%d..%d" st_pnt end_pnt -(* -(* Print statement. *) -and print_stmt fmtr = function - | Atom_stmt atom_stmt -> fprintf fmtr "%a" print_atom_stmt atom_stmt - | Comps_stmt comps_stmt -> fprintf fmtr "%a" print_comps_stmt comps_stmt - -(* Print atomic statement. *) -and print_atom_stmt fmtr = function - | Assign (elem, expr) -> fprintf fmtr "%a := %a;" print_elem elem print_expr expr - | Read elem -> fprintf fmtr "read %a;" print_elem elem - | Write expr -> - begin - match expr with - | Expr wexpr -> fprintf fmtr "write %a;" print_expr wexpr - | String str -> fprintf fmtr "write %s;" str - end - | Call (ident, exprs) -> fprintf fmtr "%s(%a);" ident print_exprs exprs - -(* Print composite statement. *) -and print_comps_stmt fmtr = function - | If_then (expr, stmts) -> fprintf fmtr "if %a then@;<0 4>@[%a@]@,fi" - print_expr expr print_stmts stmts - | If_then_else (expr, then_stmts, else_stmts) -> - fprintf fmtr "if %a then@;<0 4>@[%a@]@,else@;<0 4>@[%a@]@,fi" - print_expr expr print_stmts then_stmts print_stmts else_stmts - | While (expr, stmts) -> fprintf fmtr "while %a do@;<0 4>@[%a@]@,od" - print_expr expr print_stmts stmts -*) - (* Print statement. *) and print_stmt fmtr = function - | Assign (elem, expr) -> fprintf fmtr "%a := %a;" print_elem elem print_expr expr + | Assign (elem, expr) -> fprintf fmtr "%a := %a;" print_elem elem + print_expr expr | Read elem -> fprintf fmtr "read %a;" print_elem elem | Write expr -> begin @@ -140,9 +114,7 @@ and print_stmt fmtr = function print_expr expr print_stmts stmts (* Print element to be assigned to or be read / written. *) -and print_elem fmtr = function(* - | Single_elem ident -> fprintf fmtr "%s" ident - | Array_elem (ident, idxs) -> fprintf fmtr "%s[%a]" ident print_exprs idxs *) +and print_elem fmtr = function | Elem (ident, None) -> fprintf fmtr "%s" ident | Elem (ident, Some idxs) -> fprintf fmtr "%s[%a]" ident print_exprs idxs @@ -260,13 +232,16 @@ and print_binop fmtr = function in if lcmpr_result>=0 then fprintf fmtr "%a %a %a" - print_expr lexpr_inside_strip print_optr optr print_expr rexpr + print_expr lexpr_inside_strip + print_optr optr print_expr rexpr else fprintf fmtr "(%a) %a %a" - print_expr lexpr_inside_strip print_optr optr print_expr rexpr + print_expr lexpr_inside_strip + print_optr optr print_expr rexpr | _ -> fprintf fmtr "%a %a %a" - print_expr lexpr_inside_strip print_optr optr print_expr rexpr + print_expr lexpr_inside_strip + print_optr optr print_expr rexpr end | (lexpr, optr, Eparen rexpr_inside) -> begin @@ -280,13 +255,16 @@ and print_binop fmtr = function in if rcmpr_result>0 then fprintf fmtr "%a %a %a" - print_expr lexpr print_optr optr print_expr rexpr_inside_strip + print_expr lexpr print_optr optr + print_expr rexpr_inside_strip else fprintf fmtr "%a %a (%a)" - print_expr lexpr print_optr optr print_expr rexpr_inside_strip + print_expr lexpr print_optr optr + print_expr rexpr_inside_strip | _ -> fprintf fmtr "%a %a %a" - print_expr lexpr print_optr optr print_expr rexpr_inside_strip + print_expr lexpr print_optr optr + print_expr rexpr_inside_strip end | (lexpr, optr, rexpr) -> @@ -296,8 +274,8 @@ and print_binop fmtr = function end (* Print unary operations. -** Parenthese around an operation expression with higher precedence will be removed. -*) +** Parenthese around an operation expression with higher precedence +** will be removed. *) and print_unop fmtr = function | (optr, Eparen expr_inside) -> begin