src/Tools/Code/code_haskell.ML
author wenzelm
Sun Mar 13 14:51:38 2011 +0100 (2011-03-13)
changeset 41940 a3b68a7a0e15
parent 41343 71f4f15258a5
child 41952 c7297638599b
permissions -rw-r--r--
allow spaces in executable names;
simplified generated bash scripts;
     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') = yield_singleton Name.variants
   268           (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') = yield_singleton Name.variants
   273           (first_upper base) nsp_typ
   274       in (base', (nsp_fun, nsp_typ')) end;
   275     fun namify_stmt (Code_Thingol.Fun (_, (_, SOME _))) = pair
   276       | namify_stmt (Code_Thingol.Fun _) = namify_fun false
   277       | namify_stmt (Code_Thingol.Datatype _) = namify_typ
   278       | namify_stmt (Code_Thingol.Datatypecons _) = namify_fun true
   279       | namify_stmt (Code_Thingol.Class _) = namify_typ
   280       | namify_stmt (Code_Thingol.Classrel _) = pair
   281       | namify_stmt (Code_Thingol.Classparam _) = namify_fun false
   282       | namify_stmt (Code_Thingol.Classinst _) = pair;
   283     fun select_stmt (Code_Thingol.Fun (_, (_, SOME _))) = false
   284       | select_stmt (Code_Thingol.Fun _) = true
   285       | select_stmt (Code_Thingol.Datatype _) = true
   286       | select_stmt (Code_Thingol.Datatypecons _) = false
   287       | select_stmt (Code_Thingol.Class _) = true
   288       | select_stmt (Code_Thingol.Classrel _) = false
   289       | select_stmt (Code_Thingol.Classparam _) = false
   290       | select_stmt (Code_Thingol.Classinst _) = true;
   291   in
   292     Code_Namespace.flat_program labelled_name
   293       { module_alias = module_alias, module_prefix = module_prefix,
   294         reserved = reserved, empty_nsp = (reserved, reserved), namify_stmt = namify_stmt,
   295         modify_stmt = fn stmt => if select_stmt stmt then SOME stmt else NONE }
   296   end;
   297 
   298 fun serialize_haskell module_prefix string_classes { labelled_name, reserved_syms,
   299     includes, module_alias, class_syntax, tyco_syntax, const_syntax } program =
   300   let
   301 
   302     (* build program *)
   303     val reserved = fold (insert (op =) o fst) includes reserved_syms;
   304     val { deresolver, flat_program = haskell_program } = haskell_program_of_program
   305       labelled_name module_alias module_prefix (Name.make_context reserved) program;
   306 
   307     (* print statements *)
   308     val contr_classparam_typs = Code_Thingol.contr_classparam_typs program;
   309     fun deriving_show tyco =
   310       let
   311         fun deriv _ "fun" = false
   312           | deriv tycos tyco = not (tyco = Code_Thingol.fun_tyco)
   313               andalso (member (op =) tycos tyco
   314               orelse case try (Graph.get_node program) tyco
   315                 of SOME (Code_Thingol.Datatype (_, (_, cs))) => forall (deriv' (tyco :: tycos))
   316                     (maps snd cs)
   317                  | NONE => true)
   318         and deriv' tycos (tyco `%% tys) = deriv tycos tyco
   319               andalso forall (deriv' tycos) tys
   320           | deriv' _ (ITyVar _) = true
   321       in deriv [] tyco end;
   322     fun print_stmt deresolve = print_haskell_stmt labelled_name
   323       class_syntax tyco_syntax const_syntax (make_vars reserved)
   324       deresolve contr_classparam_typs
   325       (if string_classes then deriving_show else K false);
   326 
   327     (* print modules *)
   328     val import_includes_ps =
   329       map (fn (name, _) => str ("import qualified " ^ name ^ ";")) includes;
   330     fun print_module_frame module_name ps =
   331       (module_name, Pretty.chunks2 (
   332         str ("module " ^ module_name ^ " where {")
   333         :: ps
   334         @| str "}"
   335       ));
   336     fun print_module module_name (gr, imports) =
   337       let
   338         val deresolve = deresolver module_name
   339         fun print_import module_name = (semicolon o map str) ["import qualified", module_name];
   340         val import_ps = import_includes_ps @ map (print_import o fst) imports;
   341         fun print_stmt' gr name = case Graph.get_node gr name
   342          of (_, NONE) => NONE
   343           | (_, SOME stmt) => SOME (markup_stmt name (print_stmt deresolve (name, stmt)));
   344         val body_ps = map_filter (print_stmt' gr) ((flat o rev o Graph.strong_conn) gr);
   345       in
   346         print_module_frame module_name
   347           ((if null import_ps then [] else [Pretty.chunks import_ps]) @ body_ps)
   348       end;
   349 
   350     (*serialization*)
   351     fun write_module width (SOME destination) (module_name, content) =
   352           let
   353             val _ = File.check destination;
   354             val filepath = (Path.append destination o Path.ext "hs" o Path.explode o implode
   355               o separate "/" o Long_Name.explode) module_name;
   356             val _ = Isabelle_System.mkdirs (Path.dir filepath);
   357           in
   358             (File.write filepath o format [] width o Pretty.chunks2)
   359               [str "{-# LANGUAGE ScopedTypeVariables #-}", content]
   360           end
   361       | write_module width NONE (_, content) = writeln (format [] width content);
   362   in
   363     Code_Target.serialization
   364       (fn width => fn destination => K () o map (write_module width destination))
   365       (fn present => fn width => rpair (try (deresolver ""))
   366         o format present width o Pretty.chunks o map snd)
   367       (map (uncurry print_module_frame o apsnd single) includes
   368         @ map (fn module_name => print_module module_name (Graph.get_node haskell_program module_name))
   369           ((flat o rev o Graph.strong_conn) haskell_program))
   370   end;
   371 
   372 val serializer : Code_Target.serializer =
   373   Code_Target.parse_args (Scan.optional (Args.$$$ "root" -- Args.colon |-- Args.name) ""
   374     -- Scan.optional (Args.$$$ "string_classes" >> K true) false
   375     >> (fn (module_prefix, string_classes) =>
   376       serialize_haskell module_prefix string_classes));
   377 
   378 val literals = let
   379   fun char_haskell c =
   380     let
   381       val s = ML_Syntax.print_char c;
   382     in if s = "'" then "\\'" else s end;
   383   fun numeral_haskell k = if k >= 0 then string_of_int k
   384     else Library.enclose "(" ")" (signed_string_of_int k);
   385 in Literals {
   386   literal_char = Library.enclose "'" "'" o char_haskell,
   387   literal_string = quote o translate_string char_haskell,
   388   literal_numeral = numeral_haskell,
   389   literal_positive_numeral = numeral_haskell,
   390   literal_alternative_numeral = numeral_haskell,
   391   literal_naive_numeral = numeral_haskell,
   392   literal_list = enum "," "[" "]",
   393   infix_cons = (5, ":")
   394 } end;
   395 
   396 
   397 (** optional monad syntax **)
   398 
   399 fun pretty_haskell_monad c_bind =
   400   let
   401     fun dest_bind t1 t2 = case Code_Thingol.split_pat_abs t2
   402      of SOME ((pat, ty), t') =>
   403           SOME ((SOME ((pat, ty), true), t1), t')
   404       | NONE => NONE;
   405     fun dest_monad c_bind_name (IConst (c, _) `$ t1 `$ t2) =
   406           if c = c_bind_name then dest_bind t1 t2
   407           else NONE
   408       | dest_monad _ t = case Code_Thingol.split_let t
   409          of SOME (((pat, ty), tbind), t') =>
   410               SOME ((SOME ((pat, ty), false), tbind), t')
   411           | NONE => NONE;
   412     fun implode_monad c_bind_name = Code_Thingol.unfoldr (dest_monad c_bind_name);
   413     fun print_monad print_bind print_term (NONE, t) vars =
   414           (semicolon [print_term vars NOBR t], vars)
   415       | print_monad print_bind print_term (SOME ((bind, _), true), t) vars = vars
   416           |> print_bind NOBR bind
   417           |>> (fn p => semicolon [p, str "<-", print_term vars NOBR t])
   418       | print_monad print_bind print_term (SOME ((bind, _), false), t) vars = vars
   419           |> print_bind NOBR bind
   420           |>> (fn p => semicolon [str "let", str "{", p, str "=", print_term vars NOBR t, str "}"]);
   421     fun pretty _ [c_bind'] print_term thm vars fxy [(t1, _), (t2, _)] = case dest_bind t1 t2
   422      of SOME (bind, t') => let
   423           val (binds, t'') = implode_monad c_bind' t'
   424           val (ps, vars') = fold_map (print_monad (gen_print_bind (K print_term) thm) print_term)
   425             (bind :: binds) vars;
   426         in
   427           (brackify fxy o single o enclose "do { " " }" o Pretty.breaks)
   428             (ps @| print_term vars' NOBR t'')
   429         end
   430       | NONE => brackify_infix (1, L) fxy
   431           (print_term vars (INFX (1, L)) t1, str ">>=", print_term vars (INFX (1, X)) t2)
   432   in (2, ([c_bind], pretty)) end;
   433 
   434 fun add_monad target' raw_c_bind thy =
   435   let
   436     val c_bind = Code.read_const thy raw_c_bind;
   437   in if target = target' then
   438     thy
   439     |> Code_Target.add_const_syntax target c_bind
   440         (SOME (Code_Printer.complex_const_syntax (pretty_haskell_monad c_bind)))
   441   else error "Only Haskell target allows for monad syntax" end;
   442 
   443 
   444 (** Isar setup **)
   445 
   446 val _ =
   447   Outer_Syntax.command "code_monad" "define code syntax for monads" Keyword.thy_decl (
   448     Parse.term_group -- Parse.name >> (fn (raw_bind, target) =>
   449       Toplevel.theory  (add_monad target raw_bind))
   450   );
   451 
   452 val setup =
   453   Code_Target.add_target
   454     (target, { serializer = serializer, literals = literals,
   455       check = { env_var = "EXEC_GHC", make_destination = I,
   456         make_command = fn module_name =>
   457           "\"$EXEC_GHC\" -fglasgow-exts -odir build -hidir build -stubdir build -e \"\" " ^
   458             module_name ^ ".hs" } })
   459   #> Code_Target.add_tyco_syntax target "fun" (SOME (2, fn print_typ => fn fxy => fn [ty1, ty2] =>
   460       brackify_infix (1, R) fxy (
   461         print_typ (INFX (1, X)) ty1,
   462         str "->",
   463         print_typ (INFX (1, R)) ty2
   464       )))
   465   #> fold (Code_Target.add_reserved target) [
   466       "hiding", "deriving", "where", "case", "of", "infix", "infixl", "infixr",
   467       "import", "default", "forall", "let", "in", "class", "qualified", "data",
   468       "newtype", "instance", "if", "then", "else", "type", "as", "do", "module"
   469     ]
   470   #> fold (Code_Target.add_reserved target) [
   471       "Prelude", "Main", "Bool", "Maybe", "Either", "Ordering", "Char", "String", "Int",
   472       "Integer", "Float", "Double", "Rational", "IO", "Eq", "Ord", "Enum", "Bounded",
   473       "Num", "Real", "Integral", "Fractional", "Floating", "RealFloat", "Monad", "Functor",
   474       "AlreadyExists", "ArithException", "ArrayException", "AssertionFailed", "AsyncException",
   475       "BlockedOnDeadMVar", "Deadlock", "Denormal", "DivideByZero", "DotNetException", "DynException",
   476       "Dynamic", "EOF", "EQ", "EmptyRec", "ErrorCall", "ExitException", "ExitFailure",
   477       "ExitSuccess", "False", "GT", "HeapOverflow",
   478       "IOError", "IOException", "IllegalOperation",
   479       "IndexOutOfBounds", "Just", "Key", "LT", "Left", "LossOfPrecision", "NoMethodError",
   480       "NoSuchThing", "NonTermination", "Nothing", "Obj", "OtherError", "Overflow",
   481       "PatternMatchFail", "PermissionDenied", "ProtocolError", "RecConError", "RecSelError",
   482       "RecUpdError", "ResourceBusy", "ResourceExhausted", "Right", "StackOverflow",
   483       "ThreadKilled", "True", "TyCon", "TypeRep", "UndefinedElement", "Underflow",
   484       "UnsupportedOperation", "UserError", "abs", "absReal", "acos", "acosh", "all",
   485       "and", "any", "appendFile", "asTypeOf", "asciiTab", "asin", "asinh", "atan",
   486       "atan2", "atanh", "basicIORun", "blockIO", "boundedEnumFrom", "boundedEnumFromThen",
   487       "boundedEnumFromThenTo", "boundedEnumFromTo", "boundedPred", "boundedSucc", "break",
   488       "catch", "catchException", "ceiling", "compare", "concat", "concatMap", "const",
   489       "cos", "cosh", "curry", "cycle", "decodeFloat", "denominator", "div", "divMod",
   490       "doubleToRatio", "doubleToRational", "drop", "dropWhile", "either", "elem",
   491       "emptyRec", "encodeFloat", "enumFrom", "enumFromThen", "enumFromThenTo",
   492       "enumFromTo", "error", "even", "exp", "exponent", "fail", "filter", "flip",
   493       "floatDigits", "floatProperFraction", "floatRadix", "floatRange", "floatToRational",
   494       "floor", "fmap", "foldl", "foldl'", "foldl1", "foldr", "foldr1", "fromDouble",
   495       "fromEnum", "fromEnum_0", "fromInt", "fromInteger", "fromIntegral", "fromObj",
   496       "fromRational", "fst", "gcd", "getChar", "getContents", "getLine", "head",
   497       "id", "inRange", "index", "init", "intToRatio", "interact", "ioError", "isAlpha",
   498       "isAlphaNum", "isDenormalized", "isDigit", "isHexDigit", "isIEEE", "isInfinite",
   499       "isLower", "isNaN", "isNegativeZero", "isOctDigit", "isSpace", "isUpper", "iterate", "iterate'",
   500       "last", "lcm", "length", "lex", "lexDigits", "lexLitChar", "lexmatch", "lines", "log",
   501       "logBase", "lookup", "loop", "map", "mapM", "mapM_", "max", "maxBound", "maximum",
   502       "maybe", "min", "minBound", "minimum", "mod", "negate", "nonnull", "not", "notElem",
   503       "null", "numerator", "numericEnumFrom", "numericEnumFromThen", "numericEnumFromThenTo",
   504       "numericEnumFromTo", "odd", "or", "otherwise", "pi", "pred", 
   505       "print", "product", "properFraction", "protectEsc", "putChar", "putStr", "putStrLn",
   506       "quot", "quotRem", "range", "rangeSize", "rationalToDouble", "rationalToFloat",
   507       "rationalToRealFloat", "read", "readDec", "readField", "readFieldName", "readFile",
   508       "readFloat", "readHex", "readIO", "readInt", "readList", "readLitChar", "readLn",
   509       "readOct", "readParen", "readSigned", "reads", "readsPrec", "realFloatToRational",
   510       "realToFrac", "recip", "reduce", "rem", "repeat", "replicate", "return", "reverse",
   511       "round", "scaleFloat", "scanl", "scanl1", "scanr", "scanr1", "seq", "sequence",
   512       "sequence_", "show", "showChar", "showException", "showField", "showList",
   513       "showLitChar", "showParen", "showString", "shows", "showsPrec", "significand",
   514       "signum", "signumReal", "sin", "sinh", "snd", "span", "splitAt", "sqrt", "subtract",
   515       "succ", "sum", "tail", "take", "takeWhile", "takeWhile1", "tan", "tanh", "threadToIOResult",
   516       "throw", "toEnum", "toInt", "toInteger", "toObj", "toRational", "truncate", "uncurry",
   517       "undefined", "unlines", "unsafeCoerce", "unsafeIndex", "unsafeRangeSize", "until", "unwords",
   518       "unzip", "unzip3", "userError", "words", "writeFile", "zip", "zip3", "zipWith", "zipWith3"
   519     ] (*due to weird handling of ':', we can't do anything else than to import *all* prelude symbols*);
   520 
   521 end; (*struct*)