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/tuples.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 249 (* Copyright 1989 by AT&T Bell Laboratories *)
2 :     (* tuples.sml *)
3 :    
4 :     (*
5 :     * TUPLES and Tuples should be called RECORDS and Records, since
6 :     * records are the primary concept, and tuples are a derived form.
7 :     *)
8 :     signature TUPLES =
9 :     sig
10 :    
11 :     structure Types : TYPES
12 :     val numlabel : int -> Types.label
13 :     val mkTUPLEtyc : int -> Types.tycon
14 :     val isTUPLEtyc : Types.tycon -> bool
15 :     val mkRECORDtyc : Types.label list -> Types.tycon
16 :    
17 :     end (* signature TUPLES *)
18 :    
19 :     structure Tuples : TUPLES = struct
20 :    
21 :     structure Types = Types
22 :    
23 :     open Types
24 :    
25 :     datatype labelOpt = NOlabel | SOMElabel of label
26 :     datatype tyconOpt = NOtycon | SOMEtycon of tycon
27 :    
28 : monnier 411 structure LabelArray = DynamicArrayFn (
29 : monnier 249 struct
30 :     open Array
31 :     type array = labelOpt array
32 :     type vector = labelOpt vector
33 :     type elem = labelOpt
34 :     end)
35 :    
36 : monnier 411 structure TyconArray = DynamicArrayFn (
37 : monnier 249 struct
38 :     open Array
39 :     type array = tyconOpt array
40 :     type vector = tyconOpt vector
41 :     type elem = tyconOpt
42 :     end)
43 :    
44 :     exception New
45 :     val tyconTable = IntStrMap.new(32,New) : tycon IntStrMap.intstrmap
46 :     val tyconMap = IntStrMap.map tyconTable
47 :     val tyconAdd = IntStrMap.add tyconTable
48 :    
49 :     fun labelsToSymbol(labels: label list) : Symbol.symbol =
50 :     let fun wrap [] = ["}"]
51 :     | wrap [id] = [Symbol.name id, "}"]
52 :     | wrap (id::rest) = Symbol.name id :: "," :: wrap rest
53 :     in Symbol.tycSymbol(concat("{" :: wrap labels))
54 :     end
55 :    
56 :     (* this is an optimization to make similar record tycs point to the same thing,
57 :     thus speeding equality testing on them *)
58 :     fun mkRECORDtyc labels =
59 :     let val recordName = labelsToSymbol labels
60 :     val number = Symbol.number recordName
61 :     val name = Symbol.name recordName
62 :     in tyconMap(number,name)
63 :     handle New =>
64 :     let val tycon = RECORDtyc labels
65 :     in tyconAdd(number,name,tycon);
66 :     tycon
67 :     end
68 :     end
69 :    
70 : monnier 411 val numericLabels = LabelArray.array(0,NOlabel)
71 :     val tupleTycons = TyconArray.array(0,NOtycon)
72 : monnier 249
73 :     fun numlabel i =
74 :     case LabelArray.sub(numericLabels,i)
75 :     of NOlabel =>
76 :     let val newlabel = Symbol.labSymbol(Int.toString i)
77 :     in LabelArray.update(numericLabels,i,SOMElabel(newlabel));
78 :     newlabel
79 :     end
80 :     | SOMElabel(label) => label
81 :    
82 :     fun numlabels n =
83 :     let fun labels (0,acc) = acc
84 :     | labels (i,acc) = labels (i-1, numlabel i :: acc)
85 :     in labels (n,nil)
86 :     end
87 :    
88 :     fun mkTUPLEtyc n =
89 :     case TyconArray.sub(tupleTycons,n)
90 :     of NOtycon =>
91 :     let val tycon = mkRECORDtyc(numlabels n)
92 :     in TyconArray.update(tupleTycons,n,SOMEtycon(tycon));
93 :     tycon
94 :     end
95 :     | SOMEtycon(tycon) => tycon
96 :    
97 :     fun checklabels (2,nil) = false (* {1:t} is not a tuple *)
98 :     | checklabels (n,nil) = true
99 :     | checklabels (n, lab::labs) =
100 :     Symbol.eq(lab, numlabel n) andalso checklabels(n+1,labs)
101 :    
102 :     fun isTUPLEtyc(RECORDtyc labels) = checklabels(1,labels)
103 :     | isTUPLEtyc _ = false
104 :    
105 :     end (* structure Tuples *)
106 :    

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