Make the pretty-printer cleaner for records
This commit is contained in:
parent
31f9808a93
commit
ffdcfd2789
2 changed files with 77 additions and 52 deletions
36
pretty.ml
36
pretty.ml
|
@ -3,3 +3,39 @@ open import "prelude.ml"
|
||||||
class pretty 'a begin
|
class pretty 'a begin
|
||||||
val pretty : 'a -> int -> string
|
val pretty : 'a -> int -> string
|
||||||
end
|
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
|
||||||
|
|
|
@ -28,24 +28,19 @@ instance decode item_equips begin
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
instance pretty item_equips begin
|
instance prettyrecord item_equips begin
|
||||||
let pretty (ItemEquips item_equips) w =
|
let name _ = "ItemEquips"
|
||||||
let rec smul s n =
|
let fields (ItemEquips x) =
|
||||||
if n <= 0 then
|
[
|
||||||
""
|
("button_item_b", S x.button_item_b),
|
||||||
else
|
("button_item_c_left", S x.button_item_c_left),
|
||||||
s ^ (smul s (n - 1))
|
("button_item_c_down", S x.button_item_c_down),
|
||||||
let prep = smul " " w
|
("button_item_c_right", S x.button_item_c_right),
|
||||||
let header = "ItemEquips {\n"
|
("button_slot_c_left", S x.button_slot_c_left),
|
||||||
let button_item_b = header ^ prep ^ " button_item_b = " ^ (show item_equips.button_item_b) ^ ",\n"
|
("button_slot_c_down", S x.button_slot_c_down),
|
||||||
let button_item_c_left = button_item_b ^ prep ^ " button_item_c_left = " ^ (show item_equips.button_item_c_left) ^ ",\n"
|
("button_slot_c_right", S x.button_slot_c_right),
|
||||||
let button_item_c_down = button_item_c_left ^ prep ^ " button_item_c_down = " ^ (show item_equips.button_item_c_down) ^ ",\n"
|
("equipment", S x.equipment)
|
||||||
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 ^ "}"
|
|
||||||
end
|
end
|
||||||
|
|
||||||
type save_context = SaveContext of {
|
type save_context = SaveContext of {
|
||||||
|
@ -106,38 +101,32 @@ instance decode save_context begin
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
instance pretty save_context begin
|
instance prettyrecord save_context begin
|
||||||
let pretty (SaveContext save_context) w =
|
let name _ = "SaveContext"
|
||||||
let rec smul s n =
|
let fields (SaveContext x) =
|
||||||
if n <= 0 then
|
[
|
||||||
""
|
("entrance_index", S x.entrance_index),
|
||||||
else
|
("link_age", S x.link_age),
|
||||||
s ^ (smul s (n - 1))
|
("cutscene_index", S x.cutscene_index),
|
||||||
let x = w + 2
|
("day_time", S x.day_time),
|
||||||
let prep = smul " " w
|
("night_flag", S x.night_flag),
|
||||||
let header = "SaveContext {\n"
|
("num_days", S x.num_days),
|
||||||
let entrance_index = header ^ prep ^ " entrance_index = " ^ (show save_context.entrance_index) ^ ",\n"
|
("claim_days", S x.claim_days),
|
||||||
let link_age = entrance_index ^ prep ^ " link_age = " ^ (show save_context.link_age) ^ ",\n"
|
("deaths", S x.deaths),
|
||||||
let cutscene_index = link_age ^ prep ^ " cutscene_index = " ^ (show save_context.cutscene_index) ^ ",\n"
|
("n64dd_flag", S x.n64dd_flag),
|
||||||
let day_time = cutscene_index ^ prep ^ " day_time = " ^ (show save_context.day_time) ^ ",\n"
|
("health_capacity", S x.health_capacity),
|
||||||
let night_flag = day_time ^ prep ^ " night_flag = " ^ (show save_context.night_flag) ^ ",\n"
|
("health", S x.health),
|
||||||
let num_days = night_flag ^ prep ^ " num_days = " ^ (show save_context.num_days) ^ ",\n"
|
("magic_level", S x.magic_level),
|
||||||
let claim_days = num_days ^ prep ^ " claim_days = " ^ (show save_context.claim_days) ^ ",\n"
|
("magic", S x.magic),
|
||||||
let deaths = claim_days ^ prep ^ " deaths = " ^ (show save_context.deaths) ^ ",\n"
|
("rupees", S x.rupees),
|
||||||
let n64dd_flag = deaths ^ prep ^ " n64dd_flag = " ^ (show save_context.n64dd_flag) ^ ",\n"
|
("sword_health", S x.sword_health),
|
||||||
let health_capacity = n64dd_flag ^ prep ^ " health_capacity = " ^ (show save_context.health_capacity) ^ ",\n"
|
("navi_timer", S x.navi_timer),
|
||||||
let health = health_capacity ^ prep ^ " health = " ^ (show save_context.health) ^ ",\n"
|
("magic_acquired", S x.magic_acquired),
|
||||||
let magic_level = health ^ prep ^ " magic_level = " ^ (show save_context.magic_level) ^ ",\n"
|
("double_magic", S x.double_magic),
|
||||||
let magic = magic_level ^ prep ^ " magic = " ^ (show save_context.magic) ^ ",\n"
|
("double_defense", S x.double_defense),
|
||||||
let rupees = magic ^ prep ^ " rupees = " ^ (show save_context.rupees) ^ ",\n"
|
("bgs_flag", S x.bgs_flag),
|
||||||
let sword_health = rupees ^ prep ^ " sword_health = " ^ (show save_context.sword_health) ^ ",\n"
|
("ocarina_game_reward", S x.ocarina_game_reward),
|
||||||
let navi_timer = sword_health ^ prep ^ " navi_timer = " ^ (show save_context.navi_timer) ^ ",\n"
|
("child_equips", P x.child_equips),
|
||||||
let magic_acquired = navi_timer ^ prep ^ " magic_acquired = " ^ (show save_context.magic_acquired) ^ ",\n"
|
("adult_equips", P x.adult_equips)
|
||||||
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 ^ "}"
|
|
||||||
end
|
end
|
||||||
|
|
Loading…
Reference in a new issue