/pliant/language/compiler/runtime_compile.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	scope "/pliant/language/" "/pliant/install/"
17	module "/pliant/install/ring2.pli"
18
19
20	function switch_constant e id adr
21	arg_rw Expression e ; arg Ident id ; arg Address adr
22	if addressof:(entry_type e:value)=addressof:Ident and (e:value map Ident)=id
23	e:value := adr
24	for (var Int i) 0 e:size-1
25	switch_constant e:i id adr
26
27	function copy_constant e id val type
28	arg_rw Expression e ; arg Ident id ; arg Universal val ; arg Type type
29	var Arrow adr := entry_new type
30	type copy_instance addressof:val adr
31	switch_constant e id adr
32
33	function map_constant e id obj
34	arg_rw Expression e ; arg Ident id ; arg Universal obj
35	switch_constant e id addressof:obj
36
37	method e switch_module m
38	arg_rw Expression e ; arg Module m
39	e module :> m
40	for (var Int i) 0 e:size-1
41	e:i switch_module m
42
43	function compile e modulename
44	arg_rw Expression e ; arg Str modulename
45	var Pointer:Module m :> (pliant_module_dictionary first modulename) map Module
46	if addressof:m<>null
47	e switch_module m
48	e execute
49	else
50	error error_id_corrupted "module "+modulename+" is not available any more"
51
52
53	meta runtime_compile e
54	if e:size<1 or e:size%2<>1
55	return
56	for (var Int i) 0 e:size-3 step 2
57	if not e:i:is_pure_ident
58	return
59	e:(i+1) compile ?
60	var Link:Expression expr :> duplicate (e e:size-1)
61	expr switch_module (null map Module)
62	var Link:Argument pe :> argument mapped_constant PackedExpression expr
63	var Link:Argument l :> argument local Link:Expression
64	var Link:Argument e2 :> argument indirect Expression (argument local Address) 0
65	e add (instruction (the_function 'cast (Link Expression)' PackedExpression -> Link:Expression) pe l)
66	e add (instruction (the_function 'cast Expression' Link:Expression -> Expression) l e2)
67	for (var Int i) 0 e:size-3 step 2
68	var Link:Argument id :> argument constant Str e:i:ident
69	var Pointer:Type t :> e:(i+1):result:type real_data_type
70	e:(i+1) cast t
71	e suckup e:(i+1)
72	if (t:flags .and. type_flag_do_not_copy)=0
73	e add (instruction (the_function copy_constant Expression Ident Universal Type) e2 id e:(i+1):result (argument mapped_constant Type t))
74	else
75	e add (instruction (the_function map_constant Expression Ident Universal) e2 id e:(i+1):result)
76	var Pointer:Module m :> e module
77	if (pliant_module_dictionary first m:name)=null
78	pliant_module_dictionary insert m:name true addressof:m
79	e add (instruction (the_function compile Expression Str) e2 (argument constant Str m:name))
80	e set_void_result
81
82	export runtime_compile