# HG changeset patch # User haftmann # Date 1393520873 -3600 # Node ID 7dd1971b39c18874d738b9d151b9839d4ddcd26e # Parent 1557a391a8584729c71e11b591bfacdd523de134 amended some slips, rolling back currently dysfunctional export minimimalisation for Scala diff -r 1557a391a858 -r 7dd1971b39c1 src/Tools/Code/code_ml.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; diff -r 1557a391a858 -r 7dd1971b39c1 src/Tools/Code/code_namespace.ML --- 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) diff -r 1557a391a858 -r 7dd1971b39c1 src/Tools/Code/code_scala.ML --- 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)) diff -r 1557a391a858 -r 7dd1971b39c1 src/Tools/Code/code_target.ML --- 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;