File: ast-consts.sml

package info (click to toggle)
mlton 20210117%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 58,464 kB
  • sloc: ansic: 27,682; sh: 4,455; asm: 3,569; lisp: 2,879; makefile: 2,347; perl: 1,169; python: 191; pascal: 68; javascript: 7
file content (37 lines) | stat: -rw-r--r-- 1,136 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

(*
 * Translation from one sort to another
 *)
functor MDLAstConstants(Ast : MDL_AST) : MDL_AST_CONSTANTS = 
struct

   structure Ast = Ast
   structure A   = Ast

   fun ID x = A.IDexp(A.IDENT([],x))

   abstype constTable = TABLE of (A.id * A.exp) list ref * int ref
   with fun newConstTable()  = TABLE(ref [], ref  0)
        fun const(TABLE(entries, counter)) e = 
        let fun lookup [] = 
                let val name = "TMP"^ Int.toString(!counter)
                in  counter := !counter + 1;
                    entries := (name, e) :: !entries;
                    ID name
                end
              | lookup((x,e')::rest) = if e = e' then ID x else lookup rest
        in  lookup(!entries) end
        fun genConsts(TABLE(entries, _)) = 
              map (fn (x,e) => A.VALdecl[A.VALbind(A.IDpat x,e)]) 
                   (rev(!entries))
        fun withConsts f =
        let val tbl    = newConstTable()
            val decl   = f (const tbl)
            val consts = genConsts tbl
        in  case consts of 
               [] => decl
            |  _  => A.LOCALdecl(consts,[decl])
        end
   end 

end