src/Tools/Code/code_haskell.ML
changeset 44926 de3ed037c9a5
parent 44852 8ac91e7b6024
child 44940 56fd289398a2
equal deleted inserted replaced
44924:1a5811bfe837 44926:de3ed037c9a5
     4 Serializer for Haskell.
     4 Serializer for Haskell.
     5 *)
     5 *)
     6 
     6 
     7 signature CODE_HASKELL =
     7 signature CODE_HASKELL =
     8 sig
     8 sig
       
     9   val language_params: string
     9   val target: string
    10   val target: string
    10   val setup: theory -> theory
    11   val setup: theory -> theory
    11 end;
    12 end;
    12 
    13 
    13 structure Code_Haskell : CODE_HASKELL =
    14 structure Code_Haskell : CODE_HASKELL =
    14 struct
    15 struct
    15 
    16 
    16 val target = "Haskell";
    17 val target = "Haskell";
       
    18 
       
    19 val language_extensions =
       
    20     ["EmptyDataDecls", "RankNTypes", "ScopedTypeVariables"];
       
    21 
       
    22 val language_pragma =
       
    23     "{-# LANGUAGE " ^ commas language_extensions ^ " #-}";
       
    24 
       
    25 val language_params =
       
    26     space_implode " " (map (prefix "-X") language_extensions);
    17 
    27 
    18 open Basic_Code_Thingol;
    28 open Basic_Code_Thingol;
    19 open Code_Printer;
    29 open Code_Printer;
    20 
    30 
    21 infixr 5 @@;
    31 infixr 5 @@;
   346             val filepath = (Path.append destination o Path.ext "hs" o Path.explode o implode
   356             val filepath = (Path.append destination o Path.ext "hs" o Path.explode o implode
   347               o separate "/" o Long_Name.explode) module_name;
   357               o separate "/" o Long_Name.explode) module_name;
   348             val _ = Isabelle_System.mkdirs (Path.dir filepath);
   358             val _ = Isabelle_System.mkdirs (Path.dir filepath);
   349           in
   359           in
   350             (File.write filepath o format [] width o Pretty.chunks2)
   360             (File.write filepath o format [] width o Pretty.chunks2)
   351               [str "{-# LANGUAGE ScopedTypeVariables #-}", content]
   361               [str language_pragma, content]
   352           end
   362           end
   353       | write_module width NONE (_, content) = writeln (format [] width content);
   363       | write_module width NONE (_, content) = writeln (format [] width content);
   354   in
   364   in
   355     Code_Target.serialization
   365     Code_Target.serialization
   356       (fn width => fn destination => K () o map (write_module width destination))
   366       (fn width => fn destination => K () o map (write_module width destination))
   444 val setup =
   454 val setup =
   445   Code_Target.add_target
   455   Code_Target.add_target
   446     (target, { serializer = serializer, literals = literals,
   456     (target, { serializer = serializer, literals = literals,
   447       check = { env_var = "ISABELLE_GHC", make_destination = I,
   457       check = { env_var = "ISABELLE_GHC", make_destination = I,
   448         make_command = fn module_name =>
   458         make_command = fn module_name =>
   449           "\"$ISABELLE_GHC\" -XRankNTypes -XScopedTypeVariables -XEmptyDataDecls -odir build -hidir build -stubdir build -e \"\" " ^
   459           "\"$ISABELLE_GHC\" " ^ language_params  ^ " -odir build -hidir build -stubdir build -e \"\" " ^
   450             module_name ^ ".hs" } })
   460             module_name ^ ".hs" } })
   451   #> Code_Target.add_tyco_syntax target "fun" (SOME (2, fn print_typ => fn fxy => fn [ty1, ty2] =>
   461   #> Code_Target.add_tyco_syntax target "fun" (SOME (2, fn print_typ => fn fxy => fn [ty1, ty2] =>
   452       brackify_infix (1, R) fxy (
   462       brackify_infix (1, R) fxy (
   453         print_typ (INFX (1, X)) ty1,
   463         print_typ (INFX (1, X)) ty1,
   454         str "->",
   464         str "->",