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

revision 4419, Mon Sep 18 21:53:44 2017 UTC revision 4841, Sun Sep 23 15:33:36 2018 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 20  Line 26 
26    
27  val sayt = say o CPS.ctyToString  val sayt = say o CPS.ctyToString
28    
29    fun value2str (VAR v) = LV.lvarName v
30      | value2str (LABEL v) = "(L)" ^ LV.lvarName v
31      | value2str (NUM{ival, ty={sz=0, ...}}) = "(II)" ^ IntInf.toString ival
32      | value2str (NUM{ival, ty={tag=true, ...}}) = "(I)" ^ IntInf.toString ival
33      | value2str (NUM{ival, ty={sz, ...}}) = concat[
34            "(I", Int.toString sz, ")", IntInf.toString ival
35          ]
36      | value2str (REAL{rval, ty}) = concat[
37            "(R", Int.toString ty, ")", RealLit.toString rval
38          ]
39      | value2str (STRING s) = concat["\"", String.toString s, "\""]
40      | value2str (VOID) = "(void)"
41    
42  fun numkindName (P.INT bits) = "i" ^ Int.toString bits  fun numkindName (P.INT bits) = "i" ^ Int.toString bits
43    | numkindName (P.UINT bits) = "u" ^ Int.toString bits    | numkindName (P.UINT bits) = "u" ^ Int.toString bits
44    | numkindName (P.FLOAT bits) = "f" ^ Int.toString bits    | numkindName (P.FLOAT bits) = "f" ^ Int.toString bits
# Line 125  Line 144 
144    | pureName (P.pure_numsubscript{kind}) = ("numsubscriptv" ^ numkindName kind)    | pureName (P.pure_numsubscript{kind}) = ("numsubscriptv" ^ numkindName kind)
145    | pureName P.gettag = "gettag"    | pureName P.gettag = "gettag"
146    | pureName P.mkspecial = "mkspecial"    | pureName P.mkspecial = "mkspecial"
147    | pureName P.wrap = "wrap"    | pureName P.box = "box"
148    | pureName P.unwrap = "unwrap"    | pureName P.unbox = "unbox"
149    | pureName P.cast = "cast"    | pureName P.cast = "cast"
150    | pureName P.getcon = "getcon"    | pureName P.getcon = "getcon"
151    | pureName P.getexn = "getexn"    | pureName P.getexn = "getexn"
# Line 134  Line 153 
153    | pureName P.funwrap = "funwrap"    | pureName P.funwrap = "funwrap"
154    | pureName P.iwrap = "iwrap"    | pureName P.iwrap = "iwrap"
155    | pureName P.iunwrap = "iunwrap"    | pureName P.iunwrap = "iunwrap"
156    | pureName P.i32wrap = "i32wrap"    | pureName P.i32wrap = "i32wrap"              (* 64BIT: FIXME *)
157    | pureName P.i32unwrap = "i32unwrap"    | pureName P.i32unwrap = "i32unwrap"          (* 64BIT: FIXME *)
158    | pureName P.getseqdata = "getseqdata"    | pureName P.getseqdata = "getseqdata"
159    | pureName P.recsubscript = "recsubscript"    | pureName P.recsubscript = "recsubscript"
160    | pureName P.raw64subscript = "raw64subscript"    | pureName P.raw64subscript = "raw64subscript"
161    | pureName P.newarray0 = "newarray0"    | pureName P.newarray0 = "newarray0"
162    | pureName (P.rawrecord rk) =    | pureName (P.rawrecord rk) =
163      "rawrecord_"^getOpt(Option.map rkstring rk, "notag")      "rawrecord_"^getOpt(Option.map rkstring rk, "notag")
   | pureName (P.condmove b) = "condmove "^branchName b  
164    
165  and rkstring rk = (case rk  and rkstring rk = (case rk
166          of RK_VECTOR => "RK_VECTOR"          of RK_VECTOR => "RK_VECTOR"
# Line 157  Line 175 
175           | RK_FBLOCK => "RK_FBLOCK"           | RK_FBLOCK => "RK_FBLOCK"
176           | RK_I32BLOCK => "RK_I32BLOCK")           | RK_I32BLOCK => "RK_I32BLOCK")
177    
   
178  fun show0 say =  fun show0 say =
179    let fun sayc (#"\n") = say "\\n"    let fun sayc (#"\n") = say "\\n"
180          | sayc c = say(String.str c)          | sayc c = say(String.str c)
181    
182        fun sayv(VAR v) = say(LV.lvarName v)        fun sayv v = say(value2str 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)")  
183    
184        fun sayvlist [v] = sayv v        fun sayvlist [v] = sayv v
185          | sayvlist nil = ()          | sayvlist nil = ()
186          | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)          | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)
187    
   
188        fun sayrk(RK_RECORD,n) = ()        fun sayrk(RK_RECORD,n) = ()
189          | sayrk(RK_VECTOR,n) = ()          | sayrk(RK_VECTOR,n) = ()
190          | sayrk(k,n : int) = (say (rkstring k); say " ";          | sayrk(k,n : int) = (say (rkstring k); say " ";

Legend:
Removed from v.4419  
changed lines
  Added in v.4841

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