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/FLINT/plambda/flintnm.sml
ViewVC logotype

Diff of /sml/trunk/compiler/FLINT/plambda/flintnm.sml

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

revision 4539, Sat Apr 21 17:13:52 2018 UTC revision 4540, Wed Apr 25 17:06:35 2018 UTC
# Line 124  Line 124 
124       in LT.ltc_arrow(LT.ffc_rrflint, [FL.ltc_raw aty], [FL.ltc_raw rty])       in LT.ltc_arrow(LT.ffc_rrflint, [FL.ltc_raw aty], [FL.ltc_raw rty])
125      end (* function force_raw *)      end (* function force_raw *)
126    
127  fun tocon con =  fun tocon con = (case con
128      let val _ = 1         of L.INTcon x    => F.INTcon x
     in case con of  
         L.INTcon x    => F.INTcon x  
129        | L.INT32con x  => F.INT32con x        | L.INT32con x  => F.INT32con x
130        | L.INTINFcon _ => bug "INTINFcon"        | L.INTINFcon _ => bug "INTINFcon"
131        | L.WORDcon x   => F.WORDcon x        | L.WORDcon x   => F.WORDcon x
# Line 135  Line 133 
133        | L.STRINGcon x => F.STRINGcon x        | L.STRINGcon x => F.STRINGcon x
134        | L.VLENcon x   => F.VLENcon x        | L.VLENcon x   => F.VLENcon x
135        | L.DATAcon x => bug "unexpected case in tocon"        | L.DATAcon x => bug "unexpected case in tocon"
136      end        (* end case *))
137    
138  fun tofundec (venv,d,f_lv,arg_lv,arg_lty,body,isrec) =  fun tofundec (venv,d,f_lv,arg_lv,arg_lty,body,isrec) =
139      let val _ = (debugmsg "tofundec normalize argument:\n";      let val _ = (debugmsg "tofundec normalize argument:\n";
# Line 289  Line 287 
287   * - venv is the type environment for values   * - venv is the type environment for values
288   * - conts is the continuation   * - conts is the continuation
289   *)   *)
290  and tovalue (venv,d,lexp,cont) =  and tovalue (venv,d,lexp,cont) = let
291      let val _ = debugmsg ">>tovalue"        val _ = debugmsg ">>tovalue"
292          val _ = debugLexp lexp          val _ = debugLexp lexp
293          val _ = 1        val v = (case lexp
     val v = case lexp of  
294          (* for simple values, it's trivial *)          (* for simple values, it's trivial *)
295          L.VAR v => cont(F.VAR v, LT.ltLookup(venv, v, d))               of L.VAR v => cont(F.VAR v, LT.ltLookup(venv, v, d))
296        | L.INT i =>        | L.INT i =>
297           ((i+i+2; cont(F.INT i, LT.ltc_int)) handle Overflow =>           ((i+i+2; cont(F.INT i, LT.ltc_int)) handle Overflow =>
298              (let val _ = debugmsg "toValue INT Overflow"              (let val _ = debugmsg "toValue INT Overflow"
# Line 315  Line 312 
312           end           end
313        | L.INT32 n => cont(F.INT32 n, LT.ltc_int32)        | L.INT32 n => cont(F.INT32 n, LT.ltc_int32)
314        | L.WORD32 n => cont(F.WORD32 n, LT.ltc_int32)        | L.WORD32 n => cont(F.WORD32 n, LT.ltc_int32)
315    (* REAL32: *)
316        | L.REAL x => cont(F.REAL x, LT.ltc_real)        | L.REAL x => cont(F.REAL x, LT.ltc_real)
317        | L.STRING s => cont(F.STRING s, LT.ltc_string)        | L.STRING s => cont(F.STRING s, LT.ltc_string)
   
318        (* for cases where tolvar is more convenient *)        (* for cases where tolvar is more convenient *)
319        | _ =>                | _ => let
320              let val lv = mkv()                    val lv = mkv()
321              in tolvar(venv, d, lv, lexp,                    in
322                        tolvar(venv, d, lv, lexp,
323                        fn lty => (debugmsg ">>tovalue tolvar cont";                        fn lty => (debugmsg ">>tovalue tolvar cont";
324                                   debugLexp lexp;                                   debugLexp lexp;
325                                   cont(F.VAR lv, lty)))                                   cont(F.VAR lv, lty)))
326              end              end
327                (* end case *))
328      val _ = debugmsg "<<tovalue"      val _ = debugmsg "<<tovalue"
329      in v        in
330      end          v
331          end (* tovalue *)
332    
333  (*  (*
334   * tovalues: turns a PLambda lexp into a list of values and a list of types   * tovalues: turns a PLambda lexp into a list of values and a list of types

Legend:
Removed from v.4539  
changed lines
  Added in v.4540

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