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

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

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

revision 4499, Mon Oct 16 19:01:43 2017 UTC revision 4500, Mon Oct 16 20:00:58 2017 UTC
# Line 17  Line 17 
17     *)     *)
18      val new : unit -> {      val new : unit -> {
19              pushv : VarCon.var ref * SourceMap.region * ErrorMsg.complainer -> Types.ty,              pushv : VarCon.var ref * SourceMap.region * ErrorMsg.complainer -> Types.ty,
20              pushl : Types.ty -> unit,              pushl : IntInf.int * Types.ty * ErrorMsg.complainer -> Types.ty,
21              resolve : StaticEnv.staticEnv -> unit              resolve : StaticEnv.staticEnv -> unit
22            }            }
23    
# Line 79  Line 79 
79              !tyref              !tyref
80            end            end
81    
82      (* information about overloaded literals; once the type has been resolved, we use this
83       * information to check that the literal value is within range for its type.
84       *)
85        type num_info = IntInf.int * Ty.ty * ErrorMsg.complainer
86    
87    (* overloaded functions *)    (* overloaded functions *)
88      fun new () = let      fun new () = let
89            val overloadedvars = ref (nil: (VC.var ref * ErrorMsg.complainer * Ty.tyvar) list)            val overloadedvars = ref (nil: (VC.var ref * ErrorMsg.complainer * Ty.tyvar) list)
90            val overloadedlits = ref (nil: Ty.ty list)            val overloadedlits = ref (nil: num_info list)
91          (* push an overloaded variable onto the var list *)          (* push an overloaded variable onto the var list *)
92            fun pushvar (refvar as ref(VC.OVLDvar{name,options,scheme}), region, err) = let            fun pushvar (refvar as ref(VC.OVLDvar{name,options,scheme}), region, err) = let
93                  val indicators = map #indicator options                  val indicators = map #indicator options
# Line 97  Line 102 
102                  end                  end
103              | pushvar _ = bug "Overload.push"              | pushvar _ = bug "Overload.push"
104        (* push an overloaded literal onto the var list *)        (* push an overloaded literal onto the var list *)
105          fun pushlit ty_err = overloadedlits := ty_err :: !overloadedlits          fun pushlit info = (overloadedlits := info :: !overloadedlits; #2 info)
106        (* resolve overloadings *)        (* resolve overloadings *)
107          fun resolve env = let          fun resolve env = let
108              (* this function implements defaulting behavior -- if more              (* this function implements defaulting behavior -- if more
# Line 143  Line 148 
148                        select options                        select options
149                      end                      end
150              (* resolve overloaded literals *)              (* resolve overloaded literals *)
151                fun resolveOVLDlit ty = (case ty                fun resolveOVLDlit (value, ty, err) = (
152                      (* first, resolve the type *)
153                        case ty
154                       of Ty.VARty(tyvar as ref(Ty.OVLD{sources,options})) => (                       of Ty.VARty(tyvar as ref(Ty.OVLD{sources,options})) => (
155                            case options                            case options
156                             of ty::_ => tyvar := Ty.INSTANTIATED ty (* default *)                             of ty::_ => tyvar := Ty.INSTANTIATED ty (* default *)
# Line 152  Line 159 
159                        | Ty.VARty(ref(Ty.INSTANTIATED _)) => ()                        | Ty.VARty(ref(Ty.INSTANTIATED _)) => ()
160                            (* already resolved by type checking *)                            (* already resolved by type checking *)
161                        | _ => bug "resolveOVLDlit 2"                        | _ => bug "resolveOVLDlit 2"
162                      (* end case *))                      (* end case *);
163                      (* then check that the value is in range *)
164                        if TU.numInRange(value, ty)
165                          then ()
166                          else err EM.COMPLAIN (concat[
167                              "literal value ", IntInf.toString value, " is too large for type "
168                            ])
169                            (fn ppstrm => PPType.ppType env ppstrm ty))
170                in                in
171                  app resolveOVLDlit (rev(!overloadedlits));                  app resolveOVLDlit (rev(!overloadedlits));
172                  app resolveOVLDvar (rev(!overloadedvars))                  app resolveOVLDvar (rev(!overloadedvars))

Legend:
Removed from v.4499  
changed lines
  Added in v.4500

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