1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
implementation module hashtable
import predef, syntax, StdCompare, compare_constructor
:: HashTableEntry = HTE_Ident !String !SymbolPtr !IdentClass !HashTableEntry !HashTableEntry
| HTE_Empty
:: HashTable =
{ hte_symbol_heap :: !.SymbolTable
, hte_entries :: !.{! .HashTableEntry}
}
:: IdentClass = IC_Expression
| IC_Type
| IC_TypeAttr
| IC_Class
| IC_Module
| IC_Field !Ident
| IC_Selector
| IC_Instance ![Type]
| IC_Unknown
newHashTable :: *HashTable
newHashTable = { hte_symbol_heap = newHeap, hte_entries = { HTE_Empty \\ i <- [0 .. dec cHashTableSize] }}
instance =< IdentClass
where
(=<) (IC_Instance types1) (IC_Instance types2)
= compare_types types1 types2
where
compare_types [t1 : t1s] [t2 : t2s]
# cmp = t1 =< t2
| cmp == Equal
= t1s =< t2s
= cmp
compare_types [] []
= Equal
compare_types [] _
= Smaller
compare_types _ []
= Greater
(=<) (IC_Field typ_id1) (IC_Field typ_id2)
= typ_id1 =< typ_id2
(=<) ic1 ic2
| equal_constructor ic1 ic2
= Equal
| less_constructor ic1 ic2
= Smaller
= Greater
instance =< (!a,!b) | =< a & =< b
where
(=<) (x1,y1) (x2,y2)
# cmp = x1 =< x2
| cmp == Equal
= y1 =< y2
= cmp
cHashTableSize :== 1023
hashValue :: !String -> Int
hashValue name
# hash_val = hash_value name (size name) 0 mod cHashTableSize
| hash_val < 0
= hash_val + cHashTableSize
= hash_val
where
hash_value :: !String !Int !Int -> Int
hash_value name index val
| index == 0
= val
# index = dec index
char = name.[index]
= hash_value name index (val << 2 + toInt char)
putIdentInHashTable :: !String !IdentClass !*HashTable -> (!Ident, !*HashTable)
putIdentInHashTable name indent_class {hte_symbol_heap,hte_entries}
# hash_val = hashValue name
(entries,hte_entries) = replace hte_entries hash_val HTE_Empty
(ident, hte_symbol_heap, entries) = insert name indent_class hte_symbol_heap entries
(_,hte_entries) = replace hte_entries hash_val entries
= (ident, { hte_symbol_heap = hte_symbol_heap, hte_entries = hte_entries })
where
insert :: !String !IdentClass !*SymbolTable *HashTableEntry -> (!Ident, !*SymbolTable, !*HashTableEntry)
insert name indent_class hte_symbol_heap HTE_Empty
# (hte_symbol_ptr, hte_symbol_heap) = newPtr EmptySymbolTableEntry hte_symbol_heap
= ({ id_name = name, id_info = hte_symbol_ptr}, hte_symbol_heap, HTE_Ident name hte_symbol_ptr indent_class HTE_Empty HTE_Empty)
insert name indent_class hte_symbol_heap (HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right)
# cmp = (name,indent_class) =< (hte_name,hte_class)
| cmp == Equal
= ({ id_name = hte_name, id_info = hte_symbol_ptr}, hte_symbol_heap, HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right)
| cmp == Smaller
#! (ident, hte_symbol_heap, hte_left) = insert name indent_class hte_symbol_heap hte_left
= (ident, hte_symbol_heap, HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right)
#! (ident, hte_symbol_heap, hte_right) = insert name indent_class hte_symbol_heap hte_right
= (ident, hte_symbol_heap, HTE_Ident hte_name hte_symbol_ptr hte_class hte_left hte_right)
|
