amended some slips, rolling back currently dysfunctional export minimimalisation for Scala
authorhaftmann
Thu Feb 27 18:07:53 2014 +0100 (2014-02-27)
changeset 557767dd1971b39c1
parent 55775 1557a391a858
child 55794 8f4c6ef220e3
amended some slips, rolling back currently dysfunctional export minimimalisation for Scala
src/Tools/Code/code_ml.ML
src/Tools/Code/code_namespace.ML
src/Tools/Code/code_scala.ML
src/Tools/Code/code_target.ML
     1.1 --- a/src/Tools/Code/code_ml.ML	Thu Feb 27 16:07:21 2014 +0000
     1.2 +++ b/src/Tools/Code/code_ml.ML	Thu Feb 27 18:07:53 2014 +0100
     1.3 @@ -805,7 +805,7 @@
     1.4      Code_Namespace.hierarchical_program ctxt {
     1.5        module_name = module_name, reserved = reserved, identifiers = identifiers,
     1.6        empty_nsp = (reserved, reserved), namify_module = pair, namify_stmt = namify_stmt,
     1.7 -      cyclic_modules = false, class_transitive = false,
     1.8 +      cyclic_modules = false, class_transitive = true,
     1.9        class_relation_public = true, empty_data = (),
    1.10        memorize_data = K I, modify_stmts = modify_stmts }
    1.11    end;
     2.1 --- a/src/Tools/Code/code_namespace.ML	Thu Feb 27 16:07:21 2014 +0000
     2.2 +++ b/src/Tools/Code/code_namespace.ML	Thu Feb 27 18:07:53 2014 +0100
     2.3 @@ -95,9 +95,7 @@
     2.4        let
     2.5          val succs = Code_Symbol.Graph.Keys.dest o Code_Symbol.Graph.imm_succs gr;
     2.6          val deps1 = succs sym;
     2.7 -        val deps2 = if class_transitive
     2.8 -          then []
     2.9 -          else [] |> fold (union (op =)) (map succs deps1) |> subtract (op =) deps1
    2.10 +        val deps2 = [] |> fold (union (op =)) (map succs deps1) |> subtract (op =) deps1
    2.11        in (deps1, deps2) end;
    2.12    in
    2.13      { is_datatype_or_class = is_datatype_or_class,
    2.14 @@ -115,6 +113,7 @@
    2.15          | Code_Thingol.Classinst _ => (SOME Opaque, NONE)
    2.16          | Code_Thingol.Datatypecons _ => (SOME Public, SOME Opaque)
    2.17          | Code_Thingol.Classparam _ => (SOME Public, SOME Opaque)
    2.18 +        | Code_Thingol.Class _ => (SOME Opaque, NONE)
    2.19          | Code_Thingol.Classrel _ =>
    2.20             (if class_relation_public
    2.21              then (SOME Public, SOME Opaque)
     3.1 --- a/src/Tools/Code/code_scala.ML	Thu Feb 27 16:07:21 2014 +0000
     3.2 +++ b/src/Tools/Code/code_scala.ML	Thu Feb 27 18:07:53 2014 +0100
     3.3 @@ -145,17 +145,12 @@
     3.4              |> single
     3.5              |> enclose "(" ")"
     3.6            end;
     3.7 -    fun privatize Code_Namespace.Public = concat
     3.8 -      | privatize _ = concat o cons (str "private");
     3.9 -    fun privatize' Code_Namespace.Public = concat
    3.10 -      | privatize' Code_Namespace.Opaque = concat
    3.11 -      | privatize' _ = concat o cons (str "private");
    3.12      fun print_context tyvars vs sym = applify "[" "]"
    3.13        (fn (v, sort) => (Pretty.block o map str)
    3.14          (lookup_tyvar tyvars v :: maps (fn class => [" : ", deresolve_class class]) sort))
    3.15            NOBR ((str o deresolve) sym) vs;
    3.16      fun print_defhead export tyvars vars const vs params tys ty =
    3.17 -      privatize export [str "def", constraint (applify "(" ")" (fn (param, ty) =>
    3.18 +      concat [str "def", constraint (applify "(" ")" (fn (param, ty) =>
    3.19          constraint ((str o lookup_var vars) param) (print_typ tyvars NOBR ty))
    3.20            NOBR (print_context tyvars vs (Constant const)) (params ~~ tys)) (print_typ tyvars NOBR ty),
    3.21              str "="];
    3.22 @@ -218,7 +213,7 @@
    3.23              val tyvars = intro_tyvars (map (rpair []) vs) reserved;
    3.24              fun print_co ((co, vs_args), tys) =
    3.25                concat [Pretty.block ((applify "[" "]" (str o lookup_tyvar tyvars) NOBR
    3.26 -                ((privatize export o map str) ["final", "case", "class", deresolve_const co]) vs_args)
    3.27 +                ((concat o map str) ["final", "case", "class", deresolve_const co]) vs_args)
    3.28                  @@ enum "," "(" ")" (map (fn (v, arg) => constraint (str v) (print_typ tyvars NOBR arg))
    3.29                    (Name.invent_names (snd reserved) "a" tys))),
    3.30                  str "extends",
    3.31 @@ -227,7 +222,7 @@
    3.32                ];
    3.33            in
    3.34              Pretty.chunks (applify "[" "]" (str o lookup_tyvar tyvars)
    3.35 -              NOBR ((privatize' export o map str) ["abstract", "sealed", "class", deresolve_tyco tyco]) vs
    3.36 +              NOBR ((concat o map str) ["abstract", "sealed", "class", deresolve_tyco tyco]) vs
    3.37                  :: map print_co cos)
    3.38            end
    3.39        | print_stmt (Type_Class class, (export, Code_Thingol.Class (v, (classrels, classparams)))) =
    3.40 @@ -249,7 +244,7 @@
    3.41                  val auxs = Name.invent (snd proto_vars) "a" (length tys);
    3.42                  val vars = intro_vars auxs proto_vars;
    3.43                in
    3.44 -                privatize' export [str "def", constraint (Pretty.block [applify "(" ")"
    3.45 +                concat [str "def", constraint (Pretty.block [applify "(" ")"
    3.46                    (fn (aux, ty) => constraint ((str o lookup_var vars) aux)
    3.47                    (print_typ tyvars NOBR ty)) NOBR (add_typarg (deresolve_const classparam))
    3.48                    (auxs ~~ tys), str "(implicit ", str implicit_name, str ": ",
    3.49 @@ -260,7 +255,7 @@
    3.50            in
    3.51              Pretty.chunks (
    3.52                (Pretty.block_enclose
    3.53 -                (privatize' export ([str "trait", (add_typarg o deresolve_class) class]
    3.54 +                (concat ([str "trait", (add_typarg o deresolve_class) class]
    3.55                    @ the_list (print_super_classes classrels) @ [str "{"]), str "}")
    3.56                  (map print_classparam_val classparams))
    3.57                :: map print_classparam_def classparams
    3.58 @@ -289,7 +284,7 @@
    3.59                      (const, map (IVar o SOME) auxs))
    3.60                end;
    3.61            in
    3.62 -            Pretty.block_enclose (privatize export [str "implicit def",
    3.63 +            Pretty.block_enclose (concat [str "implicit def",
    3.64                constraint (print_context tyvars vs sym) (print_dicttyp tyvars classtyp),
    3.65                str "=", str "new", print_dicttyp tyvars classtyp, str "{"], str "}")
    3.66                  (map print_classparam_instance (inst_params @ superinst_params))
     4.1 --- a/src/Tools/Code/code_target.ML	Thu Feb 27 16:07:21 2014 +0000
     4.2 +++ b/src/Tools/Code/code_target.ML	Thu Feb 27 18:07:53 2014 +0100
     4.3 @@ -353,7 +353,7 @@
     4.4        const_syntax = Code_Symbol.lookup_constant_data printings,
     4.5        tyco_syntax = Code_Symbol.lookup_type_constructor_data printings,
     4.6        class_syntax = Code_Symbol.lookup_type_class_data printings },
     4.7 -      (syms_all, program))
     4.8 +      (subtract (op =) syms_hidden syms, program))
     4.9    end;
    4.10  
    4.11  fun mount_serializer ctxt target some_width module_name args program syms =
    4.12 @@ -374,7 +374,7 @@
    4.13        else (check_name true raw_module_name; raw_module_name)
    4.14      val (mounted_serializer, (prepared_syms, prepared_program)) =
    4.15        mount_serializer ctxt target some_width module_name args program syms;
    4.16 -  in mounted_serializer prepared_program (if all_public then prepared_syms else []) end;
    4.17 +  in mounted_serializer prepared_program (if all_public then [] else prepared_syms) end;
    4.18  
    4.19  fun assert_module_name "" = error "Empty module name not allowed here"
    4.20    | assert_module_name module_name = module_name;