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/branches/SMLNJ/src/compiler/FLINT/cps/switch.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/compiler/FLINT/cps/switch.sml

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

revision 68, Fri Apr 3 00:06:42 1998 UTC revision 69, Fri Apr 3 00:06:55 1998 UTC
# Line 1  Line 1 
1  (* COPYRIGHT (c) 1996 Bell Laboratories *)  (* COPYRIGHT (c) 1998 YALE FLINT PROJECT *)
2  (* switch.sml *)  (* switch.sml *)
3    
4  signature SWITCH =  signature SWITCH =
# Line 34  Line 34 
34       } ->       } ->
35       {exp: 'value,       {exp: 'value,
36        sign: Access.consig,        sign: Access.consig,
37        cases: (Lambda.con * 'cexp) list,        cases: (FLINT.con * 'cexp) list,
38        default: 'cexp}        default: 'cexp}
39         ->         ->
40         'cexp         'cexp
41    
42  end  end
43    
44    
45  structure Switch : SWITCH =  structure Switch : SWITCH =
46  struct  struct
47    
48  local  local
49    
50  structure L = Lambda  structure L = FLINT
51  structure A = Access  structure A = Access
52    
53  in  in
# Line 187  Line 188 
188          | (false, SOME n) => switch1(e, l, default, (0,n))          | (false, SOME n) => switch1(e, l, default, (0,n))
189    end    end
190    
191    fun isboxed (L.DATAcon(_,A.CONSTANT _, _)) = false    fun isboxed (L.DATAcon((_,A.CONSTANT _, _),_,_)) = false
192      | isboxed (L.DATAcon(_,A.LISTNIL,_)) = false      | isboxed (L.DATAcon((_,A.LISTNIL,_),_,_)) = false
193      | isboxed (L.DATAcon(_,rep,_)) = true      | isboxed (L.DATAcon((_,rep,_),_,_)) = true
194      | isboxed (L.REALcon _) = true      | isboxed (L.REALcon _) = true
195      | isboxed (L.STRINGcon s) = true      | isboxed (L.STRINGcon s) = true
196      | isboxed _ = false      | isboxed _ = false
197    
198    fun isexn (L.DATAcon(_,A.EXN _,_)) = true    fun isexn (L.DATAcon((_,A.EXN _,_),_,_)) = true
199      | isexn _ = false      | isexn _ = false
200    
201   fun exn_switch(w,l,default) =   fun exn_switch(w,l,default) =
202     E_getexn(w, fn u =>     E_getexn(w, fn u =>
203        let fun g((L.DATAcon(_,A.EXN p,_),x)::r) =        let fun g((L.DATAcon((_,A.EXN p,_),_,_),x)::r) =
204                    E_path(p, fn v => E_branch(E_pneq,u,v, g r, x))                    E_path(p, fn v => E_branch(E_pneq,u,v, g r, x))
205              | g nil = default              | g nil = default
206              | g _ = bug "switch.21"              | g _ = bug "switch.21"
207         in g l         in g l
208        end)        end)
209    
210   fun datacon_switch(w,sign,l: (Lambda.con * 'cexp) list, default) =   fun datacon_switch(w,sign,l: (L.con * 'cexp) list, default) =
211     let     let
212        fun tag (L.DATAcon(_,A.CONSTANT i,_)) = i        fun tag (L.DATAcon((_,A.CONSTANT i,_),_,_)) = i
213          | tag (L.DATAcon(_,A.TAGGED i,_)) = i          | tag (L.DATAcon((_,A.TAGGED i,_),_,_)) = i
214  (*      | tag (L.DATAcon(_,A.TAGGEDREC(i,_),_)) = i *)  (*      | tag (L.DATAcon((_,A.TAGGEDREC(i,_),_),_,_)) = i *)
215          | tag _ = 0          | tag _ = 0
216    
217        fun tag'(c,e) = (tag c, e)        fun tag'(c,e) = (tag c, e)
# Line 299  Line 300 
300               end               end
301          | L.REALcon _ => real_switch(exp,cases,default)          | L.REALcon _ => real_switch(exp,cases,default)
302          | L.STRINGcon _ => string_switch(exp,cases,default)          | L.STRINGcon _ => string_switch(exp,cases,default)
303          | L.DATAcon(_,A.EXN _,_) => exn_switch(exp,cases,default)          | L.DATAcon((_,A.EXN _,_),_,_) => exn_switch(exp,cases,default)
304          | L.DATAcon _ => datacon_switch(exp,sign,cases,default)          | L.DATAcon _ => datacon_switch(exp,sign,cases,default)
305          | L.WORDcon _ => word_switch(exp, cases, default)          | L.WORDcon _ => word_switch(exp, cases, default)
306          | L.WORD32con _ => word32_switch(exp,cases,default)          | L.WORD32con _ => word32_switch(exp,cases,default)

Legend:
Removed from v.68  
changed lines
  Added in v.69

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