amended some slips, rolling back currently dysfunctional export minimimalisation for Scala
authorhaftmann
Thu, 27 Feb 2014 18:07:53 +0100
changeset 55776 7dd1971b39c1
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
--- a/src/Tools/Code/code_ml.ML	Thu Feb 27 16:07:21 2014 +0000
+++ b/src/Tools/Code/code_ml.ML	Thu Feb 27 18:07:53 2014 +0100
@@ -805,7 +805,7 @@
     Code_Namespace.hierarchical_program ctxt {
       module_name = module_name, reserved = reserved, identifiers = identifiers,
       empty_nsp = (reserved, reserved), namify_module = pair, namify_stmt = namify_stmt,
-      cyclic_modules = false, class_transitive = false,
+      cyclic_modules = false, class_transitive = true,
       class_relation_public = true, empty_data = (),
       memorize_data = K I, modify_stmts = modify_stmts }
   end;
--- a/src/Tools/Code/code_namespace.ML	Thu Feb 27 16:07:21 2014 +0000
+++ b/src/Tools/Code/code_namespace.ML	Thu Feb 27 18:07:53 2014 +0100
@@ -95,9 +95,7 @@
       let
         val succs = Code_Symbol.Graph.Keys.dest o Code_Symbol.Graph.imm_succs gr;
         val deps1 = succs sym;
-        val deps2 = if class_transitive
-          then []
-          else [] |> fold (union (op =)) (map succs deps1) |> subtract (op =) deps1
+        val deps2 = [] |> fold (union (op =)) (map succs deps1) |> subtract (op =) deps1
       in (deps1, deps2) end;
   in
     { is_datatype_or_class = is_datatype_or_class,
@@ -115,6 +113,7 @@
         | Code_Thingol.Classinst _ => (SOME Opaque, NONE)
         | Code_Thingol.Datatypecons _ => (SOME Public, SOME Opaque)
         | Code_Thingol.Classparam _ => (SOME Public, SOME Opaque)
+        | Code_Thingol.Class _ => (SOME Opaque, NONE)
         | Code_Thingol.Classrel _ =>
            (if class_relation_public
             then (SOME Public, SOME Opaque)
--- a/src/Tools/Code/code_scala.ML	Thu Feb 27 16:07:21 2014 +0000
+++ b/src/Tools/Code/code_scala.ML	Thu Feb 27 18:07:53 2014 +0100
@@ -145,17 +145,12 @@
             |> single
             |> enclose "(" ")"
           end;
-    fun privatize Code_Namespace.Public = concat
-      | privatize _ = concat o cons (str "private");
-    fun privatize' Code_Namespace.Public = concat
-      | privatize' Code_Namespace.Opaque = concat
-      | privatize' _ = concat o cons (str "private");
     fun print_context tyvars vs sym = applify "[" "]"
       (fn (v, sort) => (Pretty.block o map str)
         (lookup_tyvar tyvars v :: maps (fn class => [" : ", deresolve_class class]) sort))
           NOBR ((str o deresolve) sym) vs;
     fun print_defhead export tyvars vars const vs params tys ty =
-      privatize export [str "def", constraint (applify "(" ")" (fn (param, ty) =>
+      concat [str "def", constraint (applify "(" ")" (fn (param, ty) =>
         constraint ((str o lookup_var vars) param) (print_typ tyvars NOBR ty))
           NOBR (print_context tyvars vs (Constant const)) (params ~~ tys)) (print_typ tyvars NOBR ty),
             str "="];
@@ -218,7 +213,7 @@
             val tyvars = intro_tyvars (map (rpair []) vs) reserved;
             fun print_co ((co, vs_args), tys) =
               concat [Pretty.block ((applify "[" "]" (str o lookup_tyvar tyvars) NOBR
-                ((privatize export o map str) ["final", "case", "class", deresolve_const co]) vs_args)
+                ((concat o map str) ["final", "case", "class", deresolve_const co]) vs_args)
                 @@ enum "," "(" ")" (map (fn (v, arg) => constraint (str v) (print_typ tyvars NOBR arg))
                   (Name.invent_names (snd reserved) "a" tys))),
                 str "extends",
@@ -227,7 +222,7 @@
               ];
           in
             Pretty.chunks (applify "[" "]" (str o lookup_tyvar tyvars)
-              NOBR ((privatize' export o map str) ["abstract", "sealed", "class", deresolve_tyco tyco]) vs
+              NOBR ((concat o map str) ["abstract", "sealed", "class", deresolve_tyco tyco]) vs
                 :: map print_co cos)
           end
       | print_stmt (Type_Class class, (export, Code_Thingol.Class (v, (classrels, classparams)))) =
@@ -249,7 +244,7 @@
                 val auxs = Name.invent (snd proto_vars) "a" (length tys);
                 val vars = intro_vars auxs proto_vars;
               in
-                privatize' export [str "def", constraint (Pretty.block [applify "(" ")"
+                concat [str "def", constraint (Pretty.block [applify "(" ")"
                   (fn (aux, ty) => constraint ((str o lookup_var vars) aux)
                   (print_typ tyvars NOBR ty)) NOBR (add_typarg (deresolve_const classparam))
                   (auxs ~~ tys), str "(implicit ", str implicit_name, str ": ",
@@ -260,7 +255,7 @@
           in
             Pretty.chunks (
               (Pretty.block_enclose
-                (privatize' export ([str "trait", (add_typarg o deresolve_class) class]
+                (concat ([str "trait", (add_typarg o deresolve_class) class]
                   @ the_list (print_super_classes classrels) @ [str "{"]), str "}")
                 (map print_classparam_val classparams))
               :: map print_classparam_def classparams
@@ -289,7 +284,7 @@
                     (const, map (IVar o SOME) auxs))
               end;
           in
-            Pretty.block_enclose (privatize export [str "implicit def",
+            Pretty.block_enclose (concat [str "implicit def",
               constraint (print_context tyvars vs sym) (print_dicttyp tyvars classtyp),
               str "=", str "new", print_dicttyp tyvars classtyp, str "{"], str "}")
                 (map print_classparam_instance (inst_params @ superinst_params))
--- a/src/Tools/Code/code_target.ML	Thu Feb 27 16:07:21 2014 +0000
+++ b/src/Tools/Code/code_target.ML	Thu Feb 27 18:07:53 2014 +0100
@@ -353,7 +353,7 @@
       const_syntax = Code_Symbol.lookup_constant_data printings,
       tyco_syntax = Code_Symbol.lookup_type_constructor_data printings,
       class_syntax = Code_Symbol.lookup_type_class_data printings },
-      (syms_all, program))
+      (subtract (op =) syms_hidden syms, program))
   end;
 
 fun mount_serializer ctxt target some_width module_name args program syms =
@@ -374,7 +374,7 @@
       else (check_name true raw_module_name; raw_module_name)
     val (mounted_serializer, (prepared_syms, prepared_program)) =
       mount_serializer ctxt target some_width module_name args program syms;
-  in mounted_serializer prepared_program (if all_public then prepared_syms else []) end;
+  in mounted_serializer prepared_program (if all_public then [] else prepared_syms) end;
 
 fun assert_module_name "" = error "Empty module name not allowed here"
   | assert_module_name module_name = module_name;