/pliant/language/type/set/old_dictionary.pli
1	scope "/pliant/language/" "/pliant/install/"
2	module "/pliant/install/ring2.pli"
3
4
5	method d key_map key t default -> a
6	arg_rw Dictionary d ; arg Str key ; arg Type t ; arg Universal default ; arg Address a
7	var Pointer:Arrow c :> d first key
8	while true
9	if c=null
10	a := entry_new t
11	d insert key true a
12	if addressof:default<>null
13	t copy_instance addressof:default a
14	return
15	if entry_type:c=t
16	return c
17	c :> d next key c
18
19	meta '. kmap' e
20	if e:size<3 or e:size>4 or not (e:0 cast Dictionary) or not (e:1 cast Str) or (e:2 constant Type)=null
21	return
22	var Pointer:Type t :> (e:2 constant Type) map Type
23	e suckup e:0
24	e suckup e:1
25	var Link:Argument default
26	if e:size=3
27	default :> new Argument
28	default locate t argument_constant
29	var Link:Expression u :> expression immediat undefined near e
30	if (u constant t)<>null
31	default constant := u constant t
32	else
33	default constant := entry_new t
34	else
35	if not (e:3 cast t)
36	return
37	e suckup e:3
38	default :> e:3 result
39	var Link:Argument a :> argument indirect t (argument local Address) 0
40	e add (instruction (the_function '. key_map' Dictionary Str Type Universal -> Address) e:0:result e:1:result (argument mapped_constant Type t) default a:pointer)
41	e set_result a access_read+(e:0:access .and. access_write)+access_object
42
43
44	method d exists key t -> defined
45	arg Dictionary d ; arg Str key ; arg Type t ; arg CBool defined
46	var Pointer:Arrow c :> d first key
47	while true
48	if c=null
49	return false
50	if entry_type:c=t
51	return true
52	c :> d next key c
53
54	export '. kmap' '. exists'
55
56
57	type Any
58	void
59
60	method d scan_forward t index n item -> some
61	arg Dictionary d ; arg Type t ; arg_rw Int index ; arg Address n ; arg_rw Pointer:Arrow item ; arg CBool some
62	var Address node := n
63	while true
64	if node=null
65	index += 1
66	if index>=d:hashsize
67	return false
68	else
69	node := ((addressof:d map Address) translate Address index) map Address
70	else
71	item :> ((node translate Address 1) translate Str 1) map Arrow
72	if t<>Any and entry_type:item<>t
73	node := node map Address
74	else
75	return true
76	some := false
77
78	method d scan_first t index item -> some
79	arg Dictionary d ; arg Type t ; arg_rw Int index ; arg_rw Pointer:Arrow item ; arg CBool some
80	if d:hashsize=0
81	return false
82	index := 0
83	var Address node := (addressof:d map Address) map Address
84	some := d scan_forward t index node item
85
86	method d scan_next t index item -> some
87	arg Dictionary d ; arg Type t ; arg_rw Int index ; arg_rw Pointer:Arrow item ; arg CBool some
88	var Address node := (addressof:item translate Str -1) translate Arrow -1
89	node := node map Address
90	some := d scan_forward t index node item
91
92	function dictionary_item_label item -> label
93	arg Pointer:Arrow item ; arg_R Str label
94	label :> (addressof:item translate Str -1) map Str
95
96	meta each e
97	if e:size<3 or not e:0:is_pure_ident or not (e:1 cast Dictionary)
98	return
99	var Pointer:Arrow c :> pliant_general_dictionary first "pliant function"
100	if c=null or entry_type:c<>Function
101	return
102	var Link:Function current_function :> c map Function
103	var Link:Expression key :> null map Expression
104	var Link:Type t :> Any
105	var Int i := 2
106	while i<e:size-1
107	if i+1<e:size and e:i:ident="type" and (e:(i+1) constant Type)<>null
108	t :> (e:(i+1) constant Type) map Type
109	i += 2
110	eif i+1<e:size and e:i:ident="getkey" and e:(i+1):is_pure_ident
111	key :> e i+1
112	i += 2
113	else
114	return
115	var Link:Argument index :> argument local Int
116	var Link:Argument arrow :> argument local Pointer:Arrow
117	if t=Any
118	arrow :> argument local Pointer:Arrow
119	else
120	arrow :> argument local (pointerto linkto:t)
121	var Link:Argument some :> argument local CBool
122	var Link:LocalVariable lv :> new LocalVariable
123	lv name := e:0 ident
124	lv body :> arrow
125	lv access := access_read+access_write
126	lv function :> current_function
127	e define lv:name addressof:lv e:module
128	e suckup e:1
129	var Link:Instruction end :> instruction the_function:'do nothing'
130	e add (instruction (the_function '. scan_first' Dictionary Type Int Pointer:Arrow -> CBool) e:1:result (argument mapped_constant Type t) index arrow some)
131	e add (instruction (the_function 'jump if not' CBool) some jump end)
132	var Link:Instruction body :> instruction the_function:'do nothing'
133	e add body
134	if addressof:key<>null
135	var Link:Argument label :> argument indirect Str (argument local Address) 0
136	var Link:LocalVariable lv :> new LocalVariable
137	lv name := key ident
138	lv body :> label
139	lv access := access_read
140	lv function :> current_function
141	e define lv:name addressof:lv e:module
142	e add (instruction (the_function dictionary_item_label Pointer:Arrow -> Str) arrow label)
143	(e e:size-1) compile ?
144	e suckup (e e:size-1)
145	e add (instruction (the_function '. scan_next' Dictionary Type Int Pointer:Arrow -> CBool) e:1:result (argument mapped_constant Type t) index arrow some)
146	e add (instruction (the_function 'jump if' CBool) some jump body)
147	e add end
148	e set_void_result
149
150	export each