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/Elaborator/types/overload.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Elaborator/types/overload.sml

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

revision 1680, Sat Oct 30 16:02:13 2004 UTC revision 1681, Mon Nov 8 23:03:24 2004 UTC
# Line 1  Line 1 
1  (* COPYRIGHT 1996 AT&T Bell Laboratories. *)  (* COPYRIGHT 1996 AT&T Bell Laboratories. *)
2  (* overload.sml *)  (* overload.sml *)
3    
4  signature OVERLOAD =  signature OVERLOAD = sig
5  sig      val new : unit ->
6    val resetOverloaded : unit -> unit                { push : VarCon.var ref * ErrorMsg.complainer -> Types.ty,
7    val pushOverloaded : VarCon.var ref * ErrorMsg.complainer -> Types.ty                  resolve : StaticEnv.staticEnv -> unit }
   val resolveOverloaded : StaticEnv.staticEnv -> unit  
8  end  (* signature OVERLOAD *)  end  (* signature OVERLOAD *)
9    
10  structure Overload : OVERLOAD =  structure Overload : OVERLOAD =
# Line 19  Line 18 
18    open VarCon Types    open VarCon Types
19  in  in
20    
 (* debugging *)  
 val say = Control_Print.say  
 val debugging = ref false  
 fun debugmsg (msg: string) = if !debugging then (say msg; say "\n") else ()  
21  fun bug msg = EM.impossible("Overload: "^msg)  fun bug msg = EM.impossible("Overload: "^msg)
22    
23  type subst = (tyvar * tvKind) list  type subst = (tyvar * tvKind) list
# Line 113  Line 108 
108            handle SoftUnify => (rollBack(!subst); raise SoftUnify)            handle SoftUnify => (rollBack(!subst); raise SoftUnify)
109      end      end
110    
 exception Overld  
   
   
111  (* overloaded functions *)  (* overloaded functions *)
112    fun new () = let
113  val overloaded = ref (nil: (var ref * ErrorMsg.complainer * ty) list)  val overloaded = ref (nil: (var ref * ErrorMsg.complainer * ty) list)
114        fun push (refvar as ref(OVLDvar{options,scheme,...}), err) =
 fun resetOverloaded () = overloaded := nil  
   
 fun pushOverloaded (refvar as ref(OVLDvar{options,scheme,...}), err) =  
115       let val (scheme',ty) = copyScheme(scheme)       let val (scheme',ty) = copyScheme(scheme)
116        in overloaded := (refvar,err,ty) :: !overloaded;          in
117                overloaded := (refvar,err,ty) :: !overloaded;
118           scheme'           scheme'
119       end       end
120    | pushOverloaded _ = bug "overload.1"        | push _ = bug "overload.1"
121    
122  (* this resolveOverloaded implements defaulting behavior -- if more  (* this resolveOverloaded implements defaulting behavior -- if more
123   * than one variant matches the context type, the first one matching   * than one variant matches the context type, the first one matching
124   * (which will always be the first variant) is used as the default *)   * (which will always be the first variant) is used as the default *)
125  fun resolveOverloaded env  =      fun resolve env  =
126      let fun resolveOVLDvar(rv as ref(OVLDvar{name,options,...}),err,context) =      let fun resolveOVLDvar(rv as ref(OVLDvar{name,options,...}),err,context) =
127              let fun firstMatch({indicator, variant}::rest) =              let fun firstMatch({indicator, variant}::rest) =
128                        let val (nty,_) = TU.instantiatePoly indicator                        let val (nty,_) = TU.instantiatePoly indicator
# Line 154  Line 144 
144               in firstMatch(!options)               in firstMatch(!options)
145              end              end
146            | resolveOVLDvar _ = bug "overload.2"            | resolveOVLDvar _ = bug "overload.2"
147            in
148       in app resolveOVLDvar (!overloaded);              app resolveOVLDvar (!overloaded)
         overloaded := nil  
149      end      end
150    in
151        { push = push, resolve = resolve }
152    end (* new *)
153    
154  end (* local *)  end (* local *)
155  end (* structure Overload *)  end (* structure Overload *)
   

Legend:
Removed from v.1680  
changed lines
  Added in v.1681

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