src/Tools/Code/code_haskell.ML
author noschinl
Thu, 08 Sep 2011 12:23:11 +0200
changeset 45723 8ac91e7b6024
parent 45661 fddb09e6f84d
child 45797 de3ed037c9a5
permissions -rw-r--r--
call ghc with -XEmptyDataDecls
     1 (*  Title:      Tools/Code/code_haskell.ML
     2     Author:     Florian Haftmann, TU Muenchen
     3 
     4 Serializer for Haskell.
     5 *)
     6 
     7 signature CODE_HASKELL =
     8 sig
     9   val target: string
    10   val setup: theory -> theory
    11 end;
    12 
    13 structure Code_Haskell : CODE_HASKELL =
    14 struct
    15 
    16 val target = "Haskell";
    17 
    18 open Basic_Code_Thingol;
    19 open Code_Printer;
    20 
    21 infixr 5 @@;
    22 infixr 5 @|;
    23 
    24 
    25 (** Haskell serializer **)
    26 
    27 fun print_haskell_stmt labelled_name class_syntax tyco_syntax const_syntax
    28     reserved deresolve deriving_show =
    29   let
    30     fun class_name class = case class_syntax class
    31      of NONE => deresolve class
    32       | SOME class => class;
    33     fun print_typcontext tyvars vs = case maps (fn (v, sort) => map (pair v) sort) vs
    34      of [] => []
    35       | constraints => enum "," "(" ")" (
    36           map (fn (v, class) =>
    37             str (class_name class ^ " " ^ lookup_var tyvars v)) constraints)
    38           @@ str " => ";
    39     fun print_typforall tyvars vs = case map fst vs
    40      of [] => []
    41       | vnames => str "forall " :: Pretty.breaks
    42           (map (str o lookup_var tyvars) vnames) @ str "." @@ Pretty.brk 1;
    43     fun print_tyco_expr tyvars fxy (tyco, tys) =
    44       brackify fxy (str tyco :: map (print_typ tyvars BR) tys)
    45     and print_typ tyvars fxy (tycoexpr as tyco `%% tys) = (case tyco_syntax tyco
    46          of NONE => print_tyco_expr tyvars fxy (deresolve tyco, tys)
    47           | SOME (i, print) => print (print_typ tyvars) fxy tys)
    48       | print_typ tyvars fxy (ITyVar v) = (str o lookup_var tyvars) v;
    49     fun print_typdecl tyvars (vs, tycoexpr) =
    50       Pretty.block (print_typcontext tyvars vs @| print_tyco_expr tyvars NOBR tycoexpr);
    51     fun print_typscheme tyvars (vs, ty) =
    52       Pretty.block (print_typforall tyvars vs @ print_typcontext tyvars vs @| print_typ tyvars NOBR ty);
    53     fun print_term tyvars some_thm vars fxy (IConst c) =
    54           print_app tyvars some_thm vars fxy (c, [])
    55       | print_term tyvars some_thm vars fxy (t as (t1 `$ t2)) =
    56           (case Code_Thingol.unfold_const_app t
    57            of SOME app => print_app tyvars some_thm vars fxy app
    58             | _ =>
    59                 brackify fxy [
    60                   print_term tyvars some_thm vars NOBR t1,
    61                   print_term tyvars some_thm vars BR t2
    62                 ])
    63       | print_term tyvars some_thm vars fxy (IVar NONE) =
    64           str "_"
    65       | print_term tyvars some_thm vars fxy (IVar (SOME v)) =
    66           (str o lookup_var vars) v
    67       | print_term tyvars some_thm vars fxy (t as _ `|=> _) =
    68           let
    69             val (binds, t') = Code_Thingol.unfold_pat_abs t;
    70             val (ps, vars') = fold_map (print_bind tyvars some_thm BR o fst) binds vars;
    71           in brackets (str "\\" :: ps @ str "->" @@ print_term tyvars some_thm vars' NOBR t') end
    72       | print_term tyvars some_thm vars fxy (ICase (cases as (_, t0))) =
    73           (case Code_Thingol.unfold_const_app t0
    74            of SOME (c_ts as ((c, _), _)) => if is_none (const_syntax c)
    75                 then print_case tyvars some_thm vars fxy cases
    76                 else print_app tyvars some_thm vars fxy c_ts
    77             | NONE => print_case tyvars some_thm vars fxy cases)
    78     and print_app_expr tyvars some_thm vars ((c, ((_, (function_typs, body_typ)), annotate)), ts) =
    79       let
    80         val ty = Library.foldr (fn (ty1, ty2) => Code_Thingol.fun_tyco `%% [ty1, ty2]) (function_typs, body_typ)
    81         fun put_annotation c = brackets [c, str "::", print_typ tyvars NOBR ty]
    82       in 
    83         ((if annotate then put_annotation else I)
    84           ((str o deresolve) c)) :: map (print_term tyvars some_thm vars BR) ts
    85       end
    86     and print_app tyvars = gen_print_app (print_app_expr tyvars) (print_term tyvars) const_syntax
    87     and print_bind tyvars some_thm fxy p = gen_print_bind (print_term tyvars) some_thm fxy p
    88     and print_case tyvars some_thm vars fxy (cases as ((_, [_]), _)) =
    89           let
    90             val (binds, body) = Code_Thingol.unfold_let (ICase cases);
    91             fun print_match ((pat, ty), t) vars =
    92               vars
    93               |> print_bind tyvars some_thm BR pat
    94               |>> (fn p => semicolon [p, str "=", print_term tyvars some_thm vars NOBR t])
    95             val (ps, vars') = fold_map print_match binds vars;
    96           in brackify_block fxy (str "let {")
    97             ps
    98             (concat [str "}", str "in", print_term tyvars some_thm vars' NOBR body])
    99           end
   100       | print_case tyvars some_thm vars fxy (((t, ty), clauses as _ :: _), _) =
   101           let
   102             fun print_select (pat, body) =
   103               let
   104                 val (p, vars') = print_bind tyvars some_thm NOBR pat vars;
   105               in semicolon [p, str "->", print_term tyvars some_thm vars' NOBR body] end;
   106           in Pretty.block_enclose
   107             (concat [str "(case", print_term tyvars some_thm vars NOBR t, str "of", str "{"], str "})")
   108             (map print_select clauses)
   109           end
   110       | print_case tyvars some_thm vars fxy ((_, []), _) =
   111           (brackify fxy o Pretty.breaks o map str) ["error", "\"empty case\""];
   112     fun print_stmt (name, Code_Thingol.Fun (_, (((vs, ty), raw_eqs), _))) =
   113           let
   114             val tyvars = intro_vars (map fst vs) reserved;
   115             fun print_err n =
   116               semicolon (
   117                 (str o deresolve) name
   118                 :: map str (replicate n "_")
   119                 @ str "="
   120                 :: str "error"
   121                 @@ (str o ML_Syntax.print_string
   122                     o Long_Name.base_name o Long_Name.qualifier) name
   123               );
   124             fun print_eqn ((ts, t), (some_thm, _)) =
   125               let
   126                 val consts = fold Code_Thingol.add_constnames (t :: ts) [];
   127                 val vars = reserved
   128                   |> intro_base_names
   129                       (is_none o const_syntax) deresolve consts
   130                   |> intro_vars ((fold o Code_Thingol.fold_varnames)
   131                       (insert (op =)) ts []);
   132               in
   133                 semicolon (
   134                   (str o deresolve) name
   135                   :: map (print_term tyvars some_thm vars BR) ts
   136                   @ str "="
   137                   @@ print_term tyvars some_thm vars NOBR t
   138                 )
   139               end;
   140           in
   141             Pretty.chunks (
   142               semicolon [
   143                 (str o suffix " ::" o deresolve) name,
   144                 print_typscheme tyvars (vs, ty)
   145               ]
   146               :: (case filter (snd o snd) raw_eqs
   147                of [] => [print_err ((length o fst o Code_Thingol.unfold_fun) ty)]
   148                 | eqs => map print_eqn eqs)
   149             )
   150           end
   151       | print_stmt (name, Code_Thingol.Datatype (_, (vs, []))) =
   152           let
   153             val tyvars = intro_vars (map fst vs) reserved;
   154           in
   155             semicolon [
   156               str "data",
   157               print_typdecl tyvars (vs, (deresolve name, map (ITyVar o fst) vs))
   158             ]
   159           end
   160       | print_stmt (name, Code_Thingol.Datatype (_, (vs, [((co, _), [ty])]))) =
   161           let
   162             val tyvars = intro_vars (map fst vs) reserved;
   163           in
   164             semicolon (
   165               str "newtype"
   166               :: print_typdecl tyvars (vs, (deresolve name, map (ITyVar o fst) vs))
   167               :: str "="
   168               :: (str o deresolve) co
   169               :: print_typ tyvars BR ty
   170               :: (if deriving_show name then [str "deriving (Read, Show)"] else [])
   171             )
   172           end
   173       | print_stmt (name, Code_Thingol.Datatype (_, (vs, co :: cos))) =
   174           let
   175             val tyvars = intro_vars (map fst vs) reserved;
   176             fun print_co ((co, _), tys) =
   177               concat (
   178                 (str o deresolve) co
   179                 :: map (print_typ tyvars BR) tys
   180               )
   181           in
   182             semicolon (
   183               str "data"
   184               :: print_typdecl tyvars (vs, (deresolve name, map (ITyVar o fst) vs))
   185               :: str "="
   186               :: print_co co
   187               :: map ((fn p => Pretty.block [str "| ", p]) o print_co) cos
   188               @ (if deriving_show name then [str "deriving (Read, Show)"] else [])
   189             )
   190           end
   191       | print_stmt (name, Code_Thingol.Class (_, (v, (super_classes, classparams)))) =
   192           let
   193             val tyvars = intro_vars [v] reserved;
   194             fun print_classparam (classparam, ty) =
   195               semicolon [
   196                 (str o deresolve) classparam,
   197                 str "::",
   198                 print_typ tyvars NOBR ty
   199               ]
   200           in
   201             Pretty.block_enclose (
   202               Pretty.block [
   203                 str "class ",
   204                 Pretty.block (print_typcontext tyvars [(v, map fst super_classes)]),
   205                 str (deresolve name ^ " " ^ lookup_var tyvars v),
   206                 str " where {"
   207               ],
   208               str "};"
   209             ) (map print_classparam classparams)
   210           end
   211       | print_stmt (_, Code_Thingol.Classinst ((class, (tyco, vs)), (_, (classparam_instances, _)))) =
   212           let
   213             val tyvars = intro_vars (map fst vs) reserved;
   214             fun requires_args classparam = case const_syntax classparam
   215              of NONE => NONE
   216               | SOME (Code_Printer.Plain_const_syntax _) => SOME 0
   217               | SOME (Code_Printer.Complex_const_syntax (k,_ )) => SOME k;
   218             fun print_classparam_instance ((classparam, const), (thm, _)) =
   219               case requires_args classparam
   220                of NONE => semicolon [
   221                       (str o Long_Name.base_name o deresolve) classparam,
   222                       str "=",
   223                       print_app tyvars (SOME thm) reserved NOBR (const, [])
   224                     ]
   225                 | SOME k =>
   226                     let
   227                       val (c, ((_, tys), _)) = const; (* FIXME: pass around the need annotation flag here? *)
   228                       val (vs, rhs) = (apfst o map) fst
   229                         (Code_Thingol.unfold_abs (Code_Thingol.eta_expand k (const, [])));
   230                       val s = if (is_some o const_syntax) c
   231                         then NONE else (SOME o Long_Name.base_name o deresolve) c;
   232                       val vars = reserved
   233                         |> intro_vars (map_filter I (s :: vs));
   234                       val lhs = IConst (classparam, ((([], []), tys), false (* FIXME *))) `$$ map IVar vs;
   235                         (*dictionaries are not relevant at this late stage*)
   236                     in
   237                       semicolon [
   238                         print_term tyvars (SOME thm) vars NOBR lhs,
   239                         str "=",
   240                         print_term tyvars (SOME thm) vars NOBR rhs
   241                       ]
   242                     end;
   243           in
   244             Pretty.block_enclose (
   245               Pretty.block [
   246                 str "instance ",
   247                 Pretty.block (print_typcontext tyvars vs),
   248                 str (class_name class ^ " "),
   249                 print_typ tyvars BR (tyco `%% map (ITyVar o fst) vs),
   250                 str " where {"
   251               ],
   252               str "};"
   253             ) (map print_classparam_instance classparam_instances)
   254           end;
   255   in print_stmt end;
   256 
   257 fun haskell_program_of_program labelled_name module_alias module_prefix reserved =
   258   let
   259     fun namify_fun upper base (nsp_fun, nsp_typ) =
   260       let
   261         val (base', nsp_fun') =
   262           Name.variant (if upper then first_upper base else base) nsp_fun;
   263       in (base', (nsp_fun', nsp_typ)) end;
   264     fun namify_typ base (nsp_fun, nsp_typ) =
   265       let
   266         val (base', nsp_typ') = Name.variant (first_upper base) nsp_typ;
   267       in (base', (nsp_fun, nsp_typ')) end;
   268     fun namify_stmt (Code_Thingol.Fun (_, (_, SOME _))) = pair
   269       | namify_stmt (Code_Thingol.Fun _) = namify_fun false
   270       | namify_stmt (Code_Thingol.Datatype _) = namify_typ
   271       | namify_stmt (Code_Thingol.Datatypecons _) = namify_fun true
   272       | namify_stmt (Code_Thingol.Class _) = namify_typ
   273       | namify_stmt (Code_Thingol.Classrel _) = pair
   274       | namify_stmt (Code_Thingol.Classparam _) = namify_fun false
   275       | namify_stmt (Code_Thingol.Classinst _) = pair;
   276     fun select_stmt (Code_Thingol.Fun (_, (_, SOME _))) = false
   277       | select_stmt (Code_Thingol.Fun _) = true
   278       | select_stmt (Code_Thingol.Datatype _) = true
   279       | select_stmt (Code_Thingol.Datatypecons _) = false
   280       | select_stmt (Code_Thingol.Class _) = true
   281       | select_stmt (Code_Thingol.Classrel _) = false
   282       | select_stmt (Code_Thingol.Classparam _) = false
   283       | select_stmt (Code_Thingol.Classinst _) = true;
   284   in
   285     Code_Namespace.flat_program labelled_name
   286       { module_alias = module_alias, module_prefix = module_prefix,
   287         reserved = reserved, empty_nsp = (reserved, reserved), namify_stmt = namify_stmt,
   288         modify_stmt = fn stmt => if select_stmt stmt then SOME stmt else NONE }
   289   end;
   290 
   291 fun serialize_haskell module_prefix string_classes { labelled_name, reserved_syms,
   292     includes, module_alias, class_syntax, tyco_syntax, const_syntax } program =
   293   let
   294 
   295     (* build program *)
   296     val reserved = fold (insert (op =) o fst) includes reserved_syms;
   297     val { deresolver, flat_program = haskell_program } = haskell_program_of_program
   298       labelled_name module_alias module_prefix (Name.make_context reserved) program;
   299 
   300     (* print statements *)
   301     fun deriving_show tyco =
   302       let
   303         fun deriv _ "fun" = false
   304           | deriv tycos tyco = not (tyco = Code_Thingol.fun_tyco)
   305               andalso (member (op =) tycos tyco
   306               orelse case try (Graph.get_node program) tyco
   307                 of SOME (Code_Thingol.Datatype (_, (_, cs))) => forall (deriv' (tyco :: tycos))
   308                     (maps snd cs)
   309                  | NONE => true)
   310         and deriv' tycos (tyco `%% tys) = deriv tycos tyco
   311               andalso forall (deriv' tycos) tys
   312           | deriv' _ (ITyVar _) = true
   313       in deriv [] tyco end;
   314     fun print_stmt deresolve = print_haskell_stmt labelled_name
   315       class_syntax tyco_syntax const_syntax (make_vars reserved)
   316       deresolve
   317       (if string_classes then deriving_show else K false);
   318 
   319     (* print modules *)
   320     val import_includes_ps =
   321       map (fn (name, _) => str ("import qualified " ^ name ^ ";")) includes;
   322     fun print_module_frame module_name ps =
   323       (module_name, Pretty.chunks2 (
   324         str ("module " ^ module_name ^ " where {")
   325         :: ps
   326         @| str "}"
   327       ));
   328     fun print_module module_name (gr, imports) =
   329       let
   330         val deresolve = deresolver module_name
   331         fun print_import module_name = (semicolon o map str) ["import qualified", module_name];
   332         val import_ps = import_includes_ps @ map (print_import o fst) imports;
   333         fun print_stmt' gr name = case Graph.get_node gr name
   334          of (_, NONE) => NONE
   335           | (_, SOME stmt) => SOME (markup_stmt name (print_stmt deresolve (name, stmt)));
   336         val body_ps = map_filter (print_stmt' gr) ((flat o rev o Graph.strong_conn) gr);
   337       in
   338         print_module_frame module_name
   339           ((if null import_ps then [] else [Pretty.chunks import_ps]) @ body_ps)
   340       end;
   341 
   342     (*serialization*)
   343     fun write_module width (SOME destination) (module_name, content) =
   344           let
   345             val _ = File.check_dir destination;
   346             val filepath = (Path.append destination o Path.ext "hs" o Path.explode o implode
   347               o separate "/" o Long_Name.explode) module_name;
   348             val _ = Isabelle_System.mkdirs (Path.dir filepath);
   349           in
   350             (File.write filepath o format [] width o Pretty.chunks2)
   351               [str "{-# LANGUAGE ScopedTypeVariables #-}", content]
   352           end
   353       | write_module width NONE (_, content) = writeln (format [] width content);
   354   in
   355     Code_Target.serialization
   356       (fn width => fn destination => K () o map (write_module width destination))
   357       (fn present => fn width => rpair (try (deresolver ""))
   358         o format present width o Pretty.chunks o map snd)
   359       (map (uncurry print_module_frame o apsnd single) includes
   360         @ map (fn module_name => print_module module_name (Graph.get_node haskell_program module_name))
   361           ((flat o rev o Graph.strong_conn) haskell_program))
   362   end;
   363 
   364 val serializer : Code_Target.serializer =
   365   Code_Target.parse_args (Scan.optional (Args.$$$ "root" -- Args.colon |-- Args.name) ""
   366     -- Scan.optional (Args.$$$ "string_classes" >> K true) false
   367     >> (fn (module_prefix, string_classes) =>
   368       serialize_haskell module_prefix string_classes));
   369 
   370 val literals = let
   371   fun char_haskell c =
   372     let
   373       val s = ML_Syntax.print_char c;
   374     in if s = "'" then "\\'" else s end;
   375   fun numeral_haskell k = if k >= 0 then string_of_int k
   376     else Library.enclose "(" ")" (signed_string_of_int k);
   377 in Literals {
   378   literal_char = Library.enclose "'" "'" o char_haskell,
   379   literal_string = quote o translate_string char_haskell,
   380   literal_numeral = numeral_haskell,
   381   literal_positive_numeral = numeral_haskell,
   382   literal_alternative_numeral = numeral_haskell,
   383   literal_naive_numeral = numeral_haskell,
   384   literal_list = enum "," "[" "]",
   385   infix_cons = (5, ":")
   386 } end;
   387 
   388 
   389 (** optional monad syntax **)
   390 
   391 fun pretty_haskell_monad c_bind =
   392   let
   393     fun dest_bind t1 t2 = case Code_Thingol.split_pat_abs t2
   394      of SOME ((pat, ty), t') =>
   395           SOME ((SOME ((pat, ty), true), t1), t')
   396       | NONE => NONE;
   397     fun dest_monad c_bind_name (IConst (c, _) `$ t1 `$ t2) =
   398           if c = c_bind_name then dest_bind t1 t2
   399           else NONE
   400       | dest_monad _ t = case Code_Thingol.split_let t
   401          of SOME (((pat, ty), tbind), t') =>
   402               SOME ((SOME ((pat, ty), false), tbind), t')
   403           | NONE => NONE;
   404     fun implode_monad c_bind_name = Code_Thingol.unfoldr (dest_monad c_bind_name);
   405     fun print_monad print_bind print_term (NONE, t) vars =
   406           (semicolon [print_term vars NOBR t], vars)
   407       | print_monad print_bind print_term (SOME ((bind, _), true), t) vars = vars
   408           |> print_bind NOBR bind
   409           |>> (fn p => semicolon [p, str "<-", print_term vars NOBR t])
   410       | print_monad print_bind print_term (SOME ((bind, _), false), t) vars = vars
   411           |> print_bind NOBR bind
   412           |>> (fn p => semicolon [str "let", str "{", p, str "=", print_term vars NOBR t, str "}"]);
   413     fun pretty _ [c_bind'] print_term thm vars fxy [(t1, _), (t2, _)] = case dest_bind t1 t2
   414      of SOME (bind, t') => let
   415           val (binds, t'') = implode_monad c_bind' t'
   416           val (ps, vars') = fold_map (print_monad (gen_print_bind (K print_term) thm) print_term)
   417             (bind :: binds) vars;
   418         in
   419           (brackify fxy o single o enclose "do { " " }" o Pretty.breaks)
   420             (ps @| print_term vars' NOBR t'')
   421         end
   422       | NONE => brackify_infix (1, L) fxy
   423           (print_term vars (INFX (1, L)) t1, str ">>=", print_term vars (INFX (1, X)) t2)
   424   in (2, ([c_bind], pretty)) end;
   425 
   426 fun add_monad target' raw_c_bind thy =
   427   let
   428     val c_bind = Code.read_const thy raw_c_bind;
   429   in if target = target' then
   430     thy
   431     |> Code_Target.add_const_syntax target c_bind
   432         (SOME (Code_Printer.complex_const_syntax (pretty_haskell_monad c_bind)))
   433   else error "Only Haskell target allows for monad syntax" end;
   434 
   435 
   436 (** Isar setup **)
   437 
   438 val _ =
   439   Outer_Syntax.command "code_monad" "define code syntax for monads" Keyword.thy_decl (
   440     Parse.term_group -- Parse.name >> (fn (raw_bind, target) =>
   441       Toplevel.theory  (add_monad target raw_bind))
   442   );
   443 
   444 val setup =
   445   Code_Target.add_target
   446     (target, { serializer = serializer, literals = literals,
   447       check = { env_var = "ISABELLE_GHC", make_destination = I,
   448         make_command = fn module_name =>
   449           "\"$ISABELLE_GHC\" -XRankNTypes -XScopedTypeVariables -XEmptyDataDecls -odir build -hidir build -stubdir build -e \"\" " ^
   450             module_name ^ ".hs" } })
   451   #> Code_Target.add_tyco_syntax target "fun" (SOME (2, fn print_typ => fn fxy => fn [ty1, ty2] =>
   452       brackify_infix (1, R) fxy (
   453         print_typ (INFX (1, X)) ty1,
   454         str "->",
   455         print_typ (INFX (1, R)) ty2
   456       )))
   457   #> fold (Code_Target.add_reserved target) [
   458       "hiding", "deriving", "where", "case", "of", "infix", "infixl", "infixr",
   459       "import", "default", "forall", "let", "in", "class", "qualified", "data",
   460       "newtype", "instance", "if", "then", "else", "type", "as", "do", "module"
   461     ]
   462   #> fold (Code_Target.add_reserved target) [
   463       "Prelude", "Main", "Bool", "Maybe", "Either", "Ordering", "Char", "String", "Int",
   464       "Integer", "Float", "Double", "Rational", "IO", "Eq", "Ord", "Enum", "Bounded",
   465       "Num", "Real", "Integral", "Fractional", "Floating", "RealFloat", "Monad", "Functor",
   466       "AlreadyExists", "ArithException", "ArrayException", "AssertionFailed", "AsyncException",
   467       "BlockedOnDeadMVar", "Deadlock", "Denormal", "DivideByZero", "DotNetException", "DynException",
   468       "Dynamic", "EOF", "EQ", "EmptyRec", "ErrorCall", "ExitException", "ExitFailure",
   469       "ExitSuccess", "False", "GT", "HeapOverflow",
   470       "IOError", "IOException", "IllegalOperation",
   471       "IndexOutOfBounds", "Just", "Key", "LT", "Left", "LossOfPrecision", "NoMethodError",
   472       "NoSuchThing", "NonTermination", "Nothing", "Obj", "OtherError", "Overflow",
   473       "PatternMatchFail", "PermissionDenied", "ProtocolError", "RecConError", "RecSelError",
   474       "RecUpdError", "ResourceBusy", "ResourceExhausted", "Right", "StackOverflow",
   475       "ThreadKilled", "True", "TyCon", "TypeRep", "UndefinedElement", "Underflow",
   476       "UnsupportedOperation", "UserError", "abs", "absReal", "acos", "acosh", "all",
   477       "and", "any", "appendFile", "asTypeOf", "asciiTab", "asin", "asinh", "atan",
   478       "atan2", "atanh", "basicIORun", "blockIO", "boundedEnumFrom", "boundedEnumFromThen",
   479       "boundedEnumFromThenTo", "boundedEnumFromTo", "boundedPred", "boundedSucc", "break",
   480       "catch", "catchException", "ceiling", "compare", "concat", "concatMap", "const",
   481       "cos", "cosh", "curry", "cycle", "decodeFloat", "denominator", "div", "divMod",
   482       "doubleToRatio", "doubleToRational", "drop", "dropWhile", "either", "elem",
   483       "emptyRec", "encodeFloat", "enumFrom", "enumFromThen", "enumFromThenTo",
   484       "enumFromTo", "error", "even", "exp", "exponent", "fail", "filter", "flip",
   485       "floatDigits", "floatProperFraction", "floatRadix", "floatRange", "floatToRational",
   486       "floor", "fmap", "foldl", "foldl'", "foldl1", "foldr", "foldr1", "fromDouble",
   487       "fromEnum", "fromEnum_0", "fromInt", "fromInteger", "fromIntegral", "fromObj",
   488       "fromRational", "fst", "gcd", "getChar", "getContents", "getLine", "head",
   489       "id", "inRange", "index", "init", "intToRatio", "interact", "ioError", "isAlpha",
   490       "isAlphaNum", "isDenormalized", "isDigit", "isHexDigit", "isIEEE", "isInfinite",
   491       "isLower", "isNaN", "isNegativeZero", "isOctDigit", "isSpace", "isUpper", "iterate", "iterate'",
   492       "last", "lcm", "length", "lex", "lexDigits", "lexLitChar", "lexmatch", "lines", "log",
   493       "logBase", "lookup", "loop", "map", "mapM", "mapM_", "max", "maxBound", "maximum",
   494       "maybe", "min", "minBound", "minimum", "mod", "negate", "nonnull", "not", "notElem",
   495       "null", "numerator", "numericEnumFrom", "numericEnumFromThen", "numericEnumFromThenTo",
   496       "numericEnumFromTo", "odd", "or", "otherwise", "pi", "pred", 
   497       "print", "product", "properFraction", "protectEsc", "putChar", "putStr", "putStrLn",
   498       "quot", "quotRem", "range", "rangeSize", "rationalToDouble", "rationalToFloat",
   499       "rationalToRealFloat", "read", "readDec", "readField", "readFieldName", "readFile",
   500       "readFloat", "readHex", "readIO", "readInt", "readList", "readLitChar", "readLn",
   501       "readOct", "readParen", "readSigned", "reads", "readsPrec", "realFloatToRational",
   502       "realToFrac", "recip", "reduce", "rem", "repeat", "replicate", "return", "reverse",
   503       "round", "scaleFloat", "scanl", "scanl1", "scanr", "scanr1", "seq", "sequence",
   504       "sequence_", "show", "showChar", "showException", "showField", "showList",
   505       "showLitChar", "showParen", "showString", "shows", "showsPrec", "significand",
   506       "signum", "signumReal", "sin", "sinh", "snd", "span", "splitAt", "sqrt", "subtract",
   507       "succ", "sum", "tail", "take", "takeWhile", "takeWhile1", "tan", "tanh", "threadToIOResult",
   508       "throw", "toEnum", "toInt", "toInteger", "toObj", "toRational", "truncate", "uncurry",
   509       "undefined", "unlines", "unsafeCoerce", "unsafeIndex", "unsafeRangeSize", "until", "unwords",
   510       "unzip", "unzip3", "userError", "words", "writeFile", "zip", "zip3", "zipWith", "zipWith3"
   511     ] (*due to weird handling of ':', we can't do anything else than to import *all* prelude symbols*);
   512 
   513 end; (*struct*)