332 module_alias, class_syntax, tyco_syntax, const_syntax, program, |
332 module_alias, class_syntax, tyco_syntax, const_syntax, program, |
333 names } = |
333 names } = |
334 let |
334 let |
335 |
335 |
336 (* build program *) |
336 (* build program *) |
337 val { deresolver, hierarchical_program = sca_program } = |
337 val { deresolver, hierarchical_program = scala_program } = |
338 scala_program_of_program labelled_name (Name.make_context reserved_syms) module_alias program; |
338 scala_program_of_program labelled_name (Name.make_context reserved_syms) module_alias program; |
339 |
339 |
340 (* print statements *) |
340 (* print statements *) |
341 fun lookup_constr tyco constr = case Graph.get_node program tyco |
341 fun lookup_constr tyco constr = case Graph.get_node program tyco |
342 of Code_Thingol.Datatype (_, (_, constrs)) => |
342 of Code_Thingol.Datatype (_, (_, constrs)) => |
352 (length o fst o Code_Thingol.unfold_fun o the o AList.lookup (op =) |
352 (length o fst o Code_Thingol.unfold_fun o the o AList.lookup (op =) |
353 (classparams_of_class class)) c; |
353 (classparams_of_class class)) c; |
354 fun is_singleton_constr c = case Graph.get_node program c |
354 fun is_singleton_constr c = case Graph.get_node program c |
355 of Code_Thingol.Datatypecons (_, tyco) => null (lookup_constr tyco c) |
355 of Code_Thingol.Datatypecons (_, tyco) => null (lookup_constr tyco c) |
356 | _ => false; |
356 | _ => false; |
357 val print_stmt = print_scala_stmt labelled_name tyco_syntax const_syntax |
357 fun print_stmt prefix_fragments = print_scala_stmt labelled_name |
358 (make_vars reserved_syms) args_num is_singleton_constr; |
358 tyco_syntax const_syntax (make_vars reserved_syms) args_num |
359 |
359 is_singleton_constr (deresolver prefix_fragments, deresolver []); |
360 (* print nodes *) |
360 |
361 fun print_module base implicit_ps p = Pretty.chunks2 |
361 (* print modules *) |
362 ([str ("object " ^ base ^ " {")] |
|
363 @ (if null implicit_ps then [] else (single o Pretty.block) |
|
364 (str "import /*implicits*/" :: Pretty.brk 1 :: commas implicit_ps)) |
|
365 @ [p, str ("} /* object " ^ base ^ " */")]); |
|
366 fun print_implicit prefix_fragments implicit = |
362 fun print_implicit prefix_fragments implicit = |
367 let |
363 let |
368 val s = deresolver prefix_fragments implicit; |
364 val s = deresolver prefix_fragments implicit; |
369 in if length (Long_Name.explode s) = 1 then NONE else SOME (str s) end; |
365 in if length (Long_Name.explode s) = 1 then NONE else SOME (str s) end; |
370 fun print_node _ (_, Code_Namespace.Dummy) = NONE |
366 fun print_module prefix_fragments base implicits ps = Pretty.chunks2 |
371 | print_node prefix_fragments (name, Code_Namespace.Stmt stmt) = |
367 ([str ("object " ^ base ^ " {")] |
372 SOME (markup_stmt name (print_stmt (deresolver prefix_fragments, deresolver []) (name, stmt))) |
368 @ (case map_filter (print_implicit prefix_fragments) implicits |
373 | print_node prefix_fragments (name_fragment, Code_Namespace.Module (implicits, nodes)) = |
369 of [] => [] | implicit_ps => (single o Pretty.block) |
374 let |
370 (str "import /*implicits*/" :: Pretty.brk 1 :: commas implicit_ps)) |
375 val prefix_fragments' = prefix_fragments @ [name_fragment]; |
371 @ ps @ [str ("} /* object " ^ base ^ " */")]); |
376 in |
|
377 Option.map (print_module name_fragment |
|
378 (map_filter (print_implicit prefix_fragments') implicits)) |
|
379 (print_nodes prefix_fragments' nodes) |
|
380 end |
|
381 and print_nodes prefix_fragments nodes = let |
|
382 val ps = map_filter (fn name => print_node prefix_fragments (name, |
|
383 snd (Graph.get_node nodes name))) |
|
384 ((rev o flat o Graph.strong_conn) nodes); |
|
385 in if null ps then NONE else SOME (Pretty.chunks2 ps) end; |
|
386 |
372 |
387 (* serialization *) |
373 (* serialization *) |
388 val p = Pretty.chunks2 (map snd includes @ the_list (print_nodes [] sca_program)); |
374 val p = Pretty.chunks2 (map snd includes |
|
375 @ Code_Namespace.print_hierarchical { |
|
376 print_module = print_module, print_stmt = print_stmt, |
|
377 lift_markup = I } scala_program); |
389 fun write width NONE = writeln o format [] width |
378 fun write width NONE = writeln o format [] width |
390 | write width (SOME p) = File.write p o format [] width; |
379 | write width (SOME p) = File.write p o format [] width; |
391 in |
380 in |
392 Code_Target.serialization write (rpair (try (deresolver [])) ooo format) p |
381 Code_Target.serialization write (rpair (try (deresolver [])) ooo format) p |
393 end; |
382 end; |