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