Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/Semant/types/overloadlit.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/Semant/types/overloadlit.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 418 - (view) (download)
Original Path: sml/branches/FLINT/src/compiler/Semant/types/overloadlit.sml

1 : monnier 249 (* COPYRIGHT 1997 Bell Laboratories *)
2 :     (* overloadlit.sml *)
3 :    
4 :     (* overloaded literals *)
5 :     signature OVERLOADLIT =
6 :     sig
7 :    
8 :     (* functions for setting up, recording, and resolving literal overloadings *)
9 :     val reset : unit -> unit
10 :     val push : Types.ty -> unit
11 :     val resolve : unit -> unit
12 :    
13 :     (* isLiteralTy is for checking compatability when instantiating
14 :     overloaded literal type variables *)
15 :     val isLiteralTy : Types.litKind * Types.ty -> bool
16 :    
17 :     val debugging : bool ref
18 :    
19 :     end (* signature OVERLOADLIT *)
20 :    
21 :     structure OverloadLit : OVERLOADLIT =
22 :     struct
23 :    
24 :     structure T = Types
25 :     structure BT = BasicTypes
26 :     structure TU = TypesUtil
27 :    
28 :     (* debugging *)
29 :     val say = Control.Print.say
30 :     val debugging = ref false
31 :     fun debugmsg (msg: string) = if !debugging then (say msg; say "\n") else ()
32 :     fun bug msg = ErrorMsg.impossible("OverloadLit: "^msg)
33 :    
34 :     (* list ref storing literal types for a given typecheck call *)
35 :     val lits = ref(nil: T.ty list)
36 :    
37 :     fun reset () =
38 :     lits := []
39 :    
40 :     fun push x = lits := x :: !lits
41 :    
42 :     (* eventually, these may be defined elsewhere, perhaps via some
43 :     compiler configuration mechanism *)
44 :     val intTypes = [BT.intTy, BT.int32Ty]
45 :     val wordTypes = [BT.wordTy, BT.word8Ty, BT.word32Ty]
46 :     val realTypes = [BT.realTy]
47 :     val charTypes = [BT.charTy]
48 :     val stringTypes = [BT.stringTy]
49 :    
50 :     fun inClass(ty, tys) = List.exists (fn ty' => TU.equalType(ty,ty')) tys
51 :    
52 :     fun isLiteralTy(T.INT,ty) = inClass(ty,intTypes)
53 :     | isLiteralTy(T.WORD,ty) = inClass(ty,wordTypes)
54 :     | isLiteralTy(T.REAL,ty) = inClass(ty,realTypes)
55 :     | isLiteralTy(T.CHAR,ty) = inClass(ty,charTypes)
56 :     | isLiteralTy(T.STRING,ty) = inClass(ty,stringTypes)
57 :    
58 :     fun default T.INT = BT.intTy
59 :     | default T.WORD = BT.wordTy
60 :     | default T.REAL = BT.realTy
61 :     | default T.CHAR = BT.charTy
62 :     | default T.STRING = BT.stringTy
63 :    
64 :     fun resolve () =
65 :     let fun resolveLit ty =
66 :     case TU.prune ty
67 :     of T.VARty(tv as ref(T.LITERAL{kind,...})) =>
68 :     tv := T.INSTANTIATED(default kind)
69 :     | _ => () (* ok, must have been successfully instantiated *)
70 :     in app resolveLit (!lits)
71 :     end
72 :    
73 :     end (* structure OverloadLit *)
74 :    

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