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 2053, Mon Aug 28 05:12:11 2006 UTC revision 2054, Mon Aug 28 22:57:54 2006 UTC
# Line 45  Line 45 
45  (****************************************************************************  (****************************************************************************
46   *                         BASIC UTILITY FUNCTIONS                          *   *                         BASIC UTILITY FUNCTIONS                          *
47   ****************************************************************************)   ****************************************************************************)
48  fun debugmsg msg = if !debugging then (say "[ChkPlexp]: "; say msg; say "\n")  fun debugmsg msg =
49        if false (* !debugging *)
50        then (say "[ChkPlexp]: "; say msg; say "\n")
51                     else ()                     else ()
52    
53  fun app2(f, [], []) = ()  fun app2(f, [], []) = ()
# Line 163  Line 165 
165  fun ltMatch le s (t1, t2) =  fun ltMatch le s (t1, t2) =
166    (if ltEquiv(t1,t2) then ()    (if ltEquiv(t1,t2) then ()
167     else (clickerror();     else (clickerror();
168           say (s ^ "  **** Lty conflicting in lexp =====> \n    ");           with_pp(fn s =>
169           ltPrint t1; say "\n and   \n    "; ltPrint t2;             (PU.pps s "ERROR(checkLty): ltEquiv fails in ltMatch"; PP.newline s;
170           say "\n \n";  with_pp(fn s => PPLexp.ppLexp 20 s le);              PU.pps s "le:"; PP.newline s; PPLexp.ppLexp 6 s le;
171           say "***************************************************** \n"))              PU.pps s "t1:"; PP.newline s; PPLty.ppLty 10 s t1; PP.newline s;
172    handle zz =>              PU.pps s "t2:"; PP.newline s; PPLty.ppLty 10 s t2; PP.newline s;
173                PU.pps s"***************************************************";
174                PP.newline s))))
175      handle teUnbound2 =>
176    (clickerror();    (clickerror();
177     say (s ^ "  **** Lty conflicting in lexp =====> \n    ");     with_pp(fn s =>
178     say "uncaught exception found ";       (PU.pps s "ERROR(checkLty): exception teUnbound2 in ltMatch"; PP.newline s;
179     say "\n \n";  with_pp(fn s => PPLexp.ppLexp 20 s le); say "\n";        PU.pps s "le:"; PP.newline s; PPLexp.ppLexp 6 s le;
180     ltPrint t1; say "\n and   \n    "; ltPrint t2; say "\n";        PU.pps s "t1:"; PP.newline s; PPLty.ppLty 10 s t1; PP.newline s;
181     say "***************************************************** \n")        PU.pps s "t2:"; PP.newline s; PPLty.ppLty 10 s t2; PP.newline s;
182          PU.pps s"***************************************************";
183          PP.newline s)))
184    
185  fun ltFnApp le s (t1, t2) =  fun ltFnApp le s (t1, t2) =
186    let val (a1, b1) =    let val (a1, b1) =
# Line 463  Line 470 
470    
471  in  in
472  anyerror := false;  anyerror := false;
473  check (LT.initTkEnv, venv, DI.top) lexp; !anyerror    check (LT.initTkEnv, venv, DI.top) lexp;
474      !anyerror
475  end (* end of function checkLty *)  end (* end of function checkLty *)
476    
477  fun checkLtyTop(lexp, phase) = checkLty(lexp, LT.initLtyEnv, phase)  fun checkLtyTop(lexp, phase) = checkLty(lexp, LT.initLtyEnv, phase)

Legend:
Removed from v.2053  
changed lines
  Added in v.2054

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