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