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/chkplexp.sml
ViewVC logotype

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

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

revision 2034, Fri Aug 18 23:43:02 2006 UTC revision 2035, Fri Aug 18 23:54:34 2006 UTC
# Line 109  Line 109 
109  val lt_inst_chk = LT.lt_inst_chk_gen()  val lt_inst_chk = LT.lt_inst_chk_gen()
110  (* kind checker for ltys *)  (* kind checker for ltys *)
111  val ltyChk = LT.ltyChkGen ()  val ltyChk = LT.ltyChkGen ()
112    (* kind checker for tycs *)
113    val tycChk = LT.tkTycGen ()
114    
115  fun ltAppChk (lt, ts, kenv) : LT.lty =  fun ltAppChk (lt, ts, kenv) : LT.lty =
116    (case lt_inst_chk(lt, ts, kenv)    (case lt_inst_chk(lt, ts, kenv)
# Line 122  Line 124 
124         (clickerror ();         (clickerror ();
125          say (s ^ "  **** Kind conflicting in lexp =====> \n    ");          say (s ^ "  **** Kind conflicting in lexp =====> \n    ");
126          case zz of LT.LtyAppChk => say "      exception LtyAppChk raised! \n"          case zz of LT.LtyAppChk => say "      exception LtyAppChk raised! \n"
127                   | LT.TkTycChk =>  say "      exception TkTycChk raised! \n"                   | LT.TkTycChk _ =>  say "      exception TkTycChk raised! \n"
128                   | _ => say "   other weird exception raised! \n";                   | _ => say "   other weird exception raised! \n";
129          say "\n \n"; lePrint le; say "\n For Types: \n";          say "\n \n"; lePrint le; say "\n For Types: \n";
130          ltPrint lt; say "\n and   \n    ";          ltPrint lt; say "\n and   \n    ";
# Line 151  Line 153 
153              (clickerror ();              (clickerror ();
154               say (s ^ "  **** Applying Non-Arrow Type in lexp =====> \n    ");               say (s ^ "  **** Applying Non-Arrow Type in lexp =====> \n    ");
155               case zz of LtyArrow => say "exception LtyArrow raised. \n"               case zz of LtyArrow => say "exception LtyArrow raised. \n"
156                        | LT.tcUnbound => say "exception tcUnbound raised. \n"                        | LT.TeUnbound => say "exception TeUnbound raised. \n"
157                        | _ => say "other weird exceptions raised\n";                        | _ => say "other weird exceptions raised\n";
158               say "\n \n";  lePrint le; say "\n For Types \n";               say "\n \n";  lePrint le; say "\n For Types \n";
159               ltPrint t1; say "\n and   \n    "; ltPrint t2; say "\n \n";               ltPrint t1; say "\n and   \n    "; ltPrint t2; say "\n \n";
# Line 167  Line 169 
169              (clickerror ();              (clickerror ();
170               say (s ^ "  **** Rev-Apply Non-Arrow Type in lexp =====> \n    ");               say (s ^ "  **** Rev-Apply Non-Arrow Type in lexp =====> \n    ");
171               case zz of LtyArrow => say "exception LtyArrow raised. \n"               case zz of LtyArrow => say "exception LtyArrow raised. \n"
172                        | LT.tcUnbound => say "exception tcUnbound raised. \n"                        | LT.TeUnbound => say "exception TeUnbound raised. \n"
173                        | _ => say "other weird exceptions raised\n";                        | _ => say "other weird exceptions raised\n";
174               say "\n \n";  lePrint le; say "\n For Types \n";               say "\n \n";  lePrint le; say "\n For Types \n";
175               ltPrint t1; say "\n and   \n    "; ltPrint t2; say "\n \n";               ltPrint t1; say "\n and   \n    "; ltPrint t2; say "\n \n";
# Line 183  Line 185 
185         (clickerror ();         (clickerror ();
186          say (s ^ "  **** Select from a wrong-type lexp  =====> \n    ");          say (s ^ "  **** Select from a wrong-type lexp  =====> \n    ");
187          case zz of LtySelect => say "exception LtyArrow raised. \n"          case zz of LtySelect => say "exception LtyArrow raised. \n"
188                   | LT.tcUnbound => say "exception tcUnbound raised. \n"                   | LT.TeUnbound => say "exception TeUnbound raised. \n"
189                   | _ => say "other weird exceptions raised\n";                   | _ => say "other weird exceptions raised\n";
190          say "\n \n";  lePrint le; say "\n \n";          say "\n \n";  lePrint le; say "\n \n";
191          say "Selecting "; say (Int.toString i);          say "Selecting "; say (Int.toString i);
# Line 226  Line 228 
228            | STRING _ => ltString            | STRING _ => ltString
229            | PRIM(p, t, ts) =>            | PRIM(p, t, ts) =>
230               (* kind check t and ts *)               (* kind check t and ts *)
231                (ltyChkenv t; map ltyChkenv ts;                (ltyChkenv t; map (tycChk kenv) ts;
232                 ltTyApp le "PRIM" (t, ts, kenv))                 ltTyApp le "PRIM" (t, ts, kenv))
233    
234            | FN(v, t, e1) =>            | FN(v, t, e1) =>

Legend:
Removed from v.2034  
changed lines
  Added in v.2035

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