tuned printing of applications and let cascades
authorhaftmann
Thu, 29 Jul 2010 09:57:00 +0200
changeset 3830572f4630d4c43
parent 38304 e4640c2ceb43
child 38306 a9b52497661c
tuned printing of applications and let cascades
src/Tools/Code/code_scala.ML
     1.1 --- a/src/Tools/Code/code_scala.ML	Thu Jul 29 09:56:59 2010 +0200
     1.2 +++ b/src/Tools/Code/code_scala.ML	Thu Jul 29 09:57:00 2010 +0200
     1.3 @@ -79,24 +79,24 @@
     1.4          val arg_typs' = if is_pat orelse
     1.5            (is_none (syntax_const c) andalso is_singleton_constr c) then [] else arg_typs;
     1.6          val (l, print') = case syntax_const c
     1.7 -         of NONE => (args_num c, fn ts => applify "(" ")"
     1.8 +         of NONE => (args_num c, fn fxy => fn ts => applify "(" ")"
     1.9                (print_term tyvars is_pat some_thm vars NOBR) fxy
    1.10                  (applify "[" "]" (print_typ tyvars NOBR)
    1.11                    NOBR ((str o deresolve) c) arg_typs') ts)
    1.12 -          | SOME (Plain_const_syntax (k, s)) => (k, fn ts => applify "(" ")"
    1.13 +          | SOME (Plain_const_syntax (k, s)) => (k, fn fxy => fn ts => applify "(" ")"
    1.14                (print_term tyvars is_pat some_thm vars NOBR) fxy
    1.15                  (applify "[" "]" (print_typ tyvars NOBR)
    1.16                    NOBR (str s) arg_typs') ts)
    1.17            | SOME (Complex_const_syntax (k, print)) =>
    1.18 -              (k, fn ts => print (print_term tyvars is_pat some_thm) some_thm vars fxy
    1.19 +              (k, fn fxy => fn ts => print (print_term tyvars is_pat some_thm) some_thm vars fxy
    1.20                  (ts ~~ take k function_typs))
    1.21 -      in if k = l then print' ts
    1.22 +      in if k = l then print' fxy ts
    1.23        else if k < l then
    1.24          print_term tyvars is_pat some_thm vars fxy (Code_Thingol.eta_expand l app)
    1.25        else let
    1.26          val (ts1, ts23) = chop l ts;
    1.27        in
    1.28 -        Pretty.block (print' ts1 :: map (fn t => Pretty.block
    1.29 +        Pretty.block (print' BR ts1 :: map (fn t => Pretty.block
    1.30            [str ".apply(", print_term tyvars is_pat some_thm vars NOBR t, str ")"]) ts23)
    1.31        end end
    1.32      and print_bind tyvars some_thm fxy p =
    1.33 @@ -104,17 +104,19 @@
    1.34      and print_case tyvars some_thm vars fxy (cases as ((_, [_]), _)) =
    1.35            let
    1.36              val (binds, body) = Code_Thingol.unfold_let (ICase cases);
    1.37 -            fun print_match ((pat, ty), t) vars =
    1.38 -              vars
    1.39 -              |> print_bind tyvars some_thm BR pat
    1.40 -              |>> (fn p => concat [str "val", constraint p (print_typ tyvars NOBR ty),
    1.41 -                  str "=", print_term tyvars false some_thm vars NOBR t])
    1.42 -            val (all_ps, vars') = fold_map print_match binds vars;
    1.43 -            val (ps, p) = split_last all_ps;
    1.44 -          in brackify_block fxy
    1.45 -            (str "{")
    1.46 -            (ps @ Pretty.block [p, str ";"] @@ print_term tyvars false some_thm vars' NOBR body)
    1.47 -            (str "}")
    1.48 +            fun print_match ((IVar NONE, _), t) vars =
    1.49 +                  ((true, print_term tyvars false some_thm vars NOBR t), vars)
    1.50 +              | print_match ((pat, ty), t) vars =
    1.51 +                  vars
    1.52 +                  |> print_bind tyvars some_thm BR pat
    1.53 +                  |>> (fn p => (false, concat [str "val", constraint p (print_typ tyvars NOBR ty),
    1.54 +                      str "=", print_term tyvars false some_thm vars NOBR t]))
    1.55 +            val (seps_ps, vars') = fold_map print_match binds vars;
    1.56 +            val all_seps_ps = seps_ps @ [(true, print_term tyvars false some_thm vars' NOBR body)];
    1.57 +            fun insert_seps [(_, p)] = [p]
    1.58 +              | insert_seps ((_, p) :: (seps_ps as (sep, _) :: _)) =
    1.59 +                  (if sep then Pretty.block [p, str ";"] else p) :: insert_seps seps_ps
    1.60 +          in brackify_block fxy (str "{") (insert_seps all_seps_ps) (str "}")
    1.61            end
    1.62        | print_case tyvars some_thm vars fxy (((t, ty), clauses as _ :: _), _) =
    1.63            let