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/kernel/ltykernel.sml
[smlnj] / sml / trunk / src / compiler / FLINT / kernel / ltykernel.sml  
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/kernel/ltykernel.sml

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

revision 64, Tue Mar 31 05:26:51 1998 UTC revision 65, Wed Apr 1 20:57:44 1998 UTC
# Line 385  Line 385 
385  fun lt_vs (r as ref(_ : int, _ : ltyI, AX_NO)) = NONE  fun lt_vs (r as ref(_ : int, _ : ltyI, AX_NO)) = NONE
386    | lt_vs (r as ref(_ : int, _ : ltyI, AX_REG (_,x))) = SOME x    | lt_vs (r as ref(_ : int, _ : ltyI, AX_REG (_,x))) = SOME x
387    
 (* unfortunately, the `temporary hack' is being exported now! *)  
 val tc_freevars = tc_vs  
   
388  (** converting from the hash-consing reps to the standard reps *)  (** converting from the hash-consing reps to the standard reps *)
389  fun tk_outX (r as ref(_ : int, t : tkindI, _ : aux_info)) = t  fun tk_outX (r as ref(_ : int, t : tkindI, _ : aux_info)) = t
390  fun tc_outX (r as ref(_ : int, t : tycI, _ : aux_info)) = t  fun tc_outX (r as ref(_ : int, t : tycI, _ : aux_info)) = t
# Line 409  Line 406 
406  fun lt_key (ref (h : int, _ : ltyI, _ : aux_info)) = h  fun lt_key (ref (h : int, _ : ltyI, _ : aux_info)) = h
407    
408  (***************************************************************************  (***************************************************************************
409     *            UTILITY FUNCTIONS ON TKIND ENVIRONMENT                       *
410     ***************************************************************************)
411    
412    (** tkind environment: maps each tyvar, i.e., its debindex, to its kind *)
413    type tkindEnv = tkind list list
414    
415    (** utility functions for manipulating the tkindEnv *)
416    exception tkUnbound
417    val initTkEnv : tkindEnv = []
418    
419    fun tkLookup (kenv, i, j) =
420      let val ks = List.nth(kenv, i-1) handle _ => raise tkUnbound
421       in List.nth(ks, j) handle _ => raise tkUnbound
422      end
423    
424    fun tkInsert (kenv, ks) = ks::kenv
425    
426    (* strip any unused type variables out of a kenv, given a list of
427     * [encoded] free type variables.  the result is a "parallel list" of
428     * the kinds of those free type variables in the environment.
429     * This is meant to use the same representation of a kind environment
430     * as in ltybasic.
431     * --CALeague
432     *)
433    fun tkLookupFreeVars (kenv, tyc) =
434        let
435            fun g (kenv, d, []) = []
436              | g (kenv, d, ftv::ftvs) =
437                let val (d', i') = tvDecode ftv
438                    val kenv' = List.drop (kenv, d'-d)
439                        handle _ => raise tkUnbound
440                    val k = List.nth (hd kenv', i')
441                        handle _ => raise tkUnbound
442                    val rest = g (kenv', d', ftvs)
443                in
444                    k :: rest
445                end
446    
447            fun h ftvs = g (kenv, 1, ftvs)
448        in
449            Option.map h (tc_vs tyc)
450        end
451    
452    (***************************************************************************
453   *            UTILITY FUNCTIONS ON TYC ENVIRONMENT                         *   *            UTILITY FUNCTIONS ON TYC ENVIRONMENT                         *
454   ***************************************************************************)   ***************************************************************************)
455    
Legend:
Removed from v.64  
changed lines
  Added in v.65
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge