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

Diff of /sml/branches/primop-branch-2/src/compiler/FLINT/plambda/flintnm.sml

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

revision 1986, Mon Jul 24 22:38:55 2006 UTC revision 1987, Mon Jul 24 23:07:36 2006 UTC
# Line 22  Line 22 
22        structure BT = BasicTypes        structure BT = BasicTypes
23  in  in
24    
25    (* debugging *)
26  val say = Control_Print.say  val say = Control_Print.say
27    
28    val debugging = ref false;
29    fun debugmsg (msg : string) =
30        if !debugging then (say msg; say "\n") else ()
31    
32    
33  val mkv = LambdaVar.mkLvar  val mkv = LambdaVar.mkLvar
34  val cplv = LambdaVar.dupLvar  val cplv = LambdaVar.dupLvar
35  val ident = fn le : L.lexp => le  val ident = fn le : L.lexp => le
# Line 116  Line 123 
123          val (body',body_lty) =          val (body',body_lty) =
124          (* first, we translate the body (in the extended env) *)          (* first, we translate the body (in the extended env) *)
125          tolexp (LT.ltInsert(venv, arg_lv, arg_lty, d), d) body          tolexp (LT.ltInsert(venv, arg_lv, arg_lty, d), d) body
126          val _ = print "tofundec detuple arg type\n"          val _ =  debugmsg ">>tofundec detuple arg type"
127          (* detuple the arg type *)          (* detuple the arg type *)
128          val ((arg_raw, arg_ltys, _), unflatten) = FL.v_punflatten arg_lty          val ((arg_raw, arg_ltys, _), unflatten) = FL.v_punflatten arg_lty
129          val _ = print "unflatten body\n"          val _ = debugmsg ">>unflatten body"
130          (* now, we add tupling code at the beginning of the body *)          (* now, we add tupling code at the beginning of the body *)
131          val (arg_lvs, body'') = unflatten(arg_lv, body')          val (arg_lvs, body'') = unflatten(arg_lv, body')
132          val _ = print "construct return type\n"          val _ = debugmsg ">>construct return type"
133          (* construct the return type if necessary *)          (* construct the return type if necessary *)
134          val (body_raw, body_ltys, _) = FL.t_pflatten body_lty          val (body_raw, body_ltys, _) = FL.t_pflatten body_lty
135          val rettype = if not isrec then NONE          val rettype = if not isrec then NONE
136                        else SOME(map FL.ltc_raw body_ltys, F.LK_UNKNOWN)                        else SOME(map FL.ltc_raw body_ltys, F.LK_UNKNOWN)
137          val _ = print "Handle fcn or fct\n"          val _ = debugmsg ">>Handle fcn or fct"
138          val (f_lty, fkind) =          val (f_lty, fkind) =
139              if (LT.ltp_tyc arg_lty andalso LT.ltp_tyc body_lty) then              if (LT.ltp_tyc arg_lty andalso LT.ltp_tyc body_lty) then
140                  (* a function *)                  (* a function *)

Legend:
Removed from v.1986  
changed lines
  Added in v.1987

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