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/src/compiler/FLINT/flint/chkflint.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/flint/chkflint.sml

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

revision 73, Sun Apr 5 20:59:43 1998 UTC revision 74, Sat Apr 11 00:22:45 1998 UTC
# Line 195  Line 195 
195          in (ts, typeIn ve' eb)          in (ts, typeIn ve' eb)
196          end          end
197    
198          (* There are lvars hidden in Access.conrep, used by dcon.
199           * These functions just make sure that they are defined in the
200           * current environemnent; we don't bother to typecheck them properly
201           * because supposedly conrep will go away...
202           *)
203          fun checkAccess (DA.LVAR v) = ignore (typeofVar v)
204            | checkAccess (DA.PATH (a,_)) = checkAccess a
205            | checkAccess _ = ()
206    
207          fun checkConrep (DA.EXN a) =
208                  checkAccess a
209            | checkConrep (DA.SUSP (SOME (a1,a2))) =
210                  (checkAccess a1;
211                   checkAccess a2)
212            | checkConrep _ =
213                  ()
214    
215        fun chkSnglInst (fp as (le,s)) (lt,ts) =        fun chkSnglInst (fp as (le,s)) (lt,ts) =
216          if null ts then lt          if null ts then lt
217          else case ltTyApp fp (lt,ts,kenv)          else case ltTyApp fp (lt,ts,kenv)
# Line 285  Line 302 
302              fun g lt = (ltMatch (le,"SWITCH branch 1") (lt,selLty); venv)              fun g lt = (ltMatch (le,"SWITCH branch 1") (lt,selLty); venv)
303              fun brLts (c,e) = let              fun brLts (c,e) = let
304                val venv' = case c                val venv' = case c
305                   of DATAcon ((_,_,lt), ts, v) => let                   of DATAcon ((_,conrep,lt), ts, v) => let
306                          val _ = checkConrep conrep
307                        val fp = (le,"SWITCH DECON")                        val fp = (le,"SWITCH DECON")
308                        val ct = chkSnglInst fp (lt,ts)                        val ct = chkSnglInst fp (lt,ts)
309                        val nts = ltFnAppR fp (ct, [selLty])                        val nts = ltFnAppR fp (ct, [selLty])
# Line 309  Line 327 
327                  | NONE => ();                  | NONE => ();
328                ts                ts
329              end              end
330          | CON ((_,_,lt), ts, u, lv, e) =>          | CON ((_,conrep,lt), ts, u, lv, e) =>
331            typeWithBindingToSingleRsltOfInstAndApp ("CON",lt,ts,[u],lv) e              (checkConrep conrep;
332                 typeWithBindingToSingleRsltOfInstAndApp ("CON",lt,ts,[u],lv) e)
333          | RECORD (rk,vs,lv,e) => let          | RECORD (rk,vs,lv,e) => let
334              val lt = case rk              val lt = case rk
335                 of RK_VECTOR t => let                 of RK_VECTOR t => let
# Line 373  Line 392 
392                         typeWith (lv, rt) e)                         typeWith (lv, rt) e)
393                   | _ => bug "unexpected WCAST in typecheck")                   | _ => bug "unexpected WCAST in typecheck")
394              else bug "unexpected WCAST in typecheck"              else bug "unexpected WCAST in typecheck"
395          | PRIMOP ((_,_,lt,ts), vs, lv, e) =>          | PRIMOP ((dc,_,lt,ts), vs, lv, e) => let
396                  (* There are lvars hidden inside dicts, which we didn't check
397                   * before.  This is a first-order check that they at least
398                   * are bound to something; for now we don't care about their
399                   * types.  (I'm not sure what the rules should look like)
400                   *   --league, 10 april 1998.
401                   *)
402                  fun checkDict (SOME {default, table}) =
403                        (typeofVar default;
404                         app (ignore o typeofVar o #2) table)
405                    | checkDict (NONE : dict option) = ()
406              in
407                  checkDict dc;
408            typeWithBindingToSingleRsltOfInstAndApp ("PRIMOP",lt,ts,vs,lv) e            typeWithBindingToSingleRsltOfInstAndApp ("PRIMOP",lt,ts,vs,lv) e
409              end
410  (*  (*
411          | GENOP (dict, (_,lt,ts), vs, lv, e) =>          | GENOP (dict, (_,lt,ts), vs, lv, e) =>
412            (* verify dict ? *)            (* verify dict ? *)

Legend:
Removed from v.73  
changed lines
  Added in v.74

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