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/primop-branch-3/compiler/FLINT/reps/reify.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-3/compiler/FLINT/reps/reify.sml

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

revision 24, Thu Mar 12 00:49:58 1998 UTC revision 45, Sun Mar 22 20:11:09 1998 UTC
# Line 60  Line 60 
60    
61  (* val exnLexp : DA.access -> lexp *)  (* val exnLexp : DA.access -> lexp *)
62  fun exnLexp (DA.LVAR v) = SVAL(VAR v)  fun exnLexp (DA.LVAR v) = SVAL(VAR v)
63    | exnLexp (DA.PATH(r, i)) = SELECTg(i, exnLexp r)  (*  | exnLexp (DA.PATH(r, i)) = SELECTg(i, exnLexp r) *)
64    | exnLexp _ = bug "unexpected case in exnLexp"    | exnLexp _ = bug "unexpected case in exnLexp"
65    
66  (****************************************************************************  (****************************************************************************
# Line 110  Line 110 
110    
111       | CON ((_, DA.UNTAGGED, lt), ts, v) =>       | CON ((_, DA.UNTAGGED, lt), ts, v) =>
112           let val nt = ltAppSt(lt, map (fn _ => LT.tcc_void) ts)           let val nt = ltAppSt(lt, map (fn _ => LT.tcc_void) ts)
113               val (tc, _) = LU.tcd_arw(LT.ltd_tyc nt)               val (ntc, _) = LT.tcd_parrow(LT.ltd_tyc nt)
114    (*
115               val ntc = case LU.tcWrap tc of NONE => tc               val ntc = case LU.tcWrap tc of NONE => tc
116                                            | SOME z => z                                            | SOME z => z
117    *)
118               val hdr = LP.utgc(kenv, ntc)               val hdr = LP.utgc(kenv, ntc)
119            in hdr (SVAL (lpsv v))            in hdr (SVAL (lpsv v))
120           end           end
121       | DECON ((_, DA.UNTAGGED, lt), ts, v) =>       | DECON ((_, DA.UNTAGGED, lt), ts, v) =>
122           let val nt = ltAppSt(lt, map (fn _ => LT.tcc_void) ts)           let val nt = ltAppSt(lt, map (fn _ => LT.tcc_void) ts)
123               val (tc, _) = LU.tcd_arw(LT.ltd_tyc nt)               val (ntc, _) = LT.tcd_parrow(LT.ltd_tyc nt)
124    (*
125               val ntc = case LU.tcWrap tc of NONE => tc               val ntc = case LU.tcWrap tc of NONE => tc
126                                            | SOME z => z                                            | SOME z => z
127    *)
128               val hdr = LP.utgd(kenv, ntc)               val hdr = LP.utgd(kenv, ntc)
129            in hdr (SVAL (lpsv v))            in hdr (SVAL (lpsv v))
130           end           end
131    
132       | CON ((_, DA.TAGGED i, lt), ts, v) =>       | CON ((_, DA.TAGGED i, lt), ts, v) =>
133           let val nt = ltAppSt(lt, map (fn _ => LT.tcc_void) ts)           let val nt = ltAppSt(lt, map (fn _ => LT.tcc_void) ts)
134               val (tc, _) = LU.tcd_arw(LT.ltd_tyc nt)               val (ntc, _) = LT.tcd_parrow(LT.ltd_tyc nt)
135    (*
136               val ntc = case LU.tcWrap tc of NONE => tc               val ntc = case LU.tcWrap tc of NONE => tc
137                                            | SOME z => z                                            | SOME z => z
138    *)
139               val hdr = LP.tgdc(kenv, i, ntc)               val hdr = LP.tgdc(kenv, i, ntc)
140            in hdr (SVAL (lpsv v))            in hdr (SVAL (lpsv v))
141           end           end
142       | DECON ((_, DA.TAGGED i, lt), ts, v) =>       | DECON ((_, DA.TAGGED i, lt), ts, v) =>
143           let val nt = ltAppSt(lt, map (fn _ => LT.tcc_void) ts)           let val nt = ltAppSt(lt, map (fn _ => LT.tcc_void) ts)
144               val (tc, _) = LU.tcd_arw(LT.ltd_tyc nt)               val (ntc, _) = LT.tcd_parrow(LT.ltd_tyc nt)
145    (*
146               val ntc = case LU.tcWrap tc of NONE => tc               val ntc = case LU.tcWrap tc of NONE => tc
147                                            | SOME z => z                                            | SOME z => z
148    *)
149               val hdr = LP.tgdd(kenv, i, ntc)               val hdr = LP.tgdd(kenv, i, ntc)
150            in hdr (SVAL (lpsv v))            in hdr (SVAL (lpsv v))
151           end           end
# Line 148  Line 156 
156           bug "DECON on a constant data constructor"           bug "DECON on a constant data constructor"
157    
158       | CON ((_, DA.EXN p, nt), [], v) =>       | CON ((_, DA.EXN p, nt), [], v) =>
159           let val (ax, _) = LU.tcd_arw(LT.ltd_tyc nt)           let val (nax, _) = LT.tcd_parrow(LT.ltd_tyc nt)
160               (***WARNING: the type of ax is adjusted to reflect boxing *)               (***WARNING: the type of ax is adjusted to reflect boxing *)
161    (*
162               val nax = case LU.tcWrap ax of NONE => ax               val nax = case LU.tcWrap ax of NONE => ax
163                                            | SOME z => z                                            | SOME z => z
164    *)
165               (***WARNING: the type for the 3rd field should (string list) *)               (***WARNING: the type for the 3rd field should (string list) *)
166               val nx = LT.tcc_tuple [LT.tcc_etag nax, nax, LT.tcc_int]               val nx = LT.tcc_tuple [LT.tcc_etag nax, nax, LT.tcc_int]
167    
168            in WRAPg(nx, true, RECORDg [exnLexp p, SVAL(lpsv v), SVAL(INT 0)])            in WRAPg(nx, true, RECORDg [exnLexp p, SVAL(lpsv v), SVAL(INT 0)])
169           end           end
170       | DECON ((_, DA.EXN _, nt), [], v) =>       | DECON ((_, DA.EXN _, nt), [], v) =>
171           let val (ax, _) = LU.tcd_arw(LT.ltd_tyc nt)           let val (nax, _) = LT.tcd_parrow(LT.ltd_tyc nt)
172               (***WARNING: the type of ax is adjusted to reflect boxing *)               (***WARNING: the type of ax is adjusted to reflect boxing *)
173    (*
174               val nax = case LU.tcWrap ax of NONE => ax               val nax = case LU.tcWrap ax of NONE => ax
175                                            | SOME z => z                                            | SOME z => z
176    *)
177               (***WARNING: the type for the 3rd field should (string list) *)               (***WARNING: the type for the 3rd field should (string list) *)
178               val nx = LT.tcc_tuple [LT.tcc_etag nax, nax, LT.tcc_int]               val nx = LT.tcc_tuple [LT.tcc_etag nax, nax, LT.tcc_int]
179            in SELECTg(1, UNWRAP(nx, true, lpsv v))            in SELECTg(1, UNWRAP(nx, true, lpsv v))

Legend:
Removed from v.24  
changed lines
  Added in v.45

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