proper checking of ML functors (in Poly/ML 5.2 or later);
authorwenzelm
Fri Apr 16 11:39:08 2010 +0200 (2010-04-16)
changeset 36163823c9400eb62
parent 36162 0bd034a80a9a
child 36164 532f4d1cb0fc
proper checking of ML functors (in Poly/ML 5.2 or later);
eliminated pathetic comments;
doc-src/antiquote_setup.ML
src/Pure/ML/ml_env.ML
src/Pure/Thy/thy_output.ML
     1.1 --- a/doc-src/antiquote_setup.ML	Fri Apr 16 10:52:10 2010 +0200
     1.2 +++ b/doc-src/antiquote_setup.ML	Fri Apr 16 11:39:08 2010 +0200
     1.3 @@ -54,7 +54,7 @@
     1.4  
     1.5  fun ml_structure (txt, _) = "functor XXX() = struct structure XX = " ^ txt ^ " end;";
     1.6  
     1.7 -fun ml_functor _ = "";  (*no check!*)
     1.8 +fun ml_functor (txt, _) = "ML_Env.check_functor " ^ ML_Syntax.print_string txt;
     1.9  
    1.10  fun index_ml name kind ml = ThyOutput.antiquotation name
    1.11    (Scan.lift (Args.name -- Scan.optional (Args.colon |-- Args.name) ""))
     2.1 --- a/src/Pure/ML/ml_env.ML	Fri Apr 16 10:52:10 2010 +0200
     2.2 +++ b/src/Pure/ML/ml_env.ML	Fri Apr 16 11:39:08 2010 +0200
     2.3 @@ -9,6 +9,7 @@
     2.4    val inherit: Context.generic -> Context.generic -> Context.generic
     2.5    val name_space: ML_Name_Space.T
     2.6    val local_context: use_context
     2.7 +  val check_functor: string -> unit
     2.8  end
     2.9  
    2.10  structure ML_Env: ML_ENV =
    2.11 @@ -88,5 +89,11 @@
    2.12    print = writeln,
    2.13    error = error};
    2.14  
    2.15 +val is_functor = is_some o #lookupFunct name_space;
    2.16 +
    2.17 +fun check_functor name =
    2.18 +  if is_functor "Table" (*lookup actually works*) andalso is_functor name then ()
    2.19 +  else error ("Unknown ML functor: " ^ quote name);
    2.20 +
    2.21  end;
    2.22  
     3.1 --- a/src/Pure/Thy/thy_output.ML	Fri Apr 16 10:52:10 2010 +0200
     3.2 +++ b/src/Pure/Thy/thy_output.ML	Fri Apr 16 11:39:08 2010 +0200
     3.3 @@ -599,7 +599,7 @@
     3.4  val _ = ml_text "ML" (fn txt => "fn _ => (" ^ txt ^ ");");
     3.5  val _ = ml_text "ML_type" (fn txt => "val _ = NONE : (" ^ txt ^ ") option;");
     3.6  val _ = ml_text "ML_struct" (fn txt => "functor XXX() = struct structure XX = " ^ txt ^ " end;");
     3.7 -val _ = ml_text "ML_functor" (K "");  (*no check!*)
     3.8 +val _ = ml_text "ML_functor" (fn txt => "ML_Env.check_functor " ^ ML_Syntax.print_string txt);
     3.9  val _ = ml_text "ML_text" (K "");
    3.10  
    3.11  end;