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 731 - (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 : leunga 731 fun swapFcond fcond =
30 :     case fcond of
31 :     ? => ? | !<=> => !<=> | == => ==
32 :     | ?= => ?= | !<> => !<> | !?>= => !?<=
33 :     | < => > | ?< => ?> | !>= => !<=
34 :     | !?> => !?< | <= => >= | ?<= => ?>=
35 :     | !> => !< | !?<= => !?>= | > => <
36 :     | ?> => ?< | !<= => !>= | !?< => !?>
37 :     | >= => <= | ?>= => ?<= | !< => !>
38 :     | !?= => !?= | <> => <> | != => !=
39 :     | !? => !? | <=> => <=> | ?<> => ?<>
40 :    
41 : george 545 fun negateCond cond =
42 :     case cond of
43 :     LT => GE | LTU => GEU | LE => GT | LEU => GTU | EQ => NE
44 :     | NE => EQ | GE => LT | GEU => LTU | GT => LE | GTU => LEU
45 :    
46 :     fun hashCond cond =
47 :     case cond of
48 :     LT => 0w123 | LTU => 0w758 | LE => 0w81823 | LEU => 0w1231
49 :     | EQ => 0w987 | NE => 0w8819 | GE => 0w88123 | GEU => 0w975
50 :     | GT => 0w1287 | GTU => 0w2457
51 :    
52 :     fun condToString cond =
53 :     case cond of
54 :     LT => "<" | LTU => "<u" | LE => "<=" | LEU => "<=u"
55 :     | EQ => "=" | NE => "<>" | GE => ">=" | GEU => ">=u"
56 :     | GT => ">" | GTU => ">u"
57 :    
58 :     fun hashFcond fcond =
59 :     case fcond of
60 :     ? => 0w123 | !<=> => 0w1234 | == => 0w12345 | ?= => 0w123456
61 :     | !<> => 0w234 | !?>= => 0w2345 | < => 0w23456 | ?< => 0w345
62 :     | !>= => 0w3456 | !?> => 0w34567 | <= => 0w456 | ?<= => 0w4567
63 :     | !> => 0w45678 | !?<= => 0w567 | > => 0w5678 | ?> => 0w56789
64 :     | !<= => 0w678 | !?< => 0w6789 | >= => 0w67890 | ?>= => 0w789
65 :     | !< => 0w7890 | !?= => 0w78901 | <> => 0w890 | != => 0w8901
66 :     | !? => 0w89012 | <=> => 0w991 | ?<> => 0w391
67 :    
68 :     fun fcondToString fcond =
69 :     case fcond of
70 :     ? => "?" | !<=> => "!<=>" | == => "==" | ?= => "?="
71 :     | !<> => "!<>" | !?>= => "!?>=" | < => "<" | ?< => "?<"
72 :     | !>= => "!>=" | !?> => "!?>" | <= => "<=" | ?<= => "?<="
73 :     | !> => "!>" | !?<= => "!?<=" | > => ">" | ?> => "?>"
74 :     | !<= => "!<=" | !?< => "!?<" | >= => ">=" | ?>= => "?>="
75 :     | !< => "!<" | !?= => "!?=" | <> => "<>" | != => "!="
76 :     | !? => "!?" | <=> => "<=>" | ?<> => "?<>"
77 :    
78 :     fun hashRoundingMode m =
79 :     case m of
80 :     TO_NEAREST => 0w1 | TO_NEGINF => 0w10
81 :     | TO_POSINF => 0w100 | TO_ZERO => 0w1000
82 :    
83 :     fun roundingModeToString m =
84 :     case m of
85 :     TO_NEAREST => "to_nearest" | TO_NEGINF => "to_neginf"
86 :     | TO_POSINF => "to_posinf" | TO_ZERO => "to_zero"
87 :    
88 :     end (* MLTreeBasis *)

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