equal
deleted
inserted
replaced
112 |
112 |
113 |
113 |
114 (** tables of token translation functions **) |
114 (** tables of token translation functions **) |
115 |
115 |
116 fun lookup_tokentr tabs modes = |
116 fun lookup_tokentr tabs modes = |
117 let val trs = distinct (eq_fst (op =)) |
117 let val trs = distinct (eq_fst (op =)) (maps (these o AList.lookup (op =) tabs) (modes @ [""])) |
118 (List.concat (map (these o AList.lookup (op =) tabs) (modes @ [""]))) |
|
119 in fn c => Option.map fst (AList.lookup (op =) trs c) end; |
118 in fn c => Option.map fst (AList.lookup (op =) trs c) end; |
120 |
119 |
121 fun merge_tokentrtabs tabs1 tabs2 = |
120 fun merge_tokentrtabs tabs1 tabs2 = |
122 let |
121 let |
123 fun eq_tr ((c1, (_, s1)), (c2, (_, s2))) = c1 = c2 andalso s1 = s2; |
122 fun eq_tr ((c1, (_, s1)), (c2, (_, s2))) = c1 = c2 andalso s1 = s2; |
148 |
147 |
149 (** tables of translation rules **) |
148 (** tables of translation rules **) |
150 |
149 |
151 type ruletab = (Ast.ast * Ast.ast) list Symtab.table; |
150 type ruletab = (Ast.ast * Ast.ast) list Symtab.table; |
152 |
151 |
153 fun dest_ruletab tab = List.concat (map snd (Symtab.dest tab)); |
152 fun dest_ruletab tab = maps snd (Symtab.dest tab); |
154 |
153 |
155 |
154 |
156 (* empty, extend, merge ruletabs *) |
155 (* empty, extend, merge ruletabs *) |
157 |
156 |
158 val extend_ruletab = fold_rev (fn r => Symtab.update_list (Ast.head_of_rule r, r)); |
157 val extend_ruletab = fold_rev (fn r => Symtab.update_list (Ast.head_of_rule r, r)); |
472 cat_error msg ("The error(s) above occurred in translation pattern " ^ |
471 cat_error msg ("The error(s) above occurred in translation pattern " ^ |
473 quote str); |
472 quote str); |
474 |
473 |
475 fun prep_rules rd_pat raw_rules = |
474 fun prep_rules rd_pat raw_rules = |
476 let val rules = map (map_trrule rd_pat) raw_rules in |
475 let val rules = map (map_trrule rd_pat) raw_rules in |
477 (map check_rule (List.mapPartial parse_rule rules), |
476 (map check_rule (map_filter parse_rule rules), |
478 map check_rule (List.mapPartial print_rule rules)) |
477 map check_rule (map_filter print_rule rules)) |
479 end |
478 end |
480 |
479 |
481 in |
480 in |
482 |
481 |
483 val cert_rules = prep_rules I; |
482 val cert_rules = prep_rules I; |