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

SCM Repository

[smlnj] Diff of /sml/trunk/compiler/CPS/cps/ppcps.sml
ViewVC logotype

Diff of /sml/trunk/compiler/CPS/cps/ppcps.sml

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

sml/trunk/src/compiler/FLINT/cps/ppcps.sml revision 733, Fri Nov 17 05:13:45 2000 UTC sml/trunk/compiler/CPS/cps/ppcps.sml revision 4953, Mon Apr 8 17:31:53 2019 UTC
# Line 1  Line 1 
1  (* Copyright 1996 by Bell Laboratories *)  (* ppcps.sml
2  (* ppcps.sml *)   *
3     * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
4     * All rights reserved.
5     *)
6    
7  signature PPCPS =  signature PPCPS =
8  sig  sig
9    
10        val value2str : CPS.value -> string
11    
12    val printcps : (CPS.function * LtyDef.lty IntHashTable.hash_table) -> unit    val printcps : (CPS.function * LtyDef.lty IntHashTable.hash_table) -> unit
13    val printcps0: CPS.function -> unit    val printcps0: CPS.function -> unit
14    val prcps : CPS.cexp -> unit    val prcps : CPS.cexp -> unit
# Line 14  Line 20 
20    
21  local open CPS  local open CPS
22        structure LV = LambdaVar        structure LV = LambdaVar
23          structure U = CPSUtil
24  in  in
25    
26  val say = Control.Print.say  val say = Control.Print.say
27    
28  val sayt = say o CPS.ctyToString  val sayt = say o U.ctyToString
29    
30    fun value2str (VAR v) = LV.lvarName v
31      | value2str (LABEL v) = "(L)" ^ LV.lvarName v
32      | value2str (NUM{ival, ty={sz=0, ...}}) = "(II)" ^ IntInf.toString ival
33      | value2str (NUM{ival, ty={tag=true, ...}}) = "(I)" ^ IntInf.toString ival
34      | value2str (NUM{ival, ty={sz, ...}}) = concat[
35            "(I", Int.toString sz, ")", IntInf.toString ival
36          ]
37      | value2str (REAL{rval, ty}) = concat[
38            "(R", Int.toString ty, ")", RealLit.toString rval
39          ]
40      | value2str (STRING s) = concat["\"", String.toString s, "\""]
41      | value2str (VOID) = "(void)"
42    
43  fun numkindName (P.INT bits) = "i" ^ Int.toString bits  fun numkindName (P.INT bits) = "i" ^ Int.toString bits
44    | numkindName (P.UINT bits) = "u" ^ Int.toString bits    | numkindName (P.UINT bits) = "u" ^ Int.toString bits
# Line 28  Line 48 
48    | lookerName P.gethdlr = "gethdlr"    | lookerName P.gethdlr = "gethdlr"
49    | lookerName P.subscript = "subscript"    | lookerName P.subscript = "subscript"
50    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)    | lookerName (P.numsubscript{kind}) = ("numsubscript" ^ numkindName kind)
   | lookerName P.getrunvec = "getrunvec"  
51    | lookerName P.getvar = "getvar"    | lookerName P.getvar = "getvar"
   | lookerName P.deflvar = "deflvar"  
52    | lookerName P.getspecial = "getspecial"    | lookerName P.getspecial = "getspecial"
53    | lookerName P.getpseudo = "getpseudo"    | lookerName (P.rawload {kind}) = ("rawload" ^ numkindName kind)
54    
55  fun branchName P.boxed = "boxed"  fun branchName P.boxed = "boxed"
56    | branchName P.unboxed = "unboxed"    | branchName P.unboxed = "unboxed"
57    | branchName (P.cmp{oper, kind}) =    | branchName (P.cmp{oper, kind}) =
58      (numkindName kind ^      (numkindName kind ^
59       (case oper       (case oper
60        of P.>   => ">"        of P.GT   => ">"
61         | P.<   => "<"         | P.LT   => "<"
62         | P.>=  => ">="         | P.GTE  => ">="
63         | P.<=  => "<="         | P.LTE  => "<="
64         | P.eql => "="         | P.EQL => "="
65         | P.neq => "<>"         | P.NEQ => "<>"
66        (*esac*)))        (*esac*)))
67    | branchName(P.fcmp{oper, size}) =    | branchName(P.fcmp{oper, size}) =
68      (numkindName (P.FLOAT size) ^      (numkindName (P.FLOAT size) ^
# Line 63  Line 81 
81         | P.fULE  => "?<="         | P.fULE  => "?<="
82         | P.fUE   => "?="         | P.fUE   => "?="
83         | P.fUN   => "?"         | P.fUN   => "?"
84               | P.fsgn  => "sgn"
85       (*esac*)))       (*esac*)))
86    | branchName P.pneq = "pneq"    | branchName P.pneq = "pneq"
87    | branchName P.peql = "peql"    | branchName P.peql = "peql"
# Line 70  Line 89 
89    | branchName P.strneq = "strneq"    | branchName P.strneq = "strneq"
90    
91  fun setterName P.unboxedupdate = "unboxedupdate"  fun setterName P.unboxedupdate = "unboxedupdate"
   | setterName P.boxedupdate = "boxedupdate"  
