90 lines
3.8 KiB
OCaml
90 lines
3.8 KiB
OCaml
open Ast
|
|
|
|
let escape_json s =
|
|
let b = Buffer.create (String.length s + 16) in
|
|
String.iter
|
|
(function
|
|
| '"' -> Buffer.add_string b "\\\""
|
|
| '\\' -> Buffer.add_string b "\\\\"
|
|
| '\n' -> Buffer.add_string b "\\n"
|
|
| '\r' -> Buffer.add_string b "\\r"
|
|
| '\t' -> Buffer.add_string b "\\t"
|
|
| c -> Buffer.add_char b c)
|
|
s;
|
|
Buffer.contents b
|
|
|
|
let q s = Printf.sprintf "\"%s\"" (escape_json s)
|
|
let obj fields = "{" ^ String.concat "," fields ^ "}"
|
|
let arr xs = "[" ^ String.concat "," xs ^ "]"
|
|
let kv k v = q k ^ ":" ^ v
|
|
|
|
let rec typ_to_json = function
|
|
| TInt -> obj [ kv "kind" (q "int") ]
|
|
| TBool -> obj [ kv "kind" (q "bool") ]
|
|
| TVoid -> obj [ kv "kind" (q "void") ]
|
|
| TStruct name -> obj [ kv "kind" (q "struct"); kv "name" (q name) ]
|
|
| TArray t -> obj [ kv "kind" (q "array"); kv "elem" (typ_to_json t) ]
|
|
|
|
let rec expr_to_json = function
|
|
| IntLit n -> obj [ kv "node" (q "IntLit"); kv "value" (string_of_int n) ]
|
|
| BoolLit b -> obj [ kv "node" (q "BoolLit"); kv "value" (if b then "true" else "false") ]
|
|
| Var n -> obj [ kv "node" (q "Var"); kv "name" (q n) ]
|
|
| Binop (op, a, b) ->
|
|
obj
|
|
[ kv "node" (q "Binop"); kv "op" (q (Ast.string_of_binop op)); kv "left" (expr_to_json a);
|
|
kv "right" (expr_to_json b) ]
|
|
| Unop (op, e) ->
|
|
obj [ kv "node" (q "Unop"); kv "op" (q (Ast.string_of_unop op)); kv "expr" (expr_to_json e) ]
|
|
| Assign (lhs, rhs) ->
|
|
obj [ kv "node" (q "Assign"); kv "lhs" (expr_to_json lhs); kv "rhs" (expr_to_json rhs) ]
|
|
| Call (callee, args) ->
|
|
obj [ kv "node" (q "Call"); kv "callee" (expr_to_json callee); kv "args" (arr (List.map expr_to_json args)) ]
|
|
| ArrayGet (arr_e, idx) ->
|
|
obj [ kv "node" (q "ArrayGet"); kv "array" (expr_to_json arr_e); kv "index" (expr_to_json idx) ]
|
|
| StructGet (target, field) ->
|
|
obj [ kv "node" (q "StructGet"); kv "target" (expr_to_json target); kv "field" (q field) ]
|
|
|
|
let rec stmt_to_json = function
|
|
| VarDecl (t, n, init) ->
|
|
obj
|
|
[ kv "node" (q "VarDecl"); kv "type" (typ_to_json t); kv "name" (q n);
|
|
kv "init" (match init with None -> "null" | Some e -> expr_to_json e) ]
|
|
| Expr e -> obj [ kv "node" (q "Expr"); kv "expr" (expr_to_json e) ]
|
|
| If (cond, tbranch, ebranch) ->
|
|
obj
|
|
[ kv "node" (q "If"); kv "cond" (expr_to_json cond); kv "then" (arr (List.map stmt_to_json tbranch));
|
|
kv "else" (arr (List.map stmt_to_json ebranch)) ]
|
|
| ForEach (it_t, it_name, iterable, body) ->
|
|
obj
|
|
[ kv "node" (q "ForEach"); kv "iterType" (typ_to_json it_t); kv "iterName" (q it_name);
|
|
kv "iterable" (expr_to_json iterable); kv "body" (arr (List.map stmt_to_json body)) ]
|
|
| Return eo ->
|
|
obj [ kv "node" (q "Return"); kv "expr" (match eo with None -> "null" | Some e -> expr_to_json e) ]
|
|
| Block body -> obj [ kv "node" (q "Block"); kv "body" (arr (List.map stmt_to_json body)) ]
|
|
|
|
let top_to_json = function
|
|
| TopStruct s ->
|
|
obj
|
|
[ kv "node" (q "Struct"); kv "name" (q s.sname);
|
|
kv "fields"
|
|
(arr
|
|
(List.map
|
|
(fun (t, n) -> obj [ kv "type" (typ_to_json t); kv "name" (q n) ])
|
|
s.fields)) ]
|
|
| TopFunc f ->
|
|
obj
|
|
[ kv "node" (q "Function"); kv "name" (q f.name); kv "ret" (typ_to_json f.ret);
|
|
kv "params"
|
|
(arr
|
|
(List.map
|
|
(fun (t, n) -> obj [ kv "type" (typ_to_json t); kv "name" (q n) ])
|
|
f.params));
|
|
kv "body" (arr (List.map stmt_to_json f.body)) ]
|
|
| TopGlobalVar (t, n, init) ->
|
|
obj
|
|
[ kv "node" (q "GlobalVar"); kv "type" (typ_to_json t); kv "name" (q n);
|
|
kv "init" (match init with None -> "null" | Some e -> expr_to_json e) ]
|
|
|
|
let generate (prog : program) =
|
|
obj [ kv "node" (q "Program"); kv "tops" (arr (List.map top_to_json prog)) ]
|