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-3/compiler/FLINT/trans/transtypes.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-3/compiler/FLINT/trans/transtypes.sml

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

revision 3355, Sun May 17 02:45:56 2009 UTC revision 3356, Sun May 17 13:29:59 2009 UTC
# Line 5  Line 5 
5  sig  sig
6    
7    type flexmap = TycPath.tycpath FlexTycMap.map    type flexmap = TycPath.tycpath FlexTycMap.map
8      type primaryEnv = (Types.tycon list
9                         * ((Stamps.stamp * Modules.fctSig) list)) list
10    datatype primary = FormalTyc of Types.tycon    datatype primary = FormalTyc of Types.tycon
11                     | FormalFct of Stamps.stamp * Modules.fctSig                     | FormalFct of Stamps.stamp * Modules.fctSig
12    
13    val genTT  : unit    val genTT  : unit
14                 -> {tpsKnd : primary -> PLambdaType.tkind,                 -> {tpsKnd : primary -> PLambdaType.tkind,
15                     tpsTyc : flexmap -> DebIndex.depth -> TycPath.tycpath                     tpsTyc : primaryEnv -> DebIndex.depth -> primary
16                              -> PLambdaType.tyc,                              -> PLambdaType.tyc,
17                     toTyc  : flexmap ->                     toTyc  : flexmap ->
18                              DebIndex.depth -> Types.ty -> PLambdaType.tyc,                              DebIndex.depth -> Types.ty -> PLambdaType.tyc,
# Line 48  Line 50 
50  in  in
51    
52  type flexmap = TycPath.tycpath FlexTycMap.map  type flexmap = TycPath.tycpath FlexTycMap.map
53    type primaryEnv = (Types.tycon list
54                         * ((Stamps.stamp * Modules.fctSig) list)) list
55    
56  datatype primary = FormalTyc of Types.tycon  datatype primary = FormalTyc of Types.tycon
57                   | FormalFct of Stamps.stamp * fctSig                   | FormalFct of Stamps.stamp * fctSig
# Line 164  Line 168 
168    end    end
169   *)   *)
170    
171    fun tpsTyc (penv : primaryEnv) d p =
172        let fun primary2tyc (primary, cur) =
173                (case primary
174                  of (FormalTyc(GENtyc{stamp=s0, kind=FORMAL,arity,...})) =>
175                      let
176                          fun findindex ((GENtyc{stamp=s1,...}::lvl,fcts)::penv,
177                                         tdepth, num) =
178                              if Stamps.eq(s1,s0)
179                              then (tdepth, num)
180                              else findindex ((lvl,fcts)::penv, tdepth, num + 1)
181                            | findindex (([],_)::penv, tdepth, num) =
182                              findindex(penv, tdepth + 1, 0)
183                            | findindex _ = bug "Malformed primary environment"
184    
185                          val (tdepth, num) = findindex(penv, 0, 0)
186                          val finaldepth = DI.calc(cur, tdepth)
187                      in
188                          if finaldepth < 0 then bug "Invalid depth calculation"
189                          else  LT.tcc_var(finaldepth, num)
190                      end
191                   | (FormalFct _) => bug "unimplemented")
192        in primary2tyc p
193        end
194    
195  (*  (*
196  and tycTyc =  and tycTyc =
197    Stats.doPhase(Stats.makePhase "Compiler 043 1-tycTyc") tycTyc0 x    Stats.doPhase(Stats.makePhase "Compiler 043 1-tycTyc") tycTyc0 x

Legend:
Removed from v.3355  
changed lines
  Added in v.3356

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