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/mltree/mltree-basis.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/mltree/mltree-basis.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 545 - (view) (download)

1 : monnier 409 structure MLTreeBasis : MLTREE_BASIS =
2 :     struct
3 :    
4 :     datatype cond = LT | LTU | LE | LEU | EQ | NE | GE | GEU | GT | GTU
5 :    
6 :     datatype fcond = ? | !<=> | == | ?= | !<> | !?>= | < | ?< | !>= | !?> |
7 :     <= | ?<= | !> | !?<= | > | ?> | !<= | !?< | >= | ?>= |
8 :     !< | !?= | <> | != | !? | <=> | ?<>
9 :    
10 :     datatype ext = SIGN_EXTEND | ZERO_EXTEND
11 :    
12 :     datatype rounding_mode = TO_NEAREST | TO_NEGINF | TO_POSINF | TO_ZERO
13 :    
14 :     type attribs = word
15 :    
16 : george 545 type misc_op = {name:string,attribs:attribs,hash:word}
17 : monnier 409
18 : george 545 nonfix <> < > >= <=
19 :    
20 :     (* These should be datatypes, but FLINT does not optimize them well *)
21 : monnier 409 type ty = int
22 :     type fty = int
23 :    
24 : george 545 fun swapCond cond =
25 :     case cond of
26 :     LT => GT | LTU => GTU | LE => GE | LEU => GEU | EQ => EQ
27 :     | NE => NE | GE => LE | GEU => LEU | GT => LT | GTU => LTU
28 :    
29 :     fun negateCond cond =
30 :     case cond of
31 :     LT => GE | LTU => GEU | LE => GT | LEU => GTU | EQ => NE
32 :     | NE => EQ | GE => LT | GEU => LTU | GT => LE | GTU => LEU
33 :    
34 :     fun hashCond cond =
35 :     case cond of
36 :     LT => 0w123 | LTU => 0w758 | LE => 0w81823 | LEU => 0w1231
37 :     | EQ => 0w987 | NE => 0w8819 | GE => 0w88123 | GEU => 0w975
38 :     | GT => 0w1287 | GTU => 0w2457
39 :    
40 :     fun condToString cond =
41 :     case cond of
42 :     LT => "<" | LTU => "<u" | LE => "<=" | LEU => "<=u"
43 :     | EQ => "=" | NE => "<>" | GE => ">=" | GEU => ">=u"
44 :     | GT => ">" | GTU => ">u"
45 :    
46 :     fun hashFcond fcond =
47 :     case fcond of
48 :     ? => 0w123 | !<=> => 0w1234 | == => 0w12345 | ?= => 0w123456
49 :     | !<> => 0w234 | !?>= => 0w2345 | < => 0w23456 | ?< => 0w345
50 :     | !>= => 0w3456 | !?> => 0w34567 | <= => 0w456 | ?<= => 0w4567
51 :     | !> => 0w45678 | !?<= => 0w567 | > => 0w5678 | ?> => 0w56789
52 :     | !<= => 0w678 | !?< => 0w6789 | >= => 0w67890 | ?>= => 0w789
53 :     | !< => 0w7890 | !?= => 0w78901 | <> => 0w890 | != => 0w8901
54 :     | !? => 0w89012 | <=> => 0w991 | ?<> => 0w391
55 :    
56 :     fun fcondToString fcond =
57 :     case fcond of
58 :     ? => "?" | !<=> => "!<=>" | == => "==" | ?= => "?="
59 :     | !<> => "!<>" | !?>= => "!?>=" | < => "<" | ?< => "?<"
60 :     | !>= => "!>=" | !?> => "!?>" | <= => "<=" | ?<= => "?<="
61 :     | !> => "!>" | !?<= => "!?<=" | > => ">" | ?> => "?>"
62 :     | !<= => "!<=" | !?< => "!?<" | >= => ">=" | ?>= => "?>="
63 :     | !< => "!<" | !?= => "!?=" | <> => "<>" | != => "!="
64 :     | !? => "!?" | <=> => "<=>" | ?<> => "?<>"
65 :    
66 :     fun hashRoundingMode m =
67 :     case m of
68 :     TO_NEAREST => 0w1 | TO_NEGINF => 0w10
69 :     | TO_POSINF => 0w100 | TO_ZERO => 0w1000
70 :    
71 :     fun roundingModeToString m =
72 :     case m of
73 :     TO_NEAREST => "to_nearest" | TO_NEGINF => "to_neginf"
74 :     | TO_POSINF => "to_posinf" | TO_ZERO => "to_zero"
75 :    
76 :     end (* MLTreeBasis *)

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