+ | stream ->
+ start_block();
+ print_between force_newline print_anything_list stream;
+ end_block()
+
+and print_anything_list = function
+ [] -> ()
+ | [x] -> !anything x
+ | bef::((aft::_) as rest) ->
+ !anything bef;
+ let space =
+ (match bef with
+ Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
+ | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_)
+ | Ast.Token("if",_) | Ast.Token("while",_) -> true | _ -> false) or
+ (match aft with
+ Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
+ | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("{",_) -> true
+ | _ -> false) in
+ if space then pr_space ();
+ print_anything_list rest in
+
+let print_around printer term = function
+ Ast.NOTHING -> printer term
+ | Ast.BEFORE(bef,_) -> print_anything bef; printer term
+ | Ast.AFTER(aft,_) -> printer term; print_anything aft
+ | Ast.BEFOREAFTER(bef,aft,_) ->
+ print_anything bef; printer term; print_anything aft in
+
+let print_string_befaft fn fn1 x info =
+ let print ln col s = print_string (get_string_info s) ln col in
+ List.iter
+ (function (s,ln,col) -> fn1(); print ln col s; force_newline())
+ info.Ast.strbef;
+ fn x;
+ List.iter
+ (function (s,ln,col) -> force_newline(); fn1(); print ln col s)
+ info.Ast.straft in
+let print_meta (r,x) = print_text x in
+
+let print_pos l =
+ List.iter
+ (function
+ Ast.MetaPos(name,_,_,_,_) ->
+ let name = Ast.unwrap_mcode name in
+ print_text "@"; print_meta name)
+ l in
+
+(* --------------------------------------------------------------------- *)
+
+let mcode fn (s,info,mc,pos) =
+ let line = info.Ast.line in
+ let lcol = info.Ast.column in
+ match (generating,mc) with
+ (false,_) ->
+ (* printing for transformation *)
+ (* Here we don't care about the annotation on s. *)
+ let print_comments lb comments =
+ List.fold_left
+ (function line_before ->
+ function (str,line,col) ->
+ match line_before with
+ None ->
+ let str =
+ match str with
+ Ast.Noindent s -> unindent false; s
+ | Ast.Indent s -> s
+ | Ast.Space s -> s in
+ print_string str line col; Some line
+ | Some lb when line =|= lb ->
+ print_string (get_string_info str) line col; Some line
+ | _ ->
+ force_newline();
+ (* not super elegant to put side-effecting unindent in a let
+ expression... *)
+ let str =
+ match str with
+ Ast.Noindent s -> unindent false; s
+ | Ast.Indent s -> s
+ | Ast.Space s -> s in
+ print_string str line col; Some line)
+ lb comments in
+ let line_before = print_comments None info.Ast.strbef in
+ (match line_before with
+ None -> ()
+ | Some lb when lb =|= info.Ast.line -> ()
+ | _ -> force_newline());
+ fn s line lcol;
+ let _ = print_comments (Some info.Ast.line) info.Ast.straft in
+ (* newline after a pragma
+ should really store parsed versions of the strings, but make a cheap
+ effort here
+ print_comments takes care of interior newlines *)
+ ()
+ (* printing for rule generation *)
+ | (true, Ast.MINUS(_,_,_,plus_stream)) ->
+ force_newline();
+ print_text "- ";
+ fn s line lcol; print_pos pos;
+ (match plus_stream with
+ Ast.NOREPLACEMENT -> ()
+ | Ast.REPLACEMENT(plus_stream,ct) -> print_anything plus_stream)
+ | (true, Ast.CONTEXT(_,plus_streams)) ->
+ let fn s = force_newline(); fn s line lcol; print_pos pos in
+ print_around fn s plus_streams
+ | (true,Ast.PLUS Ast.ONE) ->
+ let fn s =
+ force_newline(); print_text "+ "; fn s line lcol; print_pos pos in
+ print_string_befaft fn (function _ -> print_text "+ ") s info
+ | (true,Ast.PLUS Ast.MANY) ->
+ let fn s =
+ force_newline(); print_text "++ "; fn s line lcol; print_pos pos in
+ print_string_befaft fn (function _ -> print_text "++ ") s info