src/Tools/Code/code_haskell.ML
author haftmann
Mon Jan 04 14:09:56 2010 +0100 (2010-01-04)
changeset 34244 03f8dcab55f3
parent 34178 a78b8d5b91cb
child 34269 b5c99df2e4b1
permissions -rw-r--r--
code cache without copy; tuned
     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 setup: theory -> theory
    10 end;
    11 
    12 structure Code_Haskell : CODE_HASKELL =
    13 struct
    14 
    15 val target = "Haskell";
    16 
    17 open Basic_Code_Thingol;
    18 open Code_Printer;
    19 
    20 infixr 5 @@;
    21 infixr 5 @|;
    22 
    23 
    24 (** Haskell serializer **)
    25 
    26 fun print_haskell_stmt labelled_name syntax_class syntax_tyco syntax_const
    27     reserved deresolve contr_classparam_typs deriving_show =
    28   let
    29     val deresolve_base = Long_Name.base_name o deresolve;
    30     fun class_name class = case syntax_class 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       | classbinds => enum "," "(" ")" (
    36           map (fn (v, class) =>
    37             str (class_name class ^ " " ^ lookup_var tyvars v)) classbinds)
    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 syntax_tyco 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 thm vars fxy (IConst c) =
    54           print_app tyvars thm vars fxy (c, [])
    55       | print_term tyvars thm vars fxy (t as (t1 `$ t2)) =
    56           (case Code_Thingol.unfold_const_app t
    57            of SOME app => print_app tyvars thm vars fxy app
    58             | _ =>
    59                 brackify fxy [
    60                   print_term tyvars thm vars NOBR t1,
    61                   print_term tyvars thm vars BR t2
    62                 ])
    63       | print_term tyvars thm vars fxy (IVar NONE) =
    64           str "_"
    65       | print_term tyvars thm vars fxy (IVar (SOME v)) =
    66           (str o lookup_var vars) v
    67       | print_term tyvars 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 thm BR o fst) binds vars;
    71           in brackets (str "\\" :: ps @ str "->" @@ print_term tyvars thm vars' NOBR t') end
    72       | print_term tyvars 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 (syntax_const c)
    75                 then print_case tyvars thm vars fxy cases
    76                 else print_app tyvars thm vars fxy c_ts
    77             | NONE => print_case tyvars thm vars fxy cases)
    78     and print_app_expr tyvars thm vars ((c, (_, tys)), ts) = case contr_classparam_typs c
    79      of [] => (str o deresolve) c :: map (print_term tyvars 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 thm vars BR t
    85             | print_term_anno (t, SOME _) ty =
    86                 brackets [print_term tyvars 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) tys)
    90           else (str o deresolve) c :: map (print_term tyvars thm vars BR) ts
    91         end
    92     and print_app tyvars = gen_print_app (print_app_expr tyvars) (print_term tyvars) syntax_const
    93     and print_bind tyvars thm fxy p = gen_print_bind (print_term tyvars) thm fxy p
    94     and print_case tyvars 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 thm BR pat
   100               |>> (fn p => semicolon [p, str "=", print_term tyvars 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 thm vars' NOBR body])
   105           end
   106       | print_case tyvars thm vars fxy (((t, ty), clauses as _ :: _), _) =
   107           let
   108             fun print_select (pat, body) =
   109               let
   110                 val (p, vars') = print_bind tyvars thm NOBR pat vars;
   111               in semicolon [p, str "->", print_term tyvars thm vars' NOBR body] end;
   112           in brackify_block fxy
   113             (concat [str "case", print_term tyvars thm vars NOBR t, str "of", str "{"])
   114             (map print_select clauses)
   115             (str "}") 
   116           end
   117       | print_case tyvars thm vars fxy ((_, []), _) =
   118           (brackify fxy o Pretty.breaks o map str) ["error", "\"empty case\""];
   119     fun print_stmt (name, Code_Thingol.Fun (_, ((vs, ty), []))) =
   120           let
   121             val tyvars = intro_vars (map fst vs) reserved;
   122             val n = (length o fst o Code_Thingol.unfold_fun) ty;
   123           in
   124             Pretty.chunks [
   125               semicolon [
   126                 (str o suffix " ::" o deresolve_base) name,
   127                 print_typscheme tyvars (vs, ty)
   128               ],
   129               semicolon (
   130                 (str o deresolve_base) name
   131                 :: map str (replicate n "_")
   132                 @ str "="
   133                 :: str "error"
   134                 @@ (str o ML_Syntax.print_string
   135                     o Long_Name.base_name o Long_Name.qualifier) name
   136               )
   137             ]
   138           end
   139       | print_stmt (name, Code_Thingol.Fun (_, ((vs, ty), raw_eqs))) =
   140           let
   141             val eqs = filter (snd o snd) raw_eqs;
   142             val tyvars = intro_vars (map fst vs) reserved;
   143             fun print_eqn ((ts, t), (thm, _)) =
   144               let
   145                 val consts = fold Code_Thingol.add_constnames (t :: ts) [];
   146                 val vars = reserved
   147                   |> intro_base_names
   148                       (is_none o syntax_const) deresolve consts
   149                   |> intro_vars ((fold o Code_Thingol.fold_varnames)
   150                       (insert (op =)) ts []);
   151               in
   152                 semicolon (
   153                   (str o deresolve_base) name
   154                   :: map (print_term tyvars thm vars BR) ts
   155                   @ str "="
   156                   @@ print_term tyvars thm vars NOBR t
   157                 )
   158               end;
   159           in
   160             Pretty.chunks (
   161               semicolon [
   162                 (str o suffix " ::" o deresolve_base) name,
   163                 print_typscheme tyvars (vs, ty)
   164               ]
   165               :: map print_eqn eqs
   166             )
   167           end
   168       | print_stmt (name, Code_Thingol.Datatype (_, (vs, []))) =
   169           let
   170             val tyvars = intro_vars (map fst vs) reserved;
   171           in
   172             semicolon [
   173               str "data",
   174               print_typdecl tyvars (vs, (deresolve_base name, map (ITyVar o fst) vs))
   175             ]
   176           end
   177       | print_stmt (name, Code_Thingol.Datatype (_, (vs, [(co, [ty])]))) =
   178           let
   179             val tyvars = intro_vars (map fst vs) reserved;
   180           in
   181             semicolon (
   182               str "newtype"
   183               :: print_typdecl tyvars (vs, (deresolve_base name, map (ITyVar o fst) vs))
   184               :: str "="
   185               :: (str o deresolve_base) co
   186               :: print_typ tyvars BR ty
   187               :: (if deriving_show name then [str "deriving (Read, Show)"] else [])
   188             )
   189           end
   190       | print_stmt (name, Code_Thingol.Datatype (_, (vs, co :: cos))) =
   191           let
   192             val tyvars = intro_vars (map fst vs) reserved;
   193             fun print_co (co, tys) =
   194               concat (
   195                 (str o deresolve_base) co
   196                 :: map (print_typ tyvars BR) tys
   197               )
   198           in
   199             semicolon (
   200               str "data"
   201               :: print_typdecl tyvars (vs, (deresolve_base name, map (ITyVar o fst) vs))
   202               :: str "="
   203               :: print_co co
   204               :: map ((fn p => Pretty.block [str "| ", p]) o print_co) cos
   205               @ (if deriving_show name then [str "deriving (Read, Show)"] else [])
   206             )
   207           end
   208       | print_stmt (name, Code_Thingol.Class (_, (v, (superclasses, classparams)))) =
   209           let
   210             val tyvars = intro_vars [v] reserved;
   211             fun print_classparam (classparam, ty) =
   212               semicolon [
   213                 (str o deresolve_base) classparam,
   214                 str "::",
   215                 print_typ tyvars NOBR ty
   216               ]
   217           in
   218             Pretty.block_enclose (
   219               Pretty.block [
   220                 str "class ",
   221                 Pretty.block (print_typcontext tyvars [(v, map fst superclasses)]),
   222                 str (deresolve_base name ^ " " ^ lookup_var tyvars v),
   223                 str " where {"
   224               ],
   225               str "};"
   226             ) (map print_classparam classparams)
   227           end
   228       | print_stmt (_, Code_Thingol.Classinst ((class, (tyco, vs)), (_, classparam_insts))) =
   229           let
   230             val tyvars = intro_vars (map fst vs) reserved;
   231             fun print_instdef ((classparam, c_inst), (thm, _)) = case syntax_const classparam
   232              of NONE => semicolon [
   233                     (str o deresolve_base) classparam,
   234                     str "=",
   235                     print_app tyvars thm reserved NOBR (c_inst, [])
   236                   ]
   237               | SOME (k, pr) =>
   238                   let
   239                     val (c_inst_name, (_, tys)) = c_inst;
   240                     val const = if (is_some o syntax_const) c_inst_name
   241                       then NONE else (SOME o Long_Name.base_name o deresolve) c_inst_name;
   242                     val proto_rhs = Code_Thingol.eta_expand k (c_inst, []);
   243                     val (vs, rhs) = (apfst o map) fst (Code_Thingol.unfold_abs proto_rhs);
   244                     val vars = reserved
   245                       |> intro_vars (the_list const)
   246                       |> intro_vars (map_filter I vs);
   247                     val lhs = IConst (classparam, (([], []), tys)) `$$ map IVar vs;
   248                       (*dictionaries are not relevant at this late stage*)
   249                   in
   250                     semicolon [
   251                       print_term tyvars thm vars NOBR lhs,
   252                       str "=",
   253                       print_term tyvars thm vars NOBR rhs
   254                     ]
   255                   end;
   256           in
   257             Pretty.block_enclose (
   258               Pretty.block [
   259                 str "instance ",
   260                 Pretty.block (print_typcontext tyvars vs),
   261                 str (class_name class ^ " "),
   262                 print_typ tyvars BR (tyco `%% map (ITyVar o fst) vs),
   263                 str " where {"
   264               ],
   265               str "};"
   266             ) (map print_instdef classparam_insts)
   267           end;
   268   in print_stmt end;
   269 
   270 fun haskell_program_of_program labelled_name module_name module_prefix reserved raw_module_alias program =
   271   let
   272     val module_alias = if is_some module_name then K module_name else raw_module_alias;
   273     val reserved = Name.make_context reserved;
   274     val mk_name_module = mk_name_module reserved module_prefix module_alias program;
   275     fun add_stmt (name, (stmt, deps)) =
   276       let
   277         val (module_name, base) = dest_name name;
   278         val module_name' = mk_name_module module_name;
   279         val mk_name_stmt = yield_singleton Name.variants;
   280         fun add_fun upper (nsp_fun, nsp_typ) =
   281           let
   282             val (base', nsp_fun') =
   283               mk_name_stmt (if upper then first_upper base else base) nsp_fun
   284           in (base', (nsp_fun', nsp_typ)) end;
   285         fun add_typ (nsp_fun, nsp_typ) =
   286           let
   287             val (base', nsp_typ') = mk_name_stmt (first_upper base) nsp_typ
   288           in (base', (nsp_fun, nsp_typ')) end;
   289         val add_name = case stmt
   290          of Code_Thingol.Fun _ => add_fun false
   291           | Code_Thingol.Datatype _ => add_typ
   292           | Code_Thingol.Datatypecons _ => add_fun true
   293           | Code_Thingol.Class _ => add_typ
   294           | Code_Thingol.Classrel _ => pair base
   295           | Code_Thingol.Classparam _ => add_fun false
   296           | Code_Thingol.Classinst _ => pair base;
   297         fun add_stmt' base' = case stmt
   298          of Code_Thingol.Datatypecons _ =>
   299               cons (name, (Long_Name.append module_name' base', NONE))
   300           | Code_Thingol.Classrel _ => I
   301           | Code_Thingol.Classparam _ =>
   302               cons (name, (Long_Name.append module_name' base', NONE))
   303           | _ => cons (name, (Long_Name.append module_name' base', SOME stmt));
   304       in
   305         Symtab.map_default (module_name', ([], ([], (reserved, reserved))))
   306               (apfst (fold (insert (op = : string * string -> bool)) deps))
   307         #> `(fn program => add_name ((snd o snd o the o Symtab.lookup program) module_name'))
   308         #-> (fn (base', names) =>
   309               (Symtab.map_entry module_name' o apsnd) (fn (stmts, _) =>
   310               (add_stmt' base' stmts, names)))
   311       end;
   312     val hs_program = fold add_stmt (AList.make (fn name =>
   313       (Graph.get_node program name, Graph.imm_succs program name))
   314       (Graph.strong_conn program |> flat)) Symtab.empty;
   315     fun deresolver name = (fst o the o AList.lookup (op =) ((fst o snd o the
   316       o Symtab.lookup hs_program) ((mk_name_module o fst o dest_name) name))) name
   317       handle Option => error ("Unknown statement name: " ^ labelled_name name);
   318   in (deresolver, hs_program) end;
   319 
   320 fun serialize_haskell module_prefix raw_module_name string_classes labelled_name
   321     raw_reserved includes raw_module_alias
   322     syntax_class syntax_tyco syntax_const (code_of_pretty, code_writeln) program cs destination =
   323   let
   324     val stmt_names = Code_Target.stmt_names_of_destination destination;
   325     val module_name = if null stmt_names then raw_module_name else SOME "Code";
   326     val reserved = fold (insert (op =) o fst) includes raw_reserved;
   327     val (deresolver, hs_program) = haskell_program_of_program labelled_name
   328       module_name module_prefix reserved raw_module_alias program;
   329     val contr_classparam_typs = Code_Thingol.contr_classparam_typs program;
   330     fun deriving_show tyco =
   331       let
   332         fun deriv _ "fun" = false
   333           | deriv tycos tyco = not (tyco = Code_Thingol.fun_tyco)
   334               andalso (member (op =) tycos tyco
   335               orelse case try (Graph.get_node program) tyco
   336                 of SOME (Code_Thingol.Datatype (_, (_, cs))) => forall (deriv' (tyco :: tycos))
   337                     (maps snd cs)
   338                  | NONE => true)
   339         and deriv' tycos (tyco `%% tys) = deriv tycos tyco
   340               andalso forall (deriv' tycos) tys
   341           | deriv' _ (ITyVar _) = true
   342       in deriv [] tyco end;
   343     val reserved = make_vars reserved;
   344     fun print_stmt qualified = print_haskell_stmt labelled_name
   345       syntax_class syntax_tyco syntax_const reserved
   346       (if qualified then deresolver else Long_Name.base_name o deresolver)
   347       contr_classparam_typs
   348       (if string_classes then deriving_show else K false);
   349     fun print_module name content =
   350       (name, Pretty.chunks [
   351         str ("module " ^ name ^ " where {"),
   352         str "",
   353         content,
   354         str "",
   355         str "}"
   356       ]);
   357     fun serialize_module1 (module_name', (deps, (stmts, _))) =
   358       let
   359         val stmt_names = map fst stmts;
   360         val qualified = is_none module_name;
   361         val imports = subtract (op =) stmt_names deps
   362           |> distinct (op =)
   363           |> map_filter (try deresolver)
   364           |> map Long_Name.qualifier
   365           |> distinct (op =);
   366         fun print_import_include (name, _) = str ("import qualified " ^ name ^ ";");
   367         fun print_import_module name = str ((if qualified
   368           then "import qualified "
   369           else "import ") ^ name ^ ";");
   370         val import_ps = map print_import_include includes @ map print_import_module imports
   371         val content = Pretty.chunks2 ((if null import_ps then [] else [Pretty.chunks import_ps])
   372             @ map_filter
   373               (fn (name, (_, SOME stmt)) => SOME (print_stmt qualified (name, stmt))
   374                 | (_, (_, NONE)) => NONE) stmts
   375           );
   376       in print_module module_name' content end;
   377     fun serialize_module2 (_, (_, (stmts, _))) = Pretty.chunks2 (map_filter
   378         (fn (name, (_, SOME stmt)) => if null stmt_names
   379               orelse member (op =) stmt_names name
   380               then SOME (print_stmt false (name, stmt))
   381               else NONE
   382           | (_, (_, NONE)) => NONE) stmts);
   383     val serialize_module =
   384       if null stmt_names then serialize_module1 else pair "" o serialize_module2;
   385     fun check_destination destination =
   386       (File.check destination; destination);
   387     fun write_module destination (modlname, content) =
   388       let
   389         val filename = case modlname
   390          of "" => Path.explode "Main.hs"
   391           | _ => (Path.ext "hs" o Path.explode o implode o separate "/"
   392                 o Long_Name.explode) modlname;
   393         val pathname = Path.append destination filename;
   394         val _ = File.mkdir (Path.dir pathname);
   395       in File.write pathname
   396         ("{-# OPTIONS_GHC -fglasgow-exts #-}\n\n"
   397           ^ code_of_pretty content)
   398       end
   399   in
   400     Code_Target.mk_serialization target NONE
   401       (fn NONE => K () o map (code_writeln o snd) | SOME file => K () o map
   402         (write_module (check_destination file)))
   403       (rpair [] o cat_lines o map (code_of_pretty o snd))
   404       (map (uncurry print_module) includes
   405         @ map serialize_module (Symtab.dest hs_program))
   406       destination
   407   end;
   408 
   409 val literals = let
   410   fun char_haskell c =
   411     let
   412       val s = ML_Syntax.print_char c;
   413     in if s = "'" then "\\'" else s end;
   414 in Literals {
   415   literal_char = Library.enclose "'" "'" o char_haskell,
   416   literal_string = quote o translate_string char_haskell,
   417   literal_numeral = fn unbounded => fn k => if k >= 0 then string_of_int k
   418     else Library.enclose "(" ")" (signed_string_of_int k),
   419   literal_list = enum "," "[" "]",
   420   infix_cons = (5, ":")
   421 } end;
   422 
   423 
   424 (** optional monad syntax **)
   425 
   426 fun pretty_haskell_monad c_bind =
   427   let
   428     fun dest_bind t1 t2 = case Code_Thingol.split_pat_abs t2
   429      of SOME ((pat, ty), t') =>
   430           SOME ((SOME ((pat, ty), true), t1), t')
   431       | NONE => NONE;
   432     fun dest_monad c_bind_name (IConst (c, _) `$ t1 `$ t2) =
   433           if c = c_bind_name then dest_bind t1 t2
   434           else NONE
   435       | dest_monad _ t = case Code_Thingol.split_let t
   436          of SOME (((pat, ty), tbind), t') =>
   437               SOME ((SOME ((pat, ty), false), tbind), t')
   438           | NONE => NONE;
   439     fun implode_monad c_bind_name = Code_Thingol.unfoldr (dest_monad c_bind_name);
   440     fun print_monad print_bind print_term (NONE, t) vars =
   441           (semicolon [print_term vars NOBR t], vars)
   442       | print_monad print_bind print_term (SOME ((bind, _), true), t) vars = vars
   443           |> print_bind NOBR bind
   444           |>> (fn p => semicolon [p, str "<-", print_term vars NOBR t])
   445       | print_monad print_bind print_term (SOME ((bind, _), false), t) vars = vars
   446           |> print_bind NOBR bind
   447           |>> (fn p => semicolon [str "let", p, str "=", print_term vars NOBR t]);
   448     fun pretty _ [c_bind'] print_term thm vars fxy [(t1, _), (t2, _)] = case dest_bind t1 t2
   449      of SOME (bind, t') => let
   450           val (binds, t'') = implode_monad c_bind' t'
   451           val (ps, vars') = fold_map (print_monad (gen_print_bind (K print_term) thm) print_term)
   452             (bind :: binds) vars;
   453         in
   454           (brackify fxy o single o enclose "do {" "}" o Pretty.breaks)
   455             (ps @| print_term vars' NOBR t'')
   456         end
   457       | NONE => brackify_infix (1, L) fxy
   458           [print_term vars (INFX (1, L)) t1, str ">>=", print_term vars (INFX (1, X)) t2]
   459   in (2, ([c_bind], pretty)) end;
   460 
   461 fun add_monad target' raw_c_bind thy =
   462   let
   463     val c_bind = Code.read_const thy raw_c_bind;
   464   in if target = target' then
   465     thy
   466     |> Code_Target.add_syntax_const target c_bind
   467         (SOME (pretty_haskell_monad c_bind))
   468   else error "Only Haskell target allows for monad syntax" end;
   469 
   470 
   471 (** Isar setup **)
   472 
   473 fun isar_seri_haskell module_name =
   474   Code_Target.parse_args (Scan.option (Args.$$$ "root" -- Args.colon |-- Args.name)
   475     -- Scan.optional (Args.$$$ "string_classes" >> K true) false
   476     >> (fn (module_prefix, string_classes) =>
   477       serialize_haskell module_prefix module_name string_classes));
   478 
   479 val _ =
   480   OuterSyntax.command "code_monad" "define code syntax for monads" OuterKeyword.thy_decl (
   481     OuterParse.term_group -- OuterParse.name >> (fn (raw_bind, target) =>
   482       Toplevel.theory  (add_monad target raw_bind))
   483   );
   484 
   485 val setup =
   486   Code_Target.add_target (target, (isar_seri_haskell, literals))
   487   #> Code_Target.add_syntax_tyco target "fun" (SOME (2, fn print_typ => fn fxy => fn [ty1, ty2] =>
   488       brackify_infix (1, R) fxy [
   489         print_typ (INFX (1, X)) ty1,
   490         str "->",
   491         print_typ (INFX (1, R)) ty2
   492       ]))
   493   #> fold (Code_Target.add_reserved target) [
   494       "hiding", "deriving", "where", "case", "of", "infix", "infixl", "infixr",
   495       "import", "default", "forall", "let", "in", "class", "qualified", "data",
   496       "newtype", "instance", "if", "then", "else", "type", "as", "do", "module"
   497     ]
   498   #> fold (Code_Target.add_reserved target) [
   499       "Prelude", "Main", "Bool", "Maybe", "Either", "Ordering", "Char", "String", "Int",
   500       "Integer", "Float", "Double", "Rational", "IO", "Eq", "Ord", "Enum", "Bounded",
   501       "Num", "Real", "Integral", "Fractional", "Floating", "RealFloat", "Monad", "Functor",
   502       "AlreadyExists", "ArithException", "ArrayException", "AssertionFailed", "AsyncException",
   503       "BlockedOnDeadMVar", "Deadlock", "Denormal", "DivideByZero", "DotNetException", "DynException",
   504       "Dynamic", "EOF", "EQ", "EmptyRec", "ErrorCall", "ExitException", "ExitFailure",
   505       "ExitSuccess", "False", "GT", "HeapOverflow",
   506       "IOError", "IOException", "IllegalOperation",
   507       "IndexOutOfBounds", "Just", "Key", "LT", "Left", "LossOfPrecision", "NoMethodError",
   508       "NoSuchThing", "NonTermination", "Nothing", "Obj", "OtherError", "Overflow",
   509       "PatternMatchFail", "PermissionDenied", "ProtocolError", "RecConError", "RecSelError",
   510       "RecUpdError", "ResourceBusy", "ResourceExhausted", "Right", "StackOverflow",
   511       "ThreadKilled", "True", "TyCon", "TypeRep", "UndefinedElement", "Underflow",
   512       "UnsupportedOperation", "UserError", "abs", "absReal", "acos", "acosh", "all",
   513       "and", "any", "appendFile", "asTypeOf", "asciiTab", "asin", "asinh", "atan",
   514       "atan2", "atanh", "basicIORun", "blockIO", "boundedEnumFrom", "boundedEnumFromThen",
   515       "boundedEnumFromThenTo", "boundedEnumFromTo", "boundedPred", "boundedSucc", "break",
   516       "catch", "catchException", "ceiling", "compare", "concat", "concatMap", "const",
   517       "cos", "cosh", "curry", "cycle", "decodeFloat", "denominator", "div", "divMod",
   518       "doubleToRatio", "doubleToRational", "drop", "dropWhile", "either", "elem",
   519       "emptyRec", "encodeFloat", "enumFrom", "enumFromThen", "enumFromThenTo",
   520       "enumFromTo", "error", "even", "exp", "exponent", "fail", "filter", "flip",
   521       "floatDigits", "floatProperFraction", "floatRadix", "floatRange", "floatToRational",
   522       "floor", "fmap", "foldl", "foldl'", "foldl1", "foldr", "foldr1", "fromDouble",
   523       "fromEnum", "fromEnum_0", "fromInt", "fromInteger", "fromIntegral", "fromObj",
   524       "fromRational", "fst", "gcd", "getChar", "getContents", "getLine", "head",
   525       "id", "inRange", "index", "init", "intToRatio", "interact", "ioError", "isAlpha",
   526       "isAlphaNum", "isDenormalized", "isDigit", "isHexDigit", "isIEEE", "isInfinite",
   527       "isLower", "isNaN", "isNegativeZero", "isOctDigit", "isSpace", "isUpper", "iterate", "iterate'",
   528       "last", "lcm", "length", "lex", "lexDigits", "lexLitChar", "lexmatch", "lines", "log",
   529       "logBase", "lookup", "loop", "map", "mapM", "mapM_", "max", "maxBound", "maximum",
   530       "maybe", "min", "minBound", "minimum", "mod", "negate", "nonnull", "not", "notElem",
   531       "null", "numerator", "numericEnumFrom", "numericEnumFromThen", "numericEnumFromThenTo",
   532       "numericEnumFromTo", "odd", "or", "otherwise", "pi", "pred", 
   533       "print", "product", "properFraction", "protectEsc", "putChar", "putStr", "putStrLn",
   534       "quot", "quotRem", "range", "rangeSize", "rationalToDouble", "rationalToFloat",
   535       "rationalToRealFloat", "read", "readDec", "readField", "readFieldName", "readFile",
   536       "readFloat", "readHex", "readIO", "readInt", "readList", "readLitChar", "readLn",
   537       "readOct", "readParen", "readSigned", "reads", "readsPrec", "realFloatToRational",
   538       "realToFrac", "recip", "reduce", "rem", "repeat", "replicate", "return", "reverse",
   539       "round", "scaleFloat", "scanl", "scanl1", "scanr", "scanr1", "seq", "sequence",
   540       "sequence_", "show", "showChar", "showException", "showField", "showList",
   541       "showLitChar", "showParen", "showString", "shows", "showsPrec", "significand",
   542       "signum", "signumReal", "sin", "sinh", "snd", "span", "splitAt", "sqrt", "subtract",
   543       "succ", "sum", "tail", "take", "takeWhile", "takeWhile1", "tan", "tanh", "threadToIOResult",
   544       "throw", "toEnum", "toInt", "toInteger", "toObj", "toRational", "truncate", "uncurry",
   545       "undefined", "unlines", "unsafeCoerce", "unsafeIndex", "unsafeRangeSize", "until", "unwords",
   546       "unzip", "unzip3", "userError", "words", "writeFile", "zip", "zip3", "zipWith", "zipWith3"
   547     ] (*due to weird handling of ':', we can't do anything else than to import *all* prelude symbols*);
   548 
   549 end; (*struct*)