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

SCM Repository

[diderot] Diff of /branches/vis12/src/compiler/gen/il/gen-ops.sml
ViewVC logotype

Diff of /branches/vis12/src/compiler/gen/il/gen-ops.sml

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

revision 2279, Sat Mar 9 12:21:57 2013 UTC revision 2280, Sat Mar 9 13:37:40 2013 UTC
# Line 18  Line 18 
18   *      arity   *      arity
19   *      comment                 (optional)   *      comment                 (optional)
20   *   *
21     *  Operations with effects are denoted by a "!" as the first character of the line.
22     *
23   * The template file must contain a line consisting of just the string "@BODY@" (i.e.,   * The template file must contain a line consisting of just the string "@BODY@" (i.e.,
24   * without leading/trailing whitespace).  This line is replaced with the generated   * without leading/trailing whitespace).  This line is replaced with the generated
25   * definitions; all other lines are passed to the output file unchanged.   * definitions; all other lines are passed to the output file unchanged.
26   *   *
27   * We generate five definitions:   * We generate the following definitions:
28   *   *
29   *      datatype rator = ...   *      datatype rator = ...
30   *      val arity : rator -> int   *      val arity : rator -> int
31     *      val resArity : rator -> int
32     *      val pure : rator -> bool
33   *      val same : rator * rator -> bool   *      val same : rator * rator -> bool
34   *      val hash : rator -> word   *      val hash : rator -> word
35   *      val toString : rator -> toString   *      val toString : rator -> toString
# Line 45  Line 49 
49    (* operator-specification fields *)    (* operator-specification fields *)
50      type op_spec = {      type op_spec = {
51          name : string,          name : string,
52            isPure : bool,
53          ty : string list,          ty : string list,
54          resArity : int,          resArity : int,
55          arity : int,          arity : int,
# Line 55  Line 60 
60    
61      fun optField ss = if (SS.isEmpty ss) then NONE else SOME(SS.string ss)      fun optField ss = if (SS.isEmpty ss) then NONE else SOME(SS.string ss)
62    
63      fun doLine ss = if (SS.sub(ss, 0) = #"#")      fun doLine ss = let
64            then NONE            fun doFields (isPure, ss) = (case SS.fields (fn #":" => true | _ => false) ss
           else (case SS.fields (fn #":" => true | _ => false) ss  
65               of [name, ty, resArity, arity, comment] => SOME{               of [name, ty, resArity, arity, comment] => SOME{
66                      name = SS.string (stripWS name),                      name = SS.string (stripWS name),
67                            isPure = isPure,
68                      ty = let                      ty = let
69                        val ty = stripWS ty                        val ty = stripWS ty
70                        fun cvt ty = SS.string(stripWS ty)                        fun cvt ty = SS.string(stripWS ty)
# Line 77  Line 82 
82                | [_] => NONE (* assume a blank line *)                | [_] => NONE (* assume a blank line *)
83                | _ => raise Fail "bogus input"                | _ => raise Fail "bogus input"
84              (* end case *))              (* end case *))
85              in
86                case SS.getc ss
87                 of NONE => NONE
88                  | SOME(#"#", _) => NONE
89                  | SOME(#"!", rest) => doFields (false, rest)
90                  | _ => doFields (true, ss)
91                (* end case *)
92              end
93    
94    (* read a specification file, returning a list of operator specifications *)    (* read a specification file, returning a list of operator specifications *)
95      fun readFile fname = let      fun readFile fname = let
# Line 114  Line 127 
127    
128      fun genType (outS, ops) = let      fun genType (outS, ops) = let
129            fun lp (_, []) = ()            fun lp (_, []) = ()
130              | lp (prefix, {name, ty, resArity, arity, comment}::r) = (              | lp (prefix, {name, isPure, ty, resArity, arity, comment}::r) = (
131                  case ty                  case ty
132                   of [] => TextIO.output(outS, concat["      ", prefix, " ", name, "\n"])                   of [] => TextIO.output(outS, concat["      ", prefix, " ", name, "\n"])
133                    | [ty] => TextIO.output(outS,                    | [ty] => TextIO.output(outS,
# Line 133  Line 146 
146    
147  (* FIXME: eventually we should use default values *)  (* FIXME: eventually we should use default values *)
148      fun genResArity (outS, ops) = let      fun genResArity (outS, ops) = let
149            fun genOp {name, ty=[], resArity, arity, comment} =            fun genOp {name, isPure, ty=[], resArity, arity, comment} =
150                  TextIO.output(outS, concat[name, " = ", Int.toString resArity, "\n"])                  TextIO.output(outS, concat[name, " = ", Int.toString resArity, "\n"])
151              | genOp {name, resArity, ...} =              | genOp {name, resArity, ...} =
152                  TextIO.output(outS, concat["(", name, " _) = ", Int.toString resArity, "\n"])                  TextIO.output(outS, concat["(", name, " _) = ", Int.toString resArity, "\n"])
# Line 142  Line 155 
155            end            end
156    
157      fun genArity (outS, ops) = let      fun genArity (outS, ops) = let
158            fun genOp {name, ty=[], resArity, arity, comment} =            fun genOp {name, isPure, ty=[], resArity, arity, comment} =
159                  TextIO.output(outS, concat[name, " = ", Int.toString arity, "\n"])                  TextIO.output(outS, concat[name, " = ", Int.toString arity, "\n"])
160              | genOp {name, arity, ...} =              | genOp {name, arity, ...} =
161                  TextIO.output(outS, concat["(", name, " _) = ", Int.toString arity, "\n"])                  TextIO.output(outS, concat["(", name, " _) = ", Int.toString arity, "\n"])
# Line 150  Line 163 
163              genFun (outS, "arity", ops, genOp)              genFun (outS, "arity", ops, genOp)
164            end            end
165    
166        fun genPurity (outS, ops) = let
167              fun lp (prefix, []) =
168                    TextIO.output(outS, concat["    ", prefix, " isPure _ = true\n"])
169                | lp (prefix, {name, isPure=false, ty, resArity, arity, comment}::ops) = (
170                    TextIO.output(outS, concat["    ", prefix, " isPure "]);
171                    case ty
172                     of [] => TextIO.output(outS, concat[name, " = false\n"])
173                      | _ => TextIO.output(outS, concat["(", name, " _) = false\n"])
174                    (* end case *);
175                    lp ("  |", ops))
176                | lp (prefix, {isPure=true, ...}::ops) = lp (prefix, ops)
177              in
178                lp ("fun", ops)
179              end
180    
181      fun genSame (outS, ops) = let      fun genSame (outS, ops) = let
182            fun prl l = TextIO.output(outS, concat l)            fun prl l = TextIO.output(outS, concat l)
183            fun genOp {name, ty=[], resArity, arity, comment} =            fun genOp {name, isPure, ty=[], resArity, arity, comment} =
184                  prl ["(", name, ", ", name, ") = true\n"]                  prl ["(", name, ", ", name, ") = true\n"]
185              | genOp {name, ty=ty::tys, arity, ...} = let              | genOp {name, ty=ty::tys, arity, ...} = let
186                  fun test argTy = (case pathOf argTy                  fun test argTy = (case pathOf argTy
# Line 206  Line 234 
234    
235      fun genHash (outS, ops) = let      fun genHash (outS, ops) = let
236            fun prl l = TextIO.output(outS, concat l)            fun prl l = TextIO.output(outS, concat l)
237            fun genOp (i, {name, ty=[], resArity, arity, comment}) =            fun genOp (i, {name, isPure, ty=[], resArity, arity, comment}) =
238                  prl [name, " = 0w", Int.toString(Vector.sub(primes, i)), "\n"]                  prl [name, " = 0w", Int.toString(Vector.sub(primes, i)), "\n"]
239              | genOp (i, {name, ty=ty::tys, ...}) = let              | genOp (i, {name, ty=ty::tys, ...}) = let
240                  fun hash argTy = (case pathOf argTy                  fun hash argTy = (case pathOf argTy
# Line 237  Line 265 
265    
266      fun genToString (outS, ops) = let      fun genToString (outS, ops) = let
267            fun prl l = TextIO.output(outS, concat l)            fun prl l = TextIO.output(outS, concat l)
268            fun genOp {name, ty=[], resArity, arity, comment} =            fun genOp {name, isPure, ty=[], resArity, arity, comment} =
269                  prl [name, " = \"", name, "\"\n"]                  prl [name, " = \"", name, "\"\n"]
270              | genOp {name, ty=ty::tys, ...} = let              | genOp {name, ty=ty::tys, ...} = let
271                  fun toS argTy = (case pathOf argTy                  fun toS argTy = (case pathOf argTy
# Line 265  Line 293 
293            TextIO.output(outS, "\n");            TextIO.output(outS, "\n");
294            genArity (outS, ops);            genArity (outS, ops);
295            TextIO.output(outS, "\n");            TextIO.output(outS, "\n");
296              genPurity (outS, ops);
297              TextIO.output(outS, "\n");
298            genSame (outS, ops);            genSame (outS, ops);
299            TextIO.output(outS, "\n");            TextIO.output(outS, "\n");
300            genHash (outS, ops);            genHash (outS, ops);

Legend:
Removed from v.2279  
changed lines
  Added in v.2280

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