Make the pretty-printer cleaner for records

This commit is contained in:
Aly 2021-03-09 09:55:22 -08:00
parent 31f9808a93
commit ffdcfd2789
2 changed files with 77 additions and 52 deletions

View file

@ -3,3 +3,39 @@ open import "prelude.ml"
class pretty 'a begin
val pretty : 'a -> int -> string
end
type prettyable =
| S : show 'a => 'a -> prettyable
| P : pretty 'a => 'a -> prettyable
let dummy_pretty = pretty
instance pretty prettyable begin
let pretty x w =
match x with
| S a -> show a
| P a -> dummy_pretty a w
end
class prettyrecord 'r begin
val name : 'r -> string
val fields : 'r -> list (string * prettyable)
end
instance prettyrecord 'a => pretty 'a begin
let pretty a w =
let rec smul s n =
if n <= 0 then
""
else
s ^ (smul s (n - 1))
let x = w + 2
let prep = smul " " w
let rf = fields a
let rec field_str acc l =
match l with
| [] -> acc
| Cons ((name, field), xs) -> field_str (acc ^ prep ^ " " ^ name ^ " = " ^ (pretty field x) ^ ",\n") xs
let body = field_str "" rf
(name a) ^ " {\n" ^ body ^ prep ^ "}"
end

View file

@ -28,24 +28,19 @@ instance decode item_equips begin
}
end
instance pretty item_equips begin
let pretty (ItemEquips item_equips) w =
let rec smul s n =
if n <= 0 then
""
else
s ^ (smul s (n - 1))
let prep = smul " " w
let header = "ItemEquips {\n"
let button_item_b = header ^ prep ^ " button_item_b = " ^ (show item_equips.button_item_b) ^ ",\n"
let button_item_c_left = button_item_b ^ prep ^ " button_item_c_left = " ^ (show item_equips.button_item_c_left) ^ ",\n"
let button_item_c_down = button_item_c_left ^ prep ^ " button_item_c_down = " ^ (show item_equips.button_item_c_down) ^ ",\n"
let button_item_c_right = button_item_c_down ^ prep ^ " button_item_c_right = " ^ (show item_equips.button_item_c_right) ^ ",\n"
let button_slot_c_left = button_item_c_right ^ prep ^ " button_slot_c_left = " ^ (show item_equips.button_slot_c_left) ^ ",\n"
let button_slot_c_down = button_slot_c_left ^ prep ^ " button_slot_c_down = " ^ (show item_equips.button_slot_c_down) ^ ",\n"
let button_slot_c_right = button_slot_c_down ^ prep ^ " button_slot_c_right = " ^ (show item_equips.button_slot_c_right) ^ ",\n"
let equipment = button_slot_c_right ^ prep ^ " equipment = " ^ (show item_equips.equipment) ^ ",\n"
equipment ^ prep ^ "}"
instance prettyrecord item_equips begin
let name _ = "ItemEquips"
let fields (ItemEquips x) =
[
("button_item_b", S x.button_item_b),
("button_item_c_left", S x.button_item_c_left),
("button_item_c_down", S x.button_item_c_down),
("button_item_c_right", S x.button_item_c_right),
("button_slot_c_left", S x.button_slot_c_left),
("button_slot_c_down", S x.button_slot_c_down),
("button_slot_c_right", S x.button_slot_c_right),
("equipment", S x.equipment)
]
end
type save_context = SaveContext of {
@ -106,38 +101,32 @@ instance decode save_context begin
}
end
instance pretty save_context begin
let pretty (SaveContext save_context) w =
let rec smul s n =
if n <= 0 then
""
else
s ^ (smul s (n - 1))
let x = w + 2
let prep = smul " " w
let header = "SaveContext {\n"
let entrance_index = header ^ prep ^ " entrance_index = " ^ (show save_context.entrance_index) ^ ",\n"
let link_age = entrance_index ^ prep ^ " link_age = " ^ (show save_context.link_age) ^ ",\n"
let cutscene_index = link_age ^ prep ^ " cutscene_index = " ^ (show save_context.cutscene_index) ^ ",\n"
let day_time = cutscene_index ^ prep ^ " day_time = " ^ (show save_context.day_time) ^ ",\n"
let night_flag = day_time ^ prep ^ " night_flag = " ^ (show save_context.night_flag) ^ ",\n"
let num_days = night_flag ^ prep ^ " num_days = " ^ (show save_context.num_days) ^ ",\n"
let claim_days = num_days ^ prep ^ " claim_days = " ^ (show save_context.claim_days) ^ ",\n"
let deaths = claim_days ^ prep ^ " deaths = " ^ (show save_context.deaths) ^ ",\n"
let n64dd_flag = deaths ^ prep ^ " n64dd_flag = " ^ (show save_context.n64dd_flag) ^ ",\n"
let health_capacity = n64dd_flag ^ prep ^ " health_capacity = " ^ (show save_context.health_capacity) ^ ",\n"
let health = health_capacity ^ prep ^ " health = " ^ (show save_context.health) ^ ",\n"
let magic_level = health ^ prep ^ " magic_level = " ^ (show save_context.magic_level) ^ ",\n"
let magic = magic_level ^ prep ^ " magic = " ^ (show save_context.magic) ^ ",\n"
let rupees = magic ^ prep ^ " rupees = " ^ (show save_context.rupees) ^ ",\n"
let sword_health = rupees ^ prep ^ " sword_health = " ^ (show save_context.sword_health) ^ ",\n"
let navi_timer = sword_health ^ prep ^ " navi_timer = " ^ (show save_context.navi_timer) ^ ",\n"
let magic_acquired = navi_timer ^ prep ^ " magic_acquired = " ^ (show save_context.magic_acquired) ^ ",\n"
let double_magic = magic_acquired ^ prep ^ " double_magic = " ^ (show save_context.double_magic) ^ ",\n"
let double_defense = double_magic ^ prep ^ " double_defense = " ^ (show save_context.double_defense) ^ ",\n"
let bgs_flag = double_defense ^ prep ^ " bgs_flag = " ^ (show save_context.bgs_flag) ^ ",\n"
let ocarina_game_reward = bgs_flag ^ prep ^ " ocarina_game_reward = " ^ (show save_context.ocarina_game_reward) ^ ",\n"
let child_equips = ocarina_game_reward ^ prep ^ " child_equips = " ^ (pretty save_context.child_equips x) ^ ",\n"
let adult_equips = child_equips ^ prep ^ " adult_equips = " ^ (pretty save_context.adult_equips x) ^ ", \n"
adult_equips ^ prep ^ "}"
instance prettyrecord save_context begin
let name _ = "SaveContext"
let fields (SaveContext x) =
[
("entrance_index", S x.entrance_index),
("link_age", S x.link_age),
("cutscene_index", S x.cutscene_index),
("day_time", S x.day_time),
("night_flag", S x.night_flag),
("num_days", S x.num_days),
("claim_days", S x.claim_days),
("deaths", S x.deaths),
("n64dd_flag", S x.n64dd_flag),
("health_capacity", S x.health_capacity),
("health", S x.health),
("magic_level", S x.magic_level),
("magic", S x.magic),
("rupees", S x.rupees),
("sword_health", S x.sword_health),
("navi_timer", S x.navi_timer),
("magic_acquired", S x.magic_acquired),
("double_magic", S x.double_magic),
("double_defense", S x.double_defense),
("bgs_flag", S x.bgs_flag),
("ocarina_game_reward", S x.ocarina_game_reward),
("child_equips", P x.child_equips),
("adult_equips", P x.adult_equips)
]
end