4 struct |
4 struct |
5 |
5 |
6 open OutputTutorial |
6 open OutputTutorial |
7 |
7 |
8 (* functions for generating appropriate expressions *) |
8 (* functions for generating appropriate expressions *) |
9 fun ml_val_open ys xs txt = |
9 fun ml_val_open ys istruc txt = |
10 let fun ml_val_open_aux ys txt = |
10 let |
|
11 fun ml_val_open_aux ys txt = |
11 "fn " ^ (case ys of [] => "_" | _ => enclose "(" ")" (commas ys)) ^ " => (" ^ txt ^ ")"; |
12 "fn " ^ (case ys of [] => "_" | _ => enclose "(" ")" (commas ys)) ^ " => (" ^ txt ^ ")"; |
12 in |
13 in |
13 (case xs of |
14 (case istruc of |
14 [] => ml_val_open_aux ys txt |
15 NONE => ml_val_open_aux ys txt |
15 | _ => ml_val_open_aux ys ("let open " ^ (space_implode " " xs) ^ " in " ^ txt ^ " end")) |
16 | SOME st => ml_val_open_aux ys ("let open " ^ st ^ " in " ^ txt ^ " end")) |
16 end; |
17 end |
17 |
18 |
18 fun ml_val txt = ml_val_open [] [] txt; |
19 fun ml_val txt = ml_val_open [] NONE txt; |
19 |
20 |
20 fun ml_pat (lhs, pat) = |
21 fun ml_pat (lhs, pat) = |
21 let |
22 let |
22 val pat' = implode (map (fn "\\<dots>" => "_" | s => s) (Symbol.explode pat)) |
23 val pat' = implode (map (fn "\\<dots>" => "_" | s => s) (Symbol.explode pat)) |
23 in "val " ^ pat' ^ " = " ^ lhs end; |
24 in "val " ^ pat' ^ " = " ^ lhs end; |
39 #> Source.exhaust |
40 #> Source.exhaust |
40 #> Chunks.transform_cmts |
41 #> Chunks.transform_cmts |
41 #> implode |
42 #> implode |
42 #> string_explode "" |
43 #> string_explode "" |
43 |
44 |
44 (* checks and prints open expressions *) |
45 (* checks and prints open expressions, calculates index entry *) |
45 fun output_ml {context = ctxt, ...} (txt, (ovars, structs)) = |
46 fun output_ml {context = ctxt, ...} (txt, (ovars, istruc)) = |
46 (eval_fn ctxt (ml_val_open ovars structs txt); |
47 (eval_fn ctxt (ml_val_open ovars istruc txt); |
47 if structs = [] |
48 case (istruc, Long_Name.base_name txt, Long_Name.qualifier txt) of |
48 then output_indexed (transform_cmts_str txt) {main = Code txt, minor = ""} |
49 (NONE, bn, "") => output_indexed (transform_cmts_str txt) {main = Code txt, minor = NoString} |
49 else output_indexed (transform_cmts_str txt) |
50 | (NONE, bn, qn) => output_indexed (transform_cmts_str txt) {main = Code bn, minor = IStruc qn} |
50 {main = Code txt, minor = ("in {\\tt\\slshape{}" ^ (implode structs) ^ "}")}) |
51 | (SOME st, _, _) => output_indexed (transform_cmts_str txt) {main = Code txt, minor = IStruc st}) |
51 |
52 |
52 val parser_ml = Scan.lift (Args.name -- |
53 val parser_ml = Scan.lift (Args.name -- |
53 (Scan.optional (Args.$$$ "for" |-- OuterParse.!!! (Scan.repeat1 Args.name)) [] -- |
54 (Scan.optional (Args.$$$ "for" |-- OuterParse.!!! (Scan.repeat1 Args.name)) [] -- |
54 Scan.optional (Args.$$$ "in" |-- OuterParse.!!! (Scan.repeat1 Args.name)) [])) |
55 Scan.option (Args.$$$ "in" |-- OuterParse.!!! Args.name))) |
55 |
56 |
56 (* checks and prints types and structures *) |
57 (* checks and prints types and structures *) |
57 fun output_struct {context = ctxt, ...} txt = |
58 fun output_struct {context = ctxt, ...} txt = |
58 (eval_fn ctxt (ml_struct txt); |
59 (eval_fn ctxt (ml_struct txt); |
59 output_indexed (string_explode "" txt) {main = Code txt, minor = "structure"}) |
60 output_indexed (string_explode "" txt) {main = Code txt, minor = Plain "structure"}) |
60 |
61 |
61 fun output_type {context = ctxt, ...} txt = |
62 fun output_type {context = ctxt, ...} txt = |
62 (eval_fn ctxt (ml_type txt); |
63 (eval_fn ctxt (ml_type txt); |
63 output_indexed (string_explode "" txt) {main = Code txt, minor = "type"}) |
64 output_indexed (string_explode "" txt) {main = Code txt, minor = Plain "type"}) |
64 |
65 |
65 (* checks and expression agains a result pattern *) |
66 (* checks and expression agains a result pattern *) |
66 fun output_response {context = ctxt, ...} (lhs, pat) = |
67 fun output_response {context = ctxt, ...} (lhs, pat) = |
67 (eval_fn ctxt (ml_pat (lhs, pat)); |
68 (eval_fn ctxt (ml_pat (lhs, pat)); |
68 output ((string_explode "" lhs) @ (string_explode "> " pat))) |
69 output ((string_explode "" lhs) @ (string_explode "> " pat))) |