let statement_description statement =
let rec statement_descriptionl level statement =
let rec get_closure_vars = function
| None -> "None"
| Some t -> (Hashtbl.fold (fun n _ s -> let (d, i) = n in s^"Local("^(string_of_int d)^","^(string_of_int i)^"),") t "[")^"]"
and prefix = function
| 0 -> ""
| level -> (String.make (level * 3) ' ') ^ "+--"
and location_name = function
| GlobalVar(uid, ind) ->"Global("^(string_of_int uid)^","^(string_of_int ind)^")\n"
| LocalVar(uid, d, ind) ->"Local("^(string_of_int uid)^","^(string_of_int d)^","^(string_of_int ind)^")\n"
and opname = function
| Plus -> "+"
| Minus -> "-"
| Divide -> "/"
| Times -> "*"
| Modulo -> "%"
| And -> "&&"
| Or -> "||"
and compopname = function
| LessThan -> "<"
| LessThanEqual -> ">"
| Equal -> "=="
| GreaterThan -> ">"
| GreaterThanEqual -> ">="
| NotEqual -> "!="
and expr_descriptionl level = function
| RBinaryOp (op1, op, op2) ->
(prefix level) ^
("BinOp " ^
((opname op) ^
("\n" ^
((expr_descriptionl (level + 1) op1) ^
(expr_descriptionl (level + 1) op2)))))
| RCompOp (op1, op, op2) ->
(prefix level) ^
("CompOp " ^
((compopname op) ^
("\n" ^
((expr_descriptionl (level + 1) op1) ^
(expr_descriptionl (level + 1) op2)))))
| RValue value ->
(prefix level) ^ "Value reference\n" ^ value_descriptionl (level + 1) value
| RMapExpr v ->
(prefix level) ^ ("Map\n" ^ ((property_list (level + 1) v) ^ "\n"))
| RArrayExpr v ->
(prefix level) ^ ("Array\n" ^ (expression_list (level + 1) v))
| RVariable(loc) ->
(prefix level) ^"Variable " ^(location_name loc)
| RVarArg(loc) ->
(prefix level) ^ "VarArg" ^(location_name loc)
| RNot(expr) ->
(prefix level) ^ "Not\n"^(expr_descriptionl (level + 1) expr)
| RDeclaration(expr1, expr2) ->
(prefix level)^"Declare\n"^
(expr_descriptionl (level + 1) expr1)^(expr_descriptionl (level + 1) expr2)
| RAssignment(expr1, expr2) ->
(prefix level)^"Assignment\n"^
(expr_descriptionl (level + 1) expr1)^(expr_descriptionl (level + 1) expr2)
| RPostFixSum(expr, inc) -> (prefix level)^"++("^(string_of_int inc)^")\n"^
(expr_descriptionl (level + 1) expr)
| RMemberExpr(expr1, expr2) ->
(prefix level)^"Member\n"^
(expr_descriptionl (level + 1) expr1)^(expr_descriptionl (level + 1) expr2)
| RTernaryCond(expr1, expr2, expr3) ->
(prefix level)^"Ternary condition\n"^
(expr_descriptionl (level + 1) expr1)^(expr_descriptionl (level + 1) expr2)^
(expr_descriptionl (level + 1) expr3)
| RFunctionCall(expr, exprl) ->
(prefix level)^"FunctionCall\n"^(expr_descriptionl (level + 1) expr)^
(expression_list (level + 1) exprl)
and value_descriptionl level = function
| RIntegerValue v ->
(prefix level) ^ ("Integer " ^ ((string_of_int v) ^ "\n"))
| RFunctionValue (stacksize, depth, numargs, varargs, stmts, closure_vars, inline) ->
(prefix level) ^
"RFunction("^(string_of_int stacksize)^","^(string_of_int depth)^","^(string_of_int numargs)
^","^(string_of_bool varargs)^","^(get_closure_vars closure_vars)^
", inline "^(match inline with | Some _ -> "true" | None -> "false")^
")\n"
^ (statement_list (level + 1) stmts)
| RLibraryFunction(_) -> ""
| RBooleanValue v ->
(prefix level) ^ ("Boolean " ^ ((string_of_bool v) ^ "\n"))
| RStringValue v -> (prefix level) ^ ("String " ^ (v ^ "\n"))
| RFloatValue v ->
(prefix level) ^ ("Float " ^ ((string_of_float v) ^ "\n"))
| RMapValue( _, _) -> ""
| RVoid -> (prefix level) ^"void\n"
| RUndefined -> (prefix level) ^"Undefined\n"
and statement_list level stmt_list =
List.fold_left (fun acc el -> acc ^ (statement_descriptionl level el))
"" stmt_list
and expression_list level expr_list =
List.fold_left (fun acc el -> acc ^ (expr_descriptionl level el)) ""
expr_list
and property_list level prop_list =
List.fold_left
(fun acc el ->
let (name, expr) = el
in
acc ^
((prefix level) ^
("Property " ^
(name ^ ("\n" ^ (expr_descriptionl (level + 1) expr))))))
"" prop_list
in match statement with
| RStatementBlock(stmts) ->
List.fold_left(fun pre stmt -> pre^(statement_descriptionl (level + 1) stmt))
((prefix level) ^"Statement block\n") stmts
| RProgram(stmts) ->
List.fold_left(fun pre stmt -> pre^(statement_descriptionl (level + 1) stmt))
((prefix level) ^"Program\n") stmts
| RTryFinally(stmt1, stmt2, env) ->
(prefix level)^"Try\n"^(statement_descriptionl (level + 1) stmt1)^
(prefix level)^"finally\n"^(statement_descriptionl (level + 1) stmt2)
| RTryCatch(stmt1, vloc, stmt2, env) ->
(prefix level)^"Try\n"^(statement_descriptionl (level + 1) stmt1)^
(prefix level)^"catch "^(location_name vloc)^(statement_descriptionl (level + 1) stmt2)
| RSwitch(expr, stmts, env) ->
List.fold_left(fun pre stmt -> pre^(statement_descriptionl (level + 1) stmt))
((prefix level)^"Switch\n"^(expr_descriptionl (level + 1) expr)) stmts
| RForEach(vloc, expr, stmt, env) ->
(prefix level)^"RForEach "^(location_name vloc)^"\n"^(expr_descriptionl (level + 1) expr)^
(statement_descriptionl (level + 1) stmt)
| RIf (expr, iflist, elselist, env) ->
(prefix level) ^
("If/Else\n" ^
((expr_descriptionl (level + 1) expr) ^
((statement_descriptionl (level + 1) iflist) ^
(statement_descriptionl (level + 1) elselist))))
| RReturn( expr, env) ->
(prefix level) ^
("Return\n" ^ (expr_descriptionl (level + 1) expr))
| RExpressionStatement (expr , env) -> expr_descriptionl level expr
| RContinue(env) -> (prefix level) ^ "Continue\n"
| RBreak(env) -> (prefix level) ^ "Break\n"
| RFor (expr1, expr2, expr3, stmt_list, env) ->
(prefix level) ^
("For\n" ^
((expr_descriptionl (level + 1) expr1) ^
((expr_descriptionl (level + 1) expr2) ^
((expr_descriptionl (level + 1) expr3) ^
(statement_descriptionl (level + 1) stmt_list)))))
| RFastIterator(vloc, start, max, incr, stmt, env) ->
(prefix level)^ ("FastIterator "^" "^(string_of_int start)^" "
^(string_of_int max)^" "^(string_of_int incr)^" "
^(location_name vloc)^(statement_descriptionl (level + 1) stmt))
| RNoop -> (prefix level) ^ "Noop\n"
| RThrow(expr, env) -> (prefix level)^"Throw\n"^(expr_descriptionl (level + 1) expr)
| RCase(Some expr, env) -> (prefix level)^"Case\n"^(expr_descriptionl (level + 1) expr)
| RCase(None, env) -> (prefix level)^"DefaultCase\n"
in statement_descriptionl 0 statement