92    | setterName P.update = "update"    | setterName P.update = "update"
93    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)    | setterName (P.numupdate{kind}) = ("numupdate" ^ numkindName kind)
94    | setterName P.unboxedassign = "unboxedassign"    | setterName P.unboxedassign = "unboxedassign"
95    | setterName P.assign = "assign"    | setterName P.assign = "assign"
96    | setterName P.sethdlr = "sethdlr"    | setterName P.sethdlr = "sethdlr"
97    | setterName P.setvar = "setvar"    | setterName P.setvar = "setvar"
   | setterName P.uselvar = "uselvar"  
   | setterName P.free = "free"  
98    | setterName P.setspecial = "setspecial"    | setterName P.setspecial = "setspecial"
99    | setterName P.setpseudo = "setpseudo"    | setterName (P.rawstore {kind}) = ("rawstore" ^ numkindName kind)
100    | setterName P.setmark = "setmark"    | setterName (P.rawupdate cty) = ("rawupdate" ^ U.ctyToString cty)
   | setterName P.acclink = "acclink"  
101    
102  fun cvtParams(from, to) = Int.toString from ^ "_" ^ Int.toString to  val cvtParam = Int.toString
103    fun cvtParams(from, to) = concat [cvtParam from, "_", cvtParam to]
104    
105  fun arithName (P.arith{oper,kind}) =  fun arithName (P.arith{oper,kind}) =
106      ((case oper of  P.+ => "+" |  P.- => "-" |  P.* => "*"      ((case oper of  P.ADD => "+" |  P.SUB => "-" |  P.MUL => "*"
107                    | P./ => "/" |  P.~ => "~" | P.abs => "abs"                    | P.DIV => "div" | P.MOD => "mod"
108                    | P.fsqrt => "fsqrt"                    | P.QUOT => "quot" | P.REM => "rem"
109                    | P.fsin => "sin" | P.fcos => "cos" | P.ftan => "tan"                    | P.FDIV => "/"
110                    | P.rshift => "rshift" | P.rshiftl => "rshiftl"                    | P.NEG => "~" | P.ABS => "abs"
111                    | P.lshift => "lshift" | P.andb => "andb"                    | P.FSQRT => "fsqrt"
112                    | P.orb => "orb" | P.xorb => "xorb" | P.notb => "notb")                    | P.FSIN => "sin" | P.FCOS => "cos" | P.FTAN => "tan"
113                      | P.RSHIFT => "rshift" | P.RSHIFTL => "rshiftl"
114                      | P.LSHIFT => "lshift" | P.ANDB => "andb"
115                      | P.ORB => "orb" | P.XORB => "xorb" | P.NOTB => "notb")
116       ^ numkindName kind)       ^ numkindName kind)
117    | arithName(P.test arg) = "test_" ^ cvtParams arg    | arithName(P.test arg) = "test_" ^ cvtParams arg
118    | arithName(P.testu arg) = "testu_" ^ cvtParams arg    | arithName(P.testu arg) = "testu_" ^ cvtParams arg
119      | arithName(P.test_inf i) = "test_inf_" ^ cvtParam i
120    | arithName (P.round{floor=true,fromkind=P.FLOAT 64,tokind=P.INT 31}) =    | arithName (P.round{floor=true,fromkind=P.FLOAT 64,tokind=P.INT 31}) =
121        "floor"        "floor"
122    | arithName (P.round{floor=false,fromkind=P.FLOAT 64,tokind=P.INT 31}) =    | arithName (P.round{floor=false,fromkind=P.FLOAT 64,tokind=P.INT 31}) =
# Line 112  Line 132 
132    | pureName (P.extend arg) = "extend_" ^ cvtParams arg    | pureName (P.extend arg) = "extend_" ^ cvtParams arg
133    | pureName (P.copy arg) = "copy_" ^ cvtParams arg    | pureName (P.copy arg) = "copy_" ^ cvtParams arg
134    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg    | pureName (P.trunc arg) = "trunc_" ^ cvtParams arg
135      | pureName (P.trunc_inf i) = "trunc_inf_" ^ cvtParam i
136      | pureName (P.copy_inf i) = concat ["copy_", cvtParam i, "_inf"]
137      | pureName (P.extend_inf i) =  concat ["extend_", cvtParam i, "_inf"]
138    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"    | pureName (P.real{fromkind=P.FLOAT 64,tokind=P.INT 31}) = "real"
139    | pureName (P.real{fromkind,tokind}) =    | pureName (P.real{fromkind,tokind}) =
140      ("real" ^ numkindName fromkind ^ "_" ^ numkindName tokind)        concat ["real", numkindName fromkind, "_", numkindName tokind]
141    | pureName P.subscriptv = "subscriptv"    | pureName P.subscriptv = "subscriptv"
142    | pureName (P.pure_numsubscript{kind}) = ("numsubscriptv" ^ numkindName kind)    | pureName (P.pure_numsubscript{kind}) = ("numsubscriptv" ^ numkindName kind)
143    | pureName P.gettag = "gettag"    | pureName P.gettag = "gettag"
144    | pureName P.mkspecial = "mkspecial"    | pureName P.mkspecial = "mkspecial"
   | pureName P.wrap = "wrap"  
   | pureName P.unwrap = "unwrap"  
145    | pureName P.cast = "cast"    | pureName P.cast = "cast"
146    | pureName P.getcon = "getcon"    | pureName P.getcon = "getcon"
147    | pureName P.getexn = "getexn"    | pureName P.getexn = "getexn"
148    | pureName P.fwrap = "fwrap"    | pureName P.box = "box"
149    | pureName P.funwrap = "funwrap"    | pureName P.unbox = "unbox"
150    | pureName P.iwrap = "iwrap"    | pureName (P.wrap kind) = "wrap_" ^ numkindName kind
151    | pureName P.iunwrap = "iunwrap"    | pureName (P.unwrap kind) = "unwrap_" ^ numkindName kind
   | pureName P.i32wrap = "i32wrap"  
   | pureName P.i32unwrap = "i32unwrap"  
152    | pureName P.getseqdata = "getseqdata"    | pureName P.getseqdata = "getseqdata"
153    | pureName P.recsubscript = "recsubscript"    | pureName P.recsubscript = "recsubscript"
154    | pureName P.raw64subscript = "raw64subscript"    | pureName P.raw64subscript = "raw64subscript"
155    | pureName P.newarray0 = "newarray0"    | pureName P.newarray0 = "newarray0"
156      | pureName (P.rawrecord rk) = "rawrecord_"^getOpt(Option.map rkstring rk, "notag")
157    
158  fun show0 say =  and rkstring rk = (case rk
   let fun sayc (#"\n") = say "\\n"  
         | sayc c = say(String.str c)  
   
       fun sayv(VAR v) = say(LV.lvarName v)  
         | sayv(LABEL v) = say("(L)" ^ LV.lvarName v)  
         | sayv(INT i) = say("(I)" ^ Int.toString i)  
         | sayv(INT32 i) = say("(I32)" ^ Word32.toString i)  
         | sayv(REAL r) = say r  
         | sayv(STRING s) = (say "\""; app sayc (explode s); say "\"")  
         | sayv(OBJECT _) = say("(object)")  
         | sayv(VOID) = say("(void)")  
   
       fun sayvlist [v] = sayv v  
         | sayvlist nil = ()  
         | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)  
   
   
       fun rkstring rk = (case rk  
159          of RK_VECTOR => "RK_VECTOR"          of RK_VECTOR => "RK_VECTOR"
160           | RK_RECORD => "RK_RECORD"           | RK_RECORD => "RK_RECORD"
161           | RK_SPILL => "RK_SPILL"           | RK_SPILL => "RK_SPILL"
# Line 164  Line 166 
166           | RK_KNOWN => "RK_KNOWN"           | RK_KNOWN => "RK_KNOWN"
167           | RK_BLOCK => "RK_BLOCK"           | RK_BLOCK => "RK_BLOCK"
168           | RK_FBLOCK => "RK_FBLOCK"           | RK_FBLOCK => "RK_FBLOCK"
169           | RK_I32BLOCK => "RK_I32BLOCK")          | RK_I32BLOCK => "RK_I32BLOCK"
170          (* end case *))
171    
172    fun show0 say =
173      let fun sayc (#"\n") = say "\\n"
174            | sayc c = say(String.str c)
175    
176          fun sayv v = say(value2str v)
177    
178          fun sayvlist [v] = sayv v
179            | sayvlist nil = ()
180            | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)
181    
182        fun sayrk(RK_RECORD,n) = ()        fun sayrk(RK_RECORD,n) = ()
183          | sayrk(RK_VECTOR,n) = ()          | sayrk(RK_VECTOR,n) = ()
# Line 238  Line 251 
251                      indent (n+3) e1;                      indent (n+3) e1;
252                      space n; say "else\n";                      space n; say "else\n";
253                      indent (n+3) e2)                      indent (n+3) e2)
254                  | RCC(k,l,p,vl,wtl,e) =>
255                       (space n;
256                        if k = REENTRANT_RCC then say "reentrant " else ();
257                        if l = "" then () else (say l; say " ");
258                        say "rcc("; sayvlist vl; say ") -> ";
259                        app (fn (w, t) => (sayv (VAR w); sayt(t))) wtl;
260                        nl(); f e)
261           in f           in f
262          end          end
263   in  indent   in  indent

Legend:
Removed from v.733  
changed lines
  Added in v.4953

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