tuned
authorhaftmann
Wed, 22 Sep 2010 12:22:47 +0200
changeset 398633dd559ab878b
parent 39835 e5448cf9a048
child 39864 b2e38c6c1400
tuned
src/Pure/Isar/named_target.ML
     1.1 --- a/src/Pure/Isar/named_target.ML	Wed Sep 22 11:46:28 2010 +0200
     1.2 +++ b/src/Pure/Isar/named_target.ML	Wed Sep 22 12:22:47 2010 +0200
     1.3 @@ -21,12 +21,7 @@
     1.4  
     1.5  datatype target = Target of {target: string, is_locale: bool, is_class: bool};
     1.6  
     1.7 -fun make_target target is_locale is_class =
     1.8 -  Target {target = target, is_locale = is_locale, is_class = is_class};
     1.9 -
    1.10 -val global_target = Target {target = "", is_locale = false, is_class = false};
    1.11 -
    1.12 -fun named_target _ "" = global_target
    1.13 +fun named_target _ "" = Target {target = "", is_locale = false, is_class = false}
    1.14    | named_target thy locale =
    1.15        if Locale.defined thy locale
    1.16        then Target {target = locale, is_locale = true, is_class = Class.is_class thy locale}
    1.17 @@ -103,7 +98,7 @@
    1.18      #> Class.const target ((b, mx), (type_params, lhs))
    1.19      #> pair (lhs, def))
    1.20  
    1.21 -fun target_foundation (ta as Target {target, is_locale, is_class, ...}) =
    1.22 +fun target_foundation (ta as Target {is_locale, is_class, ...}) =
    1.23    if is_class then class_foundation ta
    1.24    else if is_locale then locale_foundation ta
    1.25    else Generic_Target.theory_foundation;
    1.26 @@ -122,7 +117,7 @@
    1.27      |> Local_Theory.target (Locale.add_thmss locale kind local_facts')
    1.28    end
    1.29  
    1.30 -fun target_notes (ta as Target {target, is_locale, ...}) =
    1.31 +fun target_notes (Target {target, is_locale, ...}) =
    1.32    if is_locale then locale_notes target
    1.33      else fn kind => fn global_facts => fn _ => Generic_Target.theory_notes kind global_facts;
    1.34  
    1.35 @@ -148,7 +143,7 @@
    1.36  
    1.37  (* pretty *)
    1.38  
    1.39 -fun pretty_thy ctxt target is_class =
    1.40 +fun pretty (Target {target, is_locale, is_class, ...}) ctxt =
    1.41    let
    1.42      val thy = ProofContext.theory_of ctxt;
    1.43      val target_name =
    1.44 @@ -161,57 +156,50 @@
    1.45      val elems =
    1.46        (if null fixes then [] else [Element.Fixes fixes]) @
    1.47        (if null assumes then [] else [Element.Assumes assumes]);
    1.48 +    val body_elems =  if not is_locale then []
    1.49 +      else if null elems then [Pretty.block target_name]
    1.50 +      else [Pretty.block (Pretty.fbreaks (Pretty.block (target_name @ [Pretty.str " ="]) ::
    1.51 +        map (Pretty.chunks o Element.pretty_ctxt ctxt) elems))]
    1.52    in
    1.53 -    if target = "" then []
    1.54 -    else if null elems then [Pretty.block target_name]
    1.55 -    else [Pretty.block (Pretty.fbreaks (Pretty.block (target_name @ [Pretty.str " ="]) ::
    1.56 -      map (Pretty.chunks o Element.pretty_ctxt ctxt) elems))]
    1.57 +    Pretty.block [Pretty.command "theory", Pretty.brk 1,
    1.58 +      Pretty.str (Context.theory_name (ProofContext.theory_of ctxt))] :: body_elems
    1.59    end;
    1.60  
    1.61 -fun pretty (Target {target, is_class, ...}) ctxt =
    1.62 -  Pretty.block [Pretty.command "theory", Pretty.brk 1,
    1.63 -      Pretty.str (Context.theory_name (ProofContext.theory_of ctxt))] ::
    1.64 -    pretty_thy ctxt target is_class;
    1.65 -
    1.66  
    1.67  (* init *)
    1.68  
    1.69 -local
    1.70 -
    1.71  fun init_context (Target {target, is_locale, is_class}) =
    1.72    if not is_locale then ProofContext.init_global
    1.73    else if not is_class then Locale.init target
    1.74    else Class.init target;
    1.75  
    1.76 -fun init_target (ta as Target {target, ...}) thy =
    1.77 -  thy
    1.78 -  |> init_context ta
    1.79 -  |> Data.put (SOME ta)
    1.80 -  |> Local_Theory.init NONE (Long_Name.base_name target)
    1.81 -     {define = Generic_Target.define (target_foundation ta),
    1.82 -      notes = Generic_Target.notes (target_notes ta),
    1.83 -      abbrev = Generic_Target.abbrev (target_abbrev ta),
    1.84 -      declaration = fn pervasive => target_declaration ta
    1.85 -        { syntax = false, pervasive = pervasive },
    1.86 -      syntax_declaration = fn pervasive => target_declaration ta
    1.87 -        { syntax = true, pervasive = pervasive },
    1.88 -      pretty = pretty ta,
    1.89 -      exit = Local_Theory.target_of};
    1.90 +fun init target thy =
    1.91 +  let
    1.92 +    val ta = named_target thy target;
    1.93 +  in
    1.94 +    thy
    1.95 +    |> init_context ta
    1.96 +    |> Data.put (SOME ta)
    1.97 +    |> Local_Theory.init NONE (Long_Name.base_name target)
    1.98 +       {define = Generic_Target.define (target_foundation ta),
    1.99 +        notes = Generic_Target.notes (target_notes ta),
   1.100 +        abbrev = Generic_Target.abbrev (target_abbrev ta),
   1.101 +        declaration = fn pervasive => target_declaration ta
   1.102 +          { syntax = false, pervasive = pervasive },
   1.103 +        syntax_declaration = fn pervasive => target_declaration ta
   1.104 +          { syntax = true, pervasive = pervasive },
   1.105 +        pretty = pretty ta,
   1.106 +        exit = Local_Theory.target_of}
   1.107 +  end;
   1.108  
   1.109 -in
   1.110 -
   1.111 -fun init target thy = init_target (named_target thy target) thy;
   1.112 +val theory_init = init "";
   1.113  
   1.114  fun reinit lthy =
   1.115    (case peek lthy of
   1.116      SOME {target, ...} => init target o Local_Theory.exit_global
   1.117    | NONE => error "Not in a named target");
   1.118  
   1.119 -val theory_init = init_target global_target;
   1.120 -
   1.121  fun context_cmd "-" thy = init "" thy
   1.122    | context_cmd target thy = init (Locale.intern thy target) thy;
   1.123  
   1.124  end;
   1.125 -
   1.126 -end;