Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Diff of /trunk/src/compiler/IL/gen/gen-ops.sml
[diderot] / trunk / src / compiler / IL / gen / gen-ops.sml  
ViewVC logotype

Diff of /trunk/src/compiler/IL/gen/gen-ops.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 281, Fri Aug 13 17:40:53 2010 UTC revision 282, Fri Aug 13 19:20:23 2010 UTC
# Line 41  Line 41 
41    
42    (* Specification file input *)    (* Specification file input *)
43    
44      type op_spec = {name : string, ty : string option, arity : int, comment : string option}      type op_spec = {name : string, ty : string list, arity : int, comment : string option}
45    
46      fun stripWS ss = SS.dropl Char.isSpace (SS.dropr Char.isSpace ss)      fun stripWS ss = SS.dropl Char.isSpace (SS.dropr Char.isSpace ss)
47    
# Line 52  Line 52 
52            else (case SS.fields (fn #":" => true | _ => false) ss            else (case SS.fields (fn #":" => true | _ => false) ss
53               of [name, ty, arity, comment] => SOME{               of [name, ty, arity, comment] => SOME{
54                      name = SS.string (stripWS name),                      name = SS.string (stripWS name),
55                      ty = optField (stripWS ty),                      ty = let
56                      arity = #1(valOf (Int.scan StringCvt.DEC SS.getc arity)),                        val ty = stripWS ty
57                          fun cvt ty = SS.string(stripWS ty)
58                          in
59                            if (SS.isEmpty ty)
60                              then []
61                              else List.map cvt (SS.fields (fn #"*" => true | _ => false) ty)
62                          end,
63                        arity = if SS.compare(stripWS arity, SS.full "*") = EQUAL
64                            then ~1 (* variable arity *)
65                            else #1(valOf (Int.scan StringCvt.DEC SS.getc arity)),
66                      comment = optField (stripWS comment)                      comment = optField (stripWS comment)
67                    }                    }
68                | [_] => NONE (* assume a blank line *)                | [_] => NONE (* assume a blank line *)
# Line 98  Line 107 
107            fun lp (_, []) = ()            fun lp (_, []) = ()
108              | lp (prefix, {name, ty, arity, comment}::r) = (              | lp (prefix, {name, ty, arity, comment}::r) = (
109                  case ty                  case ty
110                   of NONE => TextIO.output(outS, concat["      ", prefix, " ", name, "\n"])                   of [] => TextIO.output(outS, concat["      ", prefix, " ", name, "\n"])
111                    | SOME ty => TextIO.output(outS,                    | [ty] => TextIO.output(outS,
112                        concat["      ", prefix, " ", name, " of ", ty, "\n"])                        concat["      ", prefix, " ", name, " of ", ty, "\n"])
113                      | ty::tys => (
114                          TextIO.output(outS,
115                            concat["      ", prefix, " ", name, " of ", ty]);
116                          List.app (fn ty => TextIO.output(outS, " * "^ty)) tys;
117                          TextIO.output(outS, "\n"))
118                  (* end case *);                  (* end case *);
119                  lp ("|", r))                  lp ("|", r))
120            in            in
# Line 109  Line 123 
123            end            end
124    
125      fun genArity (outS, ops) = let      fun genArity (outS, ops) = let
126            fun genOp {name, ty=NONE, arity, comment} =            fun genOp {name, ty=[], arity, comment} =
127                  TextIO.output(outS, concat[name, " = ", Int.toString arity, "\n"])                  TextIO.output(outS, concat[name, " = ", Int.toString arity, "\n"])
128              | genOp {name, arity, ...} =              | genOp {name, arity, ...} =
129                  TextIO.output(outS, concat["(", name, " _) = ", Int.toString arity, "\n"])                  TextIO.output(outS, concat["(", name, " _) = ", Int.toString arity, "\n"])
# Line 118  Line 132 
132            end            end
133    
134      fun genSame (outS, ops) = let      fun genSame (outS, ops) = let
135            fun genOp {name, ty=NONE, arity, comment} =            fun prl l = TextIO.output(outS, concat l)
136                  TextIO.output(outS,            fun genOp {name, ty=[], arity, comment} =
137                    concat["(", name, ", ", name, ") = true\n"])                  prl ["(", name, ", ", name, ") = true\n"]
138              | genOp {name, ty=SOME argTy, arity, ...} = let              | genOp {name, ty=ty::tys, arity, ...} = let
139                  val test = (case pathOf argTy                  fun test argTy = (case pathOf argTy
140                         of SOME path => path ^ ".same"                         of SOME path => path ^ ".same"
141                          | NONE => "same" ^ argTy                          | NONE => "same" ^ argTy
142                        (* end case *))                        (* end case *))
143                  in                  val nArgs = List.length tys + 1
144                    TextIO.output(outS,                  val arg1::args1 = List.tabulate(nArgs, fn i => "a"^Int.toString i)
145                      concat["(", name, " a, ", name, " b) = ", test, "(a, b)\n"])                  val arg2::args2 = List.tabulate(nArgs, fn i => "b"^Int.toString i)
146                    fun app3 f (x::xs, y::ys, z::zs) = (f(x, y, z); app3 f (xs, ys, zs))
147                      | app3 f ([], [], []) = ()
148                    in
149                      prl ["(", name, "(", arg1];
150                      List.app (fn x => prl [",", x]) args1;
151                      prl ["), ", name, "(", arg2];
152                      List.app (fn x => prl [",", x]) args2;
153                      prl [")) = ", test ty, "(a0, b0)"];
154                      app3
155                        (fn (ty, a, b) => prl[" andalso ", test ty, "(", a, ", ", b, ")"])
156                          (tys, args1, args2);
157                      TextIO.output(outS,"\n")
158                  end                  end
159            in            in
160              genFun (outS, "same", ops, genOp);              genFun (outS, "same", ops, genOp);
# Line 160  Line 186 
186            ]            ]
187    
188      fun genHash (outS, ops) = let      fun genHash (outS, ops) = let
189            fun genOp (i, {name, ty=NONE, arity, comment}) =            fun prl l = TextIO.output(outS, concat l)
190                  TextIO.output(outS,            fun genOp (i, {name, ty=[], arity, comment}) =
191                    concat[name, " = 0w", Int.toString(Vector.sub(primes, i)), "\n"])                  prl [name, " = 0w", Int.toString(Vector.sub(primes, i)), "\n"]
192              | genOp (i, {name, ty=SOME argTy, ...}) = let              | genOp (i, {name, ty=ty::tys, ...}) = let
193                  val hash = (case pathOf argTy                  fun hash argTy = (case pathOf argTy
194                         of SOME path => path ^ ".hash"                         of SOME path => path ^ ".hash"
195                          | NONE => "hash" ^ argTy                          | NONE => "hash" ^ argTy
196                        (* end case *))                        (* end case *))
197                    val arg::args = List.tabulate(List.length tys + 1, fn i => "a"^Int.toString i)
198                  in                  in
199                    TextIO.output(outS, concat[                    prl ["(", name, "(", arg];
200                        "(", name, " a) = 0w", Int.toString(Vector.sub(primes, i)),                    List.app (fn x => prl [",", x]) args;
201                        " + ", hash, " a\n"                    prl [
202                      ])                        ")) = 0w", Int.toString(Vector.sub(primes, i)),
203                          " + ", hash ty, " ", arg
204                        ];
205                      ListPair.appEq
206                        (fn (ty, x) => prl [" + ", hash ty, " ", x])
207                          (tys, args);
208                      TextIO.output(outS, "\n")
209                  end                  end
210            fun lp (_, _, []) = ()            fun lp (_, _, []) = ()
211              | lp (i, prefix, rator::r) = (              | lp (i, prefix, rator::r) = (
212                  TextIO.output(outS, concat["    ", prefix, " hash "]);                  prl ["    ", prefix, " hash "];
213                  genOp (i, rator);                  genOp (i, rator);
214                  lp (i+1, "  |", r))                  lp (i+1, "  |", r))
215            in            in
# Line 184  Line 217 
217            end            end
218    
219      fun genToString (outS, ops) = let      fun genToString (outS, ops) = let
220            fun genOp {name, ty=NONE, arity, comment} =            fun prl l = TextIO.output(outS, concat l)
221                  TextIO.output(outS, concat[name, " = \"", name, "\"\n"])            fun genOp {name, ty=[], arity, comment} =
222              | genOp {name, ty=SOME argTy, ...} = let                  prl [name, " = \"", name, "\"\n"]
223                  val toS = (case pathOf argTy              | genOp {name, ty=ty::tys, ...} = let
224                    fun toS argTy = (case pathOf argTy
225                         of SOME path => path ^ ".toString"                         of SOME path => path ^ ".toString"
226                          | NONE => argTy ^ "ToString"                          | NONE => argTy ^ "ToString"
227                        (* end case *))                        (* end case *))
228                    val arg::args = List.tabulate(List.length tys + 1, fn i => "a"^Int.toString i)
229                  in                  in
230                    TextIO.output(outS,                    prl ["(", name, "(", arg];
231                      concat["(", name, " a) = concat[\"", name, "(\", ", toS, " a, \")\"]\n"])                    List.app (fn x => prl [",", x]) args;
232                      prl [")) = concat[\"", name, "<\", ", toS ty, " ", arg];
233                      ListPair.app
234                        (fn (ty, x) => prl["\",\", ", toS ty, " ", arg])
235                          (tys, args);
236                      TextIO.output(outS, ", \">\"]\n")
237                  end                  end
238            in            in
239              genFun (outS, "toString", ops, genOp)              genFun (outS, "toString", ops, genOp)
Legend:
Removed from v.281  
changed lines
  Added in v.282
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge