File: ast-util.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 (154 lines) | stat: -rw-r--r-- 5,796 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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
functor MDLAstUtil(Ast : MDL_AST) : MDL_AST_UTIL =
struct

   structure Ast = Ast
   open Ast

   fun ID id = IDexp(IDENT([],id))
   fun APP(f,e) = APPexp(ID f,e)
   fun BINOPexp(f,x,y) = APP(f,TUPLEexp[x,y])
   fun PLUS(a,LITexp(INTlit 0)) = a
     | PLUS(a,LITexp(WORDlit 0w0)) = a
     | PLUS(a,LITexp(WORD32lit 0w0)) = a
     | PLUS(LITexp(INTlit 0),a) = a
     | PLUS(LITexp(WORDlit 0w0),a) = a
     | PLUS(LITexp(WORD32lit 0w0),a) = a
     | PLUS(a,b) = BINOPexp("+",a,b)
   fun MINUS(a,LITexp(INTlit 0)) = a
     | MINUS(a,LITexp(WORDlit 0w0)) = a
     | MINUS(a,LITexp(WORD32lit 0w0)) = a
     | MINUS(a,b) = BINOPexp("-",a,b)
   fun ANDB(a,b) = BINOPexp("&&",a,b)
   fun ORB(a,b) = BINOPexp("||",a,b)
   fun SLL(a,LITexp(WORDlit 0w0)) = a
     | SLL(a,LITexp(WORD32lit 0w0)) = a
     | SLL(a,LITexp(INTlit 0)) = a
     | SLL(a,b) = BINOPexp("<<",a,b)
   fun SLR(a,LITexp(WORDlit 0w0)) = a
     | SLR(a,LITexp(WORD32lit 0w0)) = a
     | SLR(a,LITexp(INTlit 0)) = a
     | SLR(a,b) = BINOPexp(">>",a,b)
   fun SAR(a,LITexp(WORDlit 0w0)) = a
     | SAR(a,LITexp(WORD32lit 0w0)) = a
     | SAR(a,LITexp(INTlit 0)) = a
     | SAR(a,b) = BINOPexp("~>>",a,b)

   fun BOOLexp x = LITexp(BOOLlit x)
   fun STRINGexp s = LITexp(STRINGlit s)
   fun INTexp x = LITexp(INTlit x)
   fun INT32exp x = LITexp(INT32lit x)
   fun INTINFexp x = LITexp(INTINFlit x)
   fun CHARexp x = LITexp(CHARlit x)
   fun WORDexp x = LITexp(WORDlit x)
   fun WORD32exp x = LITexp(WORD32lit x)

   fun BOOLpat x = LITpat(BOOLlit x)
   fun STRINGpat s = LITpat(STRINGlit s)
   fun INTpat x = LITpat(INTlit x)
   fun INT32pat x = LITpat(INT32lit x)
   fun INTINFpat x = LITpat(INTINFlit x)
   fun CHARpat x = LITpat(CHARlit x)
   fun WORDpat x = LITpat(WORDlit x)
   fun WORD32pat x = LITpat(WORD32lit x)

   val UNIT = TUPLEexp []
   val TRUE = BOOLexp true
   val FALSE = BOOLexp false
   fun ANDALSO(LITexp(BOOLlit true),x) = x
     | ANDALSO(LITexp(BOOLlit false),x) = FALSE
     | ANDALSO(x,LITexp(BOOLlit true)) = x
     | ANDALSO(x,LITexp(BOOLlit false)) = FALSE
     | ANDALSO(x,y) = BINOPexp("andalso",x,y)
   fun ORELSE(LITexp(BOOLlit true),x) = TRUE
     | ORELSE(LITexp(BOOLlit false),x) = x
     | ORELSE(x,LITexp(BOOLlit true)) = TRUE
     | ORELSE(x,LITexp(BOOLlit false)) = x
     | ORELSE(x,y) = BINOPexp("orelse",x,y)
   val NILexp = LISTexp([],NONE)


   val UNITty = IDty(IDENT([],"unit"))
   val BOOLty = IDty(IDENT([],"bool"))
   val INTty = IDty(IDENT([],"int"))
   val REGISTERty = IDty(IDENT([],"CellsBasis.cell"))
   val REGISTERLISTty = APPty(IDENT([],"list"),[REGISTERty])
   val INTLISTty = APPty(IDENT([],"list"),[INTty])
   val STRINGty = IDty(IDENT([],"string"))
   val WORD32ty = IDty(IDENT(["Word32"],"word"))
   val WORDty = IDty(IDENT(["Word"],"word"))
   val LABELty = IDty(IDENT(["Label"],"label"))
   val LABEXPty = IDty(IDENT(["LabelExp"],"labexp"))
   val CONSTty = IDty(IDENT(["Constant"],"const"))
   val CELLKINDty = IDty(IDENT([],"CellsBasis.cellkind"))
   val CELLSETty = IDty(IDENT([],"cellset"))

   fun DATATYPE(id,args,cbs) = 
        DATATYPEbind{id=id,tyvars=args,mc=NONE,asm=false,field=NONE,cbs=cbs}
   fun CONS(id,arg) = CONSbind{id=id,ty=arg,mc=NONE,asm=NONE,rtl=NONE,
                               nop=FLAGoff,nullified=FLAGoff,
                               delayslot=NONE,
                               delaycand=NONE,sdi=NONE,latency=NONE,
                               pipeline=NONE, loc=SourceMapping.dummyLoc}
   fun VAL(id,e) = VALdecl[VALbind(case id of "_" => WILDpat | _ => IDpat id,e)]
   fun FUN'(id,p,e) = FUNbind(id,[CLAUSE([p],NONE,e)])
   fun FUN(id,p,e) = FUNdecl [FUN'(id,p,e)]
   fun LET([],e) = e 
     | LET(d,e) = LETexp(d,[e])


   fun ERROR text = CLAUSE([WILDpat],NONE,APP("error",STRINGexp text))
   fun ERRORfun name = 
       $["fun error msg = MLRiscErrorMsg.error(\""^name^"\",msg)"]
   fun DUMMYfun name = 
       $["fun "^name^" _ = error \""^name^"\""]
 

   fun BITSLICE(e,ranges) =
   let val temp = ID "temp"
       fun gen(tmp, [], pos, e) = e
         | gen(tmp, (a,b)::slices, pos, e) =
           let val width = b - a + 1
               val mask  = Word32.<<(0w1, Word.fromInt width) - 0w1
               val field = SLL(tmp, WORD32exp(Word32.fromInt a))
               val field = ANDB(field, WORD32exp mask)
           in  gen(tmp, slices, pos+width,
                   PLUS(SLL(field, WORD32exp(Word32.fromInt pos)),e))
           end
       fun emit(tmp) = gen(tmp, rev ranges, 0, WORD32exp 0w0)
   in  case ranges of
         [_] => emit e
       | _   => LETexp([VALdecl[VALbind(IDpat "temp",e)]], [emit(ID "temp")])
   end

      (* Add an entry *)
   fun cons(x,LISTexp(a,b)) = LISTexp(x::a,b)
     | cons(x,y)            = LISTexp([x],SOME y)

   (* Append an entry *)
   fun append(x,LISTexp([],NONE)) = x
     | append(x,y) = APP("@",TUPLEexp[x,y])

   fun compareLiteral(x,y) =
   let fun kind(INTlit _) = 0
         | kind(BOOLlit _) = 1
         | kind(STRINGlit _) = 2
         | kind(CHARlit _) = 3
         | kind(WORDlit _) = 4
         | kind(WORD32lit _) = 5
         | kind(INTINFlit _) = 6
         | kind(REALlit _) = 7
         | kind(INT32lit _) = 8
   in  case (x, y) of
         (INTlit x,INTlit y) => Int.compare(x,y)
       | (INT32lit x,INT32lit y) => Int32.compare(x,y)
       | (BOOLlit x,BOOLlit y) => if x = y then EQUAL 
                                  else if x = false then LESS else GREATER
       | (STRINGlit x,STRINGlit y) => String.compare(x,y)
       | (CHARlit x,CHARlit y) => Char.compare(x,y)
       | (WORDlit x,WORDlit y) => Word.compare(x,y)
       | (WORD32lit x,WORD32lit y) => Word32.compare(x,y)
       | (INTINFlit x,INTINFlit y) => IntInf.compare(x,y)
       | (REALlit x,REALlit y) => String.compare(x,y)
       | (x, y) => Int.compare(kind x,kind y)
   end
end