desugar.sml 1.08 KB
Newer Older
mb0's avatar
mb0 committed
1
2
3
4

structure Desugar : sig
   val run:
      SpecAbstractTree.specification ->
mb0's avatar
mb0 committed
5
         Core.Spec.t CompilationMonad.t
mb0's avatar
mb0 committed
6
7
8
9
10
11
12
13
end = struct

   structure CM = CompilationMonad
   structure DT = DesugaredTree
   structure AT = SpecAbstractTree

   open CM
   infix >>=
14
   infix >>
mb0's avatar
mb0 committed
15

16
   fun all s =
mb0's avatar
mb0 committed
17
      SplitDeclarations.run s >>=
18
      DesugarGuards.run >>=
mb0's avatar
mb0 committed
19
20
21
      InlineDecodePatterns.run >>=
      Detokenize.run >>=
      Retokenize.run >>=
mb0's avatar
mb0 committed
22
23
      DesugarDecodeSyntax.run >>=
      DesugarMonadicSequences.run
mb0's avatar
mb0 committed
24
25

   fun dumpPre (os, (_, spec)) = AT.PP.prettyTo (os, spec)
mb0's avatar
mb0 committed
26
   fun dumpPost (os, spec) = Pretty.prettyTo (os, Core.PP.spec spec)
mb0's avatar
mb0 committed
27
   fun pass (s, spec) = CM.run s (all spec)
28
29
    handle DT.DesugarTreeException (sp,err) =>
      CM.run s (errorAt (sp, [err]) >> fail) 
mb0's avatar
mb0 committed
30
31
32

   val desugar =
      BasicControl.mkKeepPass
33
         {passName="desugar",
mb0's avatar
mb0 committed
34
35
36
37
38
39
40
41
42
43
44
          registry=DesugarControl.registry,
          pass=pass,
          preExt="ast",
          preOutput=dumpPre,
          postExt="ast",
          postOutput=dumpPost}

   fun run spec =
      getState >>= (fn s =>
      return (desugar (s, spec)))
end