Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/MLRISC/Tools/FakeSMLAst/ast-util.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/Tools/FakeSMLAst/ast-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 775 - (view) (download)

1 : leunga 744 functor MDLAstUtil(Ast : MDL_AST) : MDL_AST_UTIL =
2 :     struct
3 :    
4 :     structure Ast = Ast
5 :     open Ast
6 :    
7 :     fun ID id = IDexp(IDENT([],id))
8 :     fun APP(f,e) = APPexp(ID f,e)
9 :     fun BINOPexp(f,x,y) = APP(f,TUPLEexp[x,y])
10 :     fun PLUS(a,LITexp(INTlit 0)) = a
11 :     | PLUS(a,LITexp(WORDlit 0w0)) = a
12 :     | PLUS(a,LITexp(WORD32lit 0w0)) = a
13 :     | PLUS(LITexp(INTlit 0),a) = a
14 :     | PLUS(LITexp(WORDlit 0w0),a) = a
15 :     | PLUS(LITexp(WORD32lit 0w0),a) = a
16 :     | PLUS(a,b) = BINOPexp("+",a,b)
17 :     fun MINUS(a,LITexp(INTlit 0)) = a
18 :     | MINUS(a,LITexp(WORDlit 0w0)) = a
19 :     | MINUS(a,LITexp(WORD32lit 0w0)) = a
20 :     | MINUS(a,b) = BINOPexp("-",a,b)
21 :     fun ANDB(a,b) = BINOPexp("&&",a,b)
22 :     fun ORB(a,b) = BINOPexp("||",a,b)
23 :     fun SLL(a,LITexp(WORDlit 0w0)) = a
24 :     | SLL(a,LITexp(WORD32lit 0w0)) = a
25 :     | SLL(a,LITexp(INTlit 0)) = a
26 :     | SLL(a,b) = BINOPexp("<<",a,b)
27 :     fun SLR(a,LITexp(WORDlit 0w0)) = a
28 :     | SLR(a,LITexp(WORD32lit 0w0)) = a
29 :     | SLR(a,LITexp(INTlit 0)) = a
30 :     | SLR(a,b) = BINOPexp(">>",a,b)
31 :     fun SAR(a,LITexp(WORDlit 0w0)) = a
32 :     | SAR(a,LITexp(WORD32lit 0w0)) = a
33 :     | SAR(a,LITexp(INTlit 0)) = a
34 :     | SAR(a,b) = BINOPexp("~>>",a,b)
35 :    
36 :     fun BOOLexp x = LITexp(BOOLlit x)
37 :     fun STRINGexp s = LITexp(STRINGlit s)
38 :     fun INTexp x = LITexp(INTlit x)
39 : leunga 775 fun INTINFexp x = LITexp(INTINFlit x)
40 : leunga 744 fun CHARexp x = LITexp(CHARlit x)
41 :     fun WORDexp x = LITexp(WORDlit x)
42 :     fun WORD32exp x = LITexp(WORD32lit x)
43 :    
44 :     fun BOOLpat x = LITpat(BOOLlit x)
45 :     fun STRINGpat s = LITpat(STRINGlit s)
46 :     fun INTpat x = LITpat(INTlit x)
47 : leunga 775 fun INTINFpat x = LITpat(INTINFlit x)
48 : leunga 744 fun CHARpat x = LITpat(CHARlit x)
49 :     fun WORDpat x = LITpat(WORDlit x)
50 :     fun WORD32pat x = LITpat(WORD32lit x)
51 :    
52 :     val UNIT = TUPLEexp []
53 :     val TRUE = BOOLexp true
54 :     val FALSE = BOOLexp false
55 :     fun ANDALSO(LITexp(BOOLlit true),x) = x
56 :     | ANDALSO(LITexp(BOOLlit false),x) = FALSE
57 :     | ANDALSO(x,LITexp(BOOLlit true)) = x
58 :     | ANDALSO(x,LITexp(BOOLlit false)) = FALSE
59 :     | ANDALSO(x,y) = BINOPexp("andalso",x,y)
60 :     fun ORELSE(LITexp(BOOLlit true),x) = TRUE
61 :     | ORELSE(LITexp(BOOLlit false),x) = x
62 :     | ORELSE(x,LITexp(BOOLlit true)) = TRUE
63 :     | ORELSE(x,LITexp(BOOLlit false)) = x
64 :     | ORELSE(x,y) = BINOPexp("orelse",x,y)
65 :     val NILexp = LISTexp([],NONE)
66 :    
67 :    
68 :     val UNITty = IDty(IDENT([],"unit"))
69 :     val BOOLty = IDty(IDENT([],"bool"))
70 :     val INTty = IDty(IDENT([],"int"))
71 :     val REGISTERty = IDty(IDENT([],"cell"))
72 :     val REGISTERLISTty = APPty(IDENT([],"list"),[REGISTERty])
73 :     val INTLISTty = APPty(IDENT([],"list"),[INTty])
74 :     val STRINGty = IDty(IDENT([],"string"))
75 :     val WORD32ty = IDty(IDENT(["Word32"],"word"))
76 :     val WORDty = IDty(IDENT(["Word"],"word"))
77 :     val LABELty = IDty(IDENT(["Label"],"label"))
78 :     val LABEXPty = IDty(IDENT(["LabelExp"],"labexp"))
79 :     val CONSTty = IDty(IDENT(["Constant"],"const"))
80 :     val CELLKINDty = IDty(IDENT([],"cellkind"))
81 :     val CELLSETty = IDty(IDENT([],"cellset"))
82 :    
83 :     fun DATATYPE(id,args,cbs) =
84 :     DATATYPEbind{id=id,tyvars=args,mc=NONE,asm=false,field=NONE,cbs=cbs}
85 :     fun CONS(id,arg) = CONSbind{id=id,ty=arg,mc=NONE,asm=NONE,rtl=NONE,
86 :     nop=FLAGoff,nullified=FLAGoff,
87 :     delayslot=NONE,
88 :     delaycand=NONE,sdi=NONE,latency=NONE,
89 :     pipeline=NONE, loc=SourceMap.dummyLoc}
90 :     fun VAL(id,e) = VALdecl [VALbind(IDpat id,e)]
91 :     fun FUN'(id,p,e) = FUNbind(id,[CLAUSE([p],NONE,e)])
92 :     fun FUN(id,p,e) = FUNdecl [FUN'(id,p,e)]
93 :     fun LET([],e) = e
94 :     | LET(d,e) = LETexp(d,[e])
95 :    
96 :    
97 :     fun ERROR text = CLAUSE([WILDpat],NONE,APP("error",STRINGexp text))
98 :     fun ERRORfun name =
99 :     $["fun error msg = MLRiscErrorMsg.error(\""^name^"\",msg)"]
100 :     fun DUMMYfun name =
101 :     $["fun "^name^" _ = error \""^name^"\""]
102 :    
103 :    
104 :     fun BITSLICE(e,ranges) =
105 :     let val temp = ID "temp"
106 :     fun gen(tmp, [], pos, e) = e
107 :     | gen(tmp, (a,b)::slices, pos, e) =
108 :     let val width = b - a + 1
109 :     val mask = Word32.<<(0w1, Word.fromInt width) - 0w1
110 :     val field = SLL(tmp, WORD32exp(Word32.fromInt a))
111 :     val field = ANDB(field, WORD32exp mask)
112 :     in gen(tmp, slices, pos+width,
113 :     PLUS(SLL(field, WORD32exp(Word32.fromInt pos)),e))
114 :     end
115 :     fun emit(tmp) = gen(tmp, rev ranges, 0, WORD32exp 0w0)
116 :     in case ranges of
117 :     [_] => emit e
118 :     | _ => LETexp([VALdecl[VALbind(IDpat "temp",e)]], [emit(ID "temp")])
119 :     end
120 :    
121 :     (* Add an entry *)
122 :     fun cons(x,LISTexp(a,b)) = LISTexp(x::a,b)
123 :     | cons(x,y) = LISTexp([x],SOME y)
124 :    
125 :     (* Append an entry *)
126 :     fun append(x,LISTexp([],NONE)) = x
127 :     | append(x,y) = APP("@",TUPLEexp[x,y])
128 :    
129 :     fun compareLiteral(x,y) =
130 :     let fun kind(INTlit _) = 0
131 :     | kind(BOOLlit _) = 1
132 :     | kind(STRINGlit _) = 2
133 :     | kind(CHARlit _) = 3
134 :     | kind(WORDlit _) = 4
135 :     | kind(WORD32lit _) = 5
136 :     | kind(INTINFlit _) = 6
137 : leunga 775 | kind(REALlit _) = 7
138 : leunga 744 in case (x, y) of
139 :     (INTlit x,INTlit y) => Int.compare(x,y)
140 :     | (BOOLlit x,BOOLlit y) => if x = y then EQUAL
141 :     else if x = false then LESS else GREATER
142 :     | (STRINGlit x,STRINGlit y) => String.compare(x,y)
143 :     | (CHARlit x,CHARlit y) => Char.compare(x,y)
144 :     | (WORDlit x,WORDlit y) => Word.compare(x,y)
145 :     | (WORD32lit x,WORD32lit y) => Word32.compare(x,y)
146 :     | (INTINFlit x,INTINFlit y) => IntInf.compare(x,y)
147 : leunga 775 | (REALlit x,REALlit y) => String.compare(x,y)
148 : leunga 744 | (x, y) => Int.compare(kind x,kind y)
149 :     end
150 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0