2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Desugar]{@deSugar@: the main function}
7 module Desugar ( deSugar, pprDsWarnings ) where
9 #include "HsVersions.h"
11 import CmdLineOpts ( opt_D_dump_ds )
12 import HsSyn ( MonoBinds )
13 import TcHsSyn ( TypecheckedMonoBinds )
15 import PprCore ( pprCoreBindings )
17 import DsBinds ( dsMonoBinds )
20 import Bag ( isEmptyBag )
21 import BasicTypes ( Module )
22 import CmdLineOpts ( opt_SccGroup, opt_SccProfilingOn )
23 import CoreLift ( liftCoreBindings )
24 import CoreLint ( lintCoreBindings )
25 import Id ( nullIdEnv, GenId, Id )
26 import ErrUtils ( dumpIfSet, doIfSet )
28 import UniqSupply ( splitUniqSupply, UniqSupply )
31 The only trick here is to get the @DsMonad@ stuff off to a good
35 deSugar :: UniqSupply -- name supply
36 -> Module -- module name
37 -> TypecheckedMonoBinds
38 -> IO [CoreBinding] -- output
40 deSugar us mod_name all_binds
42 (us1, us2) = splitUniqSupply us
44 module_and_group = (mod_name, grp_name)
45 grp_name = case opt_SccGroup of
47 Nothing -> mod_name -- default: module name
49 (core_prs, ds_warns) = initDs us1 nullIdEnv module_and_group
50 (dsMonoBinds opt_SccProfilingOn all_binds [])
52 ds_binds = liftCoreBindings us2 [Rec core_prs]
55 -- Display any warnings
56 doIfSet (not (isEmptyBag ds_warns))
57 (printErrs (pprDsWarnings ds_warns)) >>
59 -- Lint result if necessary
60 lintCoreBindings "Desugarer" False ds_binds >>
63 dumpIfSet opt_D_dump_ds "Desugared:"
64 (pprCoreBindings ds_binds) >>