dropped ancient in-place compilation of SML
authorhaftmann
Thu Jul 08 16:41:57 2010 +0200 (2010-07-08)
changeset 377480af0d45257be
parent 37747 3a699743bcba
child 37749 c7e15d59c58d
dropped ancient in-place compilation of SML
src/Tools/Code/code_haskell.ML
src/Tools/Code/code_ml.ML
src/Tools/Code/code_scala.ML
src/Tools/Code/code_target.ML
     1.1 --- a/src/Tools/Code/code_haskell.ML	Thu Jul 08 16:28:18 2010 +0200
     1.2 +++ b/src/Tools/Code/code_haskell.ML	Thu Jul 08 16:41:57 2010 +0200
     1.3 @@ -390,7 +390,7 @@
     1.4            ^ code_of_pretty content)
     1.5        end
     1.6    in
     1.7 -    Code_Target.mk_serialization target NONE
     1.8 +    Code_Target.mk_serialization target
     1.9        (fn NONE => K () o map (code_writeln o snd) | SOME file => K () o map
    1.10          (write_module (check_destination file)))
    1.11        (rpair [] o cat_lines o map (code_of_pretty o snd))
     2.1 --- a/src/Tools/Code/code_ml.ML	Thu Jul 08 16:28:18 2010 +0200
     2.2 +++ b/src/Tools/Code/code_ml.ML	Thu Jul 08 16:41:57 2010 +0200
     2.3 @@ -907,7 +907,7 @@
     2.4          error ("Unknown statement name: " ^ labelled_name name);
     2.5    in (deresolver, nodes) end;
     2.6  
     2.7 -fun serialize_ml target compile print_module print_stmt raw_module_name with_signatures labelled_name
     2.8 +fun serialize_ml target print_module print_stmt raw_module_name with_signatures labelled_name
     2.9    reserved includes raw_module_alias _ syntax_tyco syntax_const (code_of_pretty, code_writeln) program stmt_names destination =
    2.10    let
    2.11      val is_cons = Code_Thingol.is_cons program;
    2.12 @@ -938,7 +938,6 @@
    2.13      val p = Pretty.chunks2 (map snd includes @ snd (print_nodes [] nodes));
    2.14    in
    2.15      Code_Target.mk_serialization target
    2.16 -      (case compile of SOME compile => SOME (compile o code_of_pretty) | NONE => NONE)
    2.17        (fn NONE => code_writeln | SOME file => File.write file o code_of_pretty)
    2.18        (rpair stmt_names' o code_of_pretty) p destination
    2.19    end;
    2.20 @@ -950,7 +949,7 @@
    2.21  
    2.22  fun evaluation_code_of thy target struct_name =
    2.23    Code_Target.serialize_custom thy (target, (fn _ => fn [] =>
    2.24 -    serialize_ml target (SOME (K ())) print_sml_module print_sml_stmt (SOME struct_name) true, literals_sml));
    2.25 +    serialize_ml target print_sml_module print_sml_stmt (SOME struct_name) true, literals_sml));
    2.26  
    2.27  
    2.28  (** formal checking of compiled code **)
    2.29 @@ -969,12 +968,11 @@
    2.30  fun isar_seri_sml module_name =
    2.31    Code_Target.parse_args (Scan.optional (Args.$$$ "no_signatures" >> K false) true
    2.32    >> (fn with_signatures => serialize_ml target_SML
    2.33 -      (SOME (use_text ML_Env.local_context (1, "generated code") false))
    2.34        print_sml_module print_sml_stmt module_name with_signatures));
    2.35  
    2.36  fun isar_seri_ocaml module_name =
    2.37    Code_Target.parse_args (Scan.optional (Args.$$$ "no_signatures" >> K false) true
    2.38 -  >> (fn with_signatures => serialize_ml target_OCaml NONE
    2.39 +  >> (fn with_signatures => serialize_ml target_OCaml
    2.40        print_ocaml_module print_ocaml_stmt module_name with_signatures));
    2.41  
    2.42  val setup =
     3.1 --- a/src/Tools/Code/code_scala.ML	Thu Jul 08 16:28:18 2010 +0200
     3.2 +++ b/src/Tools/Code/code_scala.ML	Thu Jul 08 16:41:57 2010 +0200
     3.3 @@ -382,7 +382,7 @@
     3.4          val _ = File.mkdir_leaf (Path.dir pathname);
     3.5        in File.write pathname (code_of_pretty content) end
     3.6    in
     3.7 -    Code_Target.mk_serialization target NONE
     3.8 +    Code_Target.mk_serialization target
     3.9        (fn NONE => K () o map (code_writeln o snd) | SOME file => K () o map
    3.10          (write_module (check_destination file)))
    3.11        (rpair [] o cat_lines o map (code_of_pretty o snd))
     4.1 --- a/src/Tools/Code/code_target.ML	Thu Jul 08 16:28:18 2010 +0200
     4.2 +++ b/src/Tools/Code/code_target.ML	Thu Jul 08 16:41:57 2010 +0200
     4.3 @@ -21,8 +21,7 @@
     4.4    type serialization
     4.5    val parse_args: 'a parser -> Token.T list -> 'a
     4.6    val stmt_names_of_destination: destination -> string list
     4.7 -  val mk_serialization: string -> ('a -> unit) option
     4.8 -    -> (Path.T option -> 'a -> unit)
     4.9 +  val mk_serialization: string -> (Path.T option -> 'a -> unit)
    4.10      -> ('a -> string * string option list)
    4.11      -> 'a -> serialization
    4.12    val serialize: theory -> string -> int option -> string option -> Token.T list
    4.13 @@ -30,7 +29,6 @@
    4.14    val serialize_custom: theory -> string * (serializer * literals)
    4.15      -> Code_Thingol.naming -> Code_Thingol.program -> string list -> string * string option list
    4.16    val the_literals: theory -> string -> literals
    4.17 -  val compile: serialization -> unit
    4.18    val export: serialization -> unit
    4.19    val file: Path.T -> serialization -> unit
    4.20    val string: string list -> serialization -> string
    4.21 @@ -64,10 +62,9 @@
    4.22  
    4.23  (** basics **)
    4.24  
    4.25 -datatype destination = Compile | Export | File of Path.T | String of string list;
    4.26 +datatype destination = Export | File of Path.T | String of string list;
    4.27  type serialization = destination -> (string * string option list) option;
    4.28  
    4.29 -fun compile f = (f Compile; ());
    4.30  fun export f = (f Export; ());
    4.31  fun file p f = (f (File p); ());
    4.32  fun string stmts f = fst (the (f (String stmts)));
    4.33 @@ -75,11 +72,9 @@
    4.34  fun stmt_names_of_destination (String stmts) = stmts
    4.35    | stmt_names_of_destination _ = [];
    4.36  
    4.37 -fun mk_serialization target (SOME comp) _ _ code Compile = (comp code; NONE)
    4.38 -  | mk_serialization target NONE _ _ _ Compile = error (target ^ ": no internal compilation")
    4.39 -  | mk_serialization target _ output _ code Export = (output NONE code ; NONE)
    4.40 -  | mk_serialization target _ output _ code (File file) = (output (SOME file) code; NONE)
    4.41 -  | mk_serialization target _ _ string code (String _) = SOME (string code);
    4.42 +fun mk_serialization target output _ code Export = (output NONE code ; NONE)
    4.43 +  | mk_serialization target output _ code (File file) = (output (SOME file) code; NONE)
    4.44 +  | mk_serialization target _ string code (String _) = SOME (string code);
    4.45  
    4.46  
    4.47  (** theory data **)
    4.48 @@ -382,9 +377,8 @@
    4.49    let
    4.50      val (cs', (naming, program)) = Code_Thingol.consts_program thy false cs;
    4.51      fun mk_seri_dest dest = case dest
    4.52 -     of NONE => compile
    4.53 -      | SOME "-" => export
    4.54 -      | SOME f => file (Path.explode f)
    4.55 +     of "-" => export
    4.56 +      | f => file (Path.explode f)
    4.57      val _ = map (fn (((target, module), dest), args) =>
    4.58        (mk_seri_dest dest (serialize thy target NONE module args naming program cs'))) seris;
    4.59    in () end;
    4.60 @@ -530,7 +524,7 @@
    4.61    (Scan.repeat1 Parse.term_group
    4.62    -- Scan.repeat (Parse.$$$ inK |-- Parse.name
    4.63       -- Scan.option (Parse.$$$ module_nameK |-- Parse.name)
    4.64 -     -- Scan.option (Parse.$$$ fileK |-- Parse.name)
    4.65 +     --| Parse.$$$ fileK -- Parse.name
    4.66       -- Scan.optional (Parse.$$$ "(" |-- Args.parse --| Parse.$$$ ")") []
    4.67    ) >> (fn (raw_cs, seris) => export_code_cmd raw_cs seris));
    4.68