1 /* pkl.c - Poke compiler. */
2
3 /* Copyright (C) 2019, 2020, 2021 Jose E. Marchesi */
4
5 /* This program is free software: you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 */
18
19 #include <config.h>
20
21 #include <gettext.h>
22 #define _(str) gettext (str)
23 #include <stdarg.h>
24 #include <stdio.h> /* For fopen, etc */
25 #include <stdlib.h>
26 #include <string.h>
27
28 #include "basename-lgpl.h"
29
30 #include "pkt.h"
31 #include "pk-utils.h"
32
33 #include "pkl.h"
34 #include "pvm-val.h"
35
36 #include "pkl-ast.h"
37 #include "pkl-parser.h"
38 #include "pkl-pass.h"
39 #include "pkl-gen.h"
40 #include "pkl-trans.h"
41 #include "pkl-anal.h"
42 #include "pkl-trans.h"
43 #include "pkl-typify.h"
44 #include "pkl-promo.h"
45 #include "pkl-fold.h"
46 #include "pkl-env.h"
47
48 #define PKL_COMPILING_EXPRESSION 0
49 #define PKL_COMPILING_PROGRAM 1
50 #define PKL_COMPILING_STATEMENT 2
51
52
53 /* The `pkl_compiler' struct holds the compiler state.
54
55 LEXICAL_CUCKOLDING_P is 1 if alien tokens are to be recognized.
56
57 ALIEN_TOKEN_FN is the user-provided handler for alien tokens. This
58 field is NULL if the user didn't register a handler. */
59
60 struct pkl_compiler
61 {
62 pkl_env env; /* Compiler environment. */
63 pvm vm;
64 int bootstrapped;
65 int compiling;
66 int error_on_warning;
67 int quiet_p;
68 #define PKL_MODULES_STEP 8
69 char **modules;
70 int num_modules;
71 int lexical_cuckolding_p;
72 pkl_alien_token_handler_fn alien_token_fn;
73 };
74
75 pkl_compiler
pkl_new(pvm vm,const char * rt_path)76 pkl_new (pvm vm, const char *rt_path)
77 {
78 pkl_compiler compiler
79 = calloc (1, sizeof (struct pkl_compiler));
80
81 if (!compiler)
82 goto out_of_memory;
83
84 /* Create the top-level compile-time environment. This will be used
85 for as long as the incremental compiler lives. */
86 compiler->env = pkl_env_new ();
87
88 /* Set the poke virtual machine that the compiler will be generating
89 code for. */
90 compiler->vm = vm;
91
92 /* Be verbose by default :) */
93 compiler->quiet_p = 0;
94
95 /* No modules loaded initially. */
96 compiler->modules = NULL;
97 compiler->num_modules = 0;
98
99 /* Bootstrap the compiler. An error bootstraping is an internal
100 error and should be reported as such. */
101 {
102 char *poke_rt_pk = pk_str_concat (rt_path, "/pkl-rt.pk", NULL);
103 if (!poke_rt_pk)
104 goto out_of_memory;
105
106 if (!pkl_execute_file (compiler, poke_rt_pk, NULL))
107 {
108 free (poke_rt_pk);
109
110 pk_term_class ("error");
111 pk_puts ("internal error: ");
112 pk_term_end_class ("error");
113 pk_puts ("compiler failed to bootstrap itself\n");
114
115 pkl_free (compiler);
116 return NULL;
117 }
118 free (poke_rt_pk);
119
120 compiler->bootstrapped = 1;
121 }
122
123 /* Load the standard library. */
124 {
125 char *poke_std_pk = pk_str_concat (rt_path, "/std.pk", NULL);
126 if (!poke_std_pk)
127 goto out_of_memory;
128
129 if (!pkl_execute_file (compiler, poke_std_pk, NULL))
130 {
131 free (poke_std_pk);
132 pkl_free (compiler);
133 return NULL;
134 }
135
136 free (poke_std_pk);
137 }
138
139 return compiler;
140
141 out_of_memory:
142 if (compiler)
143 pkl_free (compiler);
144
145 pk_term_class ("error");
146 pk_puts ("error: ");
147 pk_term_end_class ("error");
148 pk_puts ("out of memory\n");
149
150 return NULL;
151 }
152
153 void
pkl_free(pkl_compiler compiler)154 pkl_free (pkl_compiler compiler)
155 {
156 size_t i;
157
158 pkl_env_free (compiler->env);
159 for (i = 0; i < compiler->num_modules; ++i)
160 free (compiler->modules[i]);
161 free (compiler->modules);
162 free (compiler);
163 }
164
165 static pvm_program
rest_of_compilation(pkl_compiler compiler,pkl_ast ast)166 rest_of_compilation (pkl_compiler compiler,
167 pkl_ast ast)
168 {
169 struct pkl_gen_payload gen_payload;
170
171 struct pkl_anal_payload anal1_payload;
172 struct pkl_anal_payload anal2_payload;
173 struct pkl_anal_payload analf_payload;
174
175 struct pkl_trans_payload trans1_payload;
176 struct pkl_trans_payload trans2_payload;
177 struct pkl_trans_payload trans3_payload;
178 struct pkl_trans_payload trans4_payload;
179
180 struct pkl_typify_payload typify1_payload = { 0 };
181 struct pkl_typify_payload typify2_payload = { 0 };
182
183 struct pkl_fold_payload fold_payload = { 0 };
184
185 struct pkl_phase *frontend_phases[]
186 = { &pkl_phase_trans1,
187 &pkl_phase_anal1,
188 &pkl_phase_typify1,
189 &pkl_phase_promo,
190 &pkl_phase_trans2,
191 &pkl_phase_fold,
192 &pkl_phase_trans3,
193 &pkl_phase_typify2,
194 &pkl_phase_anal2,
195 NULL,
196 };
197
198 void *frontend_payloads[]
199 = { &trans1_payload,
200 &anal1_payload,
201 &typify1_payload,
202 NULL, /* promo */
203 &trans2_payload,
204 &fold_payload,
205 &trans3_payload,
206 &typify2_payload,
207 &anal2_payload,
208 };
209
210 void *middleend_payloads[]
211 = { &fold_payload,
212 &trans4_payload,
213 &analf_payload,
214 };
215
216 struct pkl_phase *middleend_phases[]
217 = { &pkl_phase_fold,
218 &pkl_phase_trans4,
219 &pkl_phase_analf,
220 NULL
221 };
222
223 /* Note that gen does subpasses, so no transformation phases should
224 be invoked in the bakend pass. */
225 struct pkl_phase *backend_phases[]
226 = { &pkl_phase_gen,
227 NULL
228 };
229
230 void *backend_payloads[]
231 = { &gen_payload
232 };
233
234 /* Initialize payloads. */
235 pkl_anal_init_payload (&anal1_payload);
236 pkl_anal_init_payload (&anal2_payload);
237 pkl_anal_init_payload (&analf_payload);
238 pkl_trans_init_payload (&trans1_payload);
239 pkl_trans_init_payload (&trans2_payload);
240 pkl_trans_init_payload (&trans3_payload);
241 pkl_trans_init_payload (&trans4_payload);
242 pkl_gen_init_payload (&gen_payload, compiler);
243
244 if (!pkl_do_pass (compiler, ast,
245 frontend_phases, frontend_payloads, PKL_PASS_F_TYPES, 1))
246 goto error;
247
248 if (trans1_payload.errors > 0
249 || trans2_payload.errors > 0
250 || trans3_payload.errors > 0
251 || anal1_payload.errors > 0
252 || anal2_payload.errors > 0
253 || typify1_payload.errors > 0
254 || fold_payload.errors > 0
255 || typify2_payload.errors > 0)
256 goto error;
257
258 if (!pkl_do_pass (compiler, ast,
259 middleend_phases, middleend_payloads, PKL_PASS_F_TYPES, 2))
260 goto error;
261
262 if (trans4_payload.errors > 0
263 || fold_payload.errors > 0
264 || analf_payload.errors > 0)
265 goto error;
266
267 if (!pkl_do_pass (compiler, ast,
268 backend_phases, backend_payloads, 0, 0))
269 goto error;
270
271 if (analf_payload.errors > 0)
272 goto error;
273
274 pkl_ast_free (ast);
275 return gen_payload.program;
276
277 error:
278 pkl_ast_free (ast);
279 return NULL;
280 }
281
282 int
pkl_execute_buffer(pkl_compiler compiler,const char * buffer,const char ** end)283 pkl_execute_buffer (pkl_compiler compiler,
284 const char *buffer, const char **end)
285 {
286 pkl_ast ast = NULL;
287 pvm_program program;
288 int ret;
289 pkl_env env = NULL;
290
291 compiler->compiling = PKL_COMPILING_PROGRAM;
292 env = pkl_env_dup_toplevel (compiler->env);
293
294 /* Parse the input routine into an AST. */
295 ret = pkl_parse_buffer (compiler, &env, &ast,
296 PKL_PARSE_PROGRAM,
297 buffer, end);
298 if (ret == 1)
299 /* Parse error. */
300 goto error;
301 else if (ret == 2)
302 /* Memory exhaustion. */
303 printf (_("out of memory\n"));
304
305 program = rest_of_compilation (compiler, ast);
306 if (program == NULL)
307 goto error;
308
309 // pvm_disassemble_program (program);
310 pvm_program_make_executable (program);
311
312 /* Execute the program in the poke vm. */
313 {
314 pvm_val val;
315
316 if (pvm_run (compiler->vm, program, &val) != PVM_EXIT_OK)
317 goto error;
318
319 /* Discard the value. */
320 }
321
322 pvm_destroy_program (program);
323 pkl_env_free (compiler->env);
324 compiler->env = env;
325 return 1;
326
327 error:
328 pkl_env_free (env);
329 return 0;
330 }
331
332 int
pkl_execute_statement(pkl_compiler compiler,const char * buffer,const char ** end,pvm_val * val)333 pkl_execute_statement (pkl_compiler compiler,
334 const char *buffer, const char **end,
335 pvm_val *val)
336 {
337 pkl_ast ast = NULL;
338 pvm_program program;
339 int ret;
340 pkl_env env = NULL;
341
342 compiler->compiling = PKL_COMPILING_STATEMENT;
343 env = pkl_env_dup_toplevel (compiler->env);
344
345 /* Parse the input routine into an AST. */
346 ret = pkl_parse_buffer (compiler, &env, &ast,
347 PKL_PARSE_STATEMENT,
348 buffer, end);
349 if (ret == 1)
350 /* Parse error. */
351 goto error;
352 else if (ret == 2)
353 /* Memory exhaustion. */
354 printf (_("out of memory\n"));
355
356 program = rest_of_compilation (compiler, ast);
357 if (program == NULL)
358 goto error;
359
360 pvm_program_make_executable (program);
361
362 /* Execute the routine in the poke vm. */
363 if (pvm_run (compiler->vm, program, val) != PVM_EXIT_OK)
364 goto error;
365
366 pvm_destroy_program (program);
367 pkl_env_free (compiler->env);
368 compiler->env = env;
369 return 1;
370
371 error:
372 pkl_env_free (env);
373 return 0;
374 }
375
376 pvm_program
pkl_compile_expression(pkl_compiler compiler,const char * buffer,const char ** end)377 pkl_compile_expression (pkl_compiler compiler,
378 const char *buffer, const char **end)
379 {
380 pkl_ast ast = NULL;
381 pvm_program program;
382 int ret;
383 pkl_env env = NULL;
384
385 compiler->compiling = PKL_COMPILING_EXPRESSION;
386 env = pkl_env_dup_toplevel (compiler->env);
387
388 /* Parse the input program into an AST. */
389 ret = pkl_parse_buffer (compiler, &env, &ast,
390 PKL_PARSE_EXPRESSION,
391 buffer, end);
392 if (ret == 1)
393 /* Parse error. */
394 goto error;
395 else if (ret == 2)
396 /* Memory exhaustion. */
397 printf (_("out of memory\n"));
398
399 program = rest_of_compilation (compiler, ast);
400 if (program == NULL)
401 goto error;
402
403 pkl_env_free (compiler->env);
404 compiler->env = env;
405 pvm_program_make_executable (program);
406
407 return program;
408
409 error:
410 pkl_env_free (env);
411 return NULL;
412 }
413
414 int
pkl_execute_expression(pkl_compiler compiler,const char * buffer,const char ** end,pvm_val * val)415 pkl_execute_expression (pkl_compiler compiler,
416 const char *buffer, const char **end,
417 pvm_val *val)
418 {
419 pkl_ast ast = NULL;
420 pvm_program program;
421 int ret;
422 pkl_env env = NULL;
423
424 compiler->compiling = PKL_COMPILING_EXPRESSION;
425 env = pkl_env_dup_toplevel (compiler->env);
426
427 /* Parse the input routine into an AST. */
428 ret = pkl_parse_buffer (compiler, &env, &ast,
429 PKL_PARSE_EXPRESSION,
430 buffer, end);
431 if (ret == 1)
432 /* Parse error. */
433 goto error;
434 else if (ret == 2)
435 /* Memory exhaustion. */
436 printf (_("out of memory\n"));
437
438 program = rest_of_compilation (compiler, ast);
439 if (program == NULL)
440 goto error;
441
442 pvm_program_make_executable (program);
443
444 /* Execute the routine in the poke vm. */
445 if (pvm_run (compiler->vm, program, val) != PVM_EXIT_OK)
446 goto error;
447
448 pvm_destroy_program (program);
449 pkl_env_free (compiler->env);
450 compiler->env = env;
451 return 1;
452
453 error:
454 pkl_env_free (env);
455 return 0;
456 }
457
458 int
pkl_execute_file(pkl_compiler compiler,const char * fname,int * exit_status)459 pkl_execute_file (pkl_compiler compiler, const char *fname,
460 int *exit_status)
461 {
462 int ret;
463 pkl_ast ast = NULL;
464 pvm_program program;
465 FILE *fp;
466 pkl_env env = NULL;
467
468 compiler->compiling = PKL_COMPILING_PROGRAM;
469
470 fp = fopen (fname, "rb");
471 if (!fp)
472 {
473 perror (fname);
474 return 0;
475 }
476
477 env = pkl_env_dup_toplevel (compiler->env);
478 ret = pkl_parse_file (compiler, &env, &ast, fp, fname);
479 if (ret == 1)
480 /* Parse error. */
481 goto error;
482 else if (ret == 2)
483 {
484 /* Memory exhaustion. */
485 printf (_("out of memory\n"));
486 }
487
488 program = rest_of_compilation (compiler, ast);
489 if (program == NULL)
490 goto error;
491
492 pvm_program_make_executable (program);
493 fclose (fp);
494
495 /* Execute the program in the poke vm. */
496 {
497 pvm_val val;
498 int status = pvm_run (compiler->vm, program, &val);
499
500 if (exit_status)
501 *exit_status = status;
502 }
503
504 pvm_destroy_program (program);
505 pkl_env_free (compiler->env);
506 compiler->env = env;
507 return 1;
508
509 error:
510 fclose (fp);
511 pkl_env_free (env);
512 return 0;
513 }
514
515 pkl_env
pkl_get_env(pkl_compiler compiler)516 pkl_get_env (pkl_compiler compiler)
517 {
518 return compiler->env;
519 }
520
521 int
pkl_bootstrapped_p(pkl_compiler compiler)522 pkl_bootstrapped_p (pkl_compiler compiler)
523 {
524 return compiler->bootstrapped;
525 }
526
527 int
pkl_compiling_expression_p(pkl_compiler compiler)528 pkl_compiling_expression_p (pkl_compiler compiler)
529 {
530 return compiler->compiling == PKL_COMPILING_EXPRESSION;
531 }
532
533 int
pkl_compiling_statement_p(pkl_compiler compiler)534 pkl_compiling_statement_p (pkl_compiler compiler)
535 {
536 return compiler->compiling == PKL_COMPILING_STATEMENT;
537 }
538
539 int
pkl_error_on_warning(pkl_compiler compiler)540 pkl_error_on_warning (pkl_compiler compiler)
541 {
542 return compiler->error_on_warning;
543 }
544
545 void
pkl_set_error_on_warning(pkl_compiler compiler,int error_on_warning)546 pkl_set_error_on_warning (pkl_compiler compiler,
547 int error_on_warning)
548 {
549 compiler->error_on_warning = error_on_warning;
550 }
551
552 int
pkl_quiet_p(pkl_compiler compiler)553 pkl_quiet_p (pkl_compiler compiler)
554 {
555 return compiler->quiet_p;
556 }
557
558 void
pkl_set_quiet_p(pkl_compiler compiler,int quiet_p)559 pkl_set_quiet_p (pkl_compiler compiler, int quiet_p)
560 {
561 compiler->quiet_p = quiet_p;
562 }
563
564 int
pkl_lexical_cuckolding_p(pkl_compiler compiler)565 pkl_lexical_cuckolding_p (pkl_compiler compiler)
566 {
567 return compiler->lexical_cuckolding_p;
568 }
569
570 void
pkl_set_lexical_cuckolding_p(pkl_compiler compiler,int lexical_cuckolding_p)571 pkl_set_lexical_cuckolding_p (pkl_compiler compiler,
572 int lexical_cuckolding_p)
573 {
574 compiler->lexical_cuckolding_p = lexical_cuckolding_p;
575 }
576
577 pkl_alien_token_handler_fn
pkl_alien_token_fn(pkl_compiler compiler)578 pkl_alien_token_fn (pkl_compiler compiler)
579 {
580 return compiler->alien_token_fn;
581 }
582
583 void
pkl_set_alien_token_fn(pkl_compiler compiler,pkl_alien_token_handler_fn cb)584 pkl_set_alien_token_fn (pkl_compiler compiler,
585 pkl_alien_token_handler_fn cb)
586 {
587 compiler->alien_token_fn = cb;
588 }
589
590 pvm_program
pkl_compile_call(pkl_compiler compiler,pvm_val cls,pvm_val * ret,va_list ap)591 pkl_compile_call (pkl_compiler compiler, pvm_val cls, pvm_val *ret,
592 va_list ap)
593 {
594 pvm_program program;
595 pkl_asm pasm;
596 pvm_val arg;
597
598 pasm = pkl_asm_new (NULL /* ast */, compiler, 1 /* prologue */);
599
600 /* Push the arguments for the function. */
601 do
602 {
603 arg = va_arg (ap, pvm_val);
604 if (arg != PVM_NULL)
605 pkl_asm_insn (pasm, PKL_INSN_PUSH, arg);
606 }
607 while (arg != PVM_NULL);
608
609 /* Call the closure. */
610 pkl_asm_insn (pasm, PKL_INSN_PUSH, cls);
611 pkl_asm_insn (pasm, PKL_INSN_CALL);
612
613 program = pkl_asm_finish (pasm, 1 /* epilogue */);
614 return program;
615 }
616
617 pvm
pkl_get_vm(pkl_compiler compiler)618 pkl_get_vm (pkl_compiler compiler)
619 {
620 return compiler->vm;
621 }
622
623 void
pkl_add_module(pkl_compiler compiler,const char * path)624 pkl_add_module (pkl_compiler compiler, const char *path)
625 {
626 const char *module = last_component (path);
627
628 if (compiler->num_modules % PKL_MODULES_STEP == 0)
629 {
630 size_t size = ((compiler->num_modules + PKL_MODULES_STEP)
631 * sizeof (char*));
632 compiler->modules = realloc (compiler->modules, size);
633 memset (compiler->modules + compiler->num_modules, 0,
634 PKL_MODULES_STEP * sizeof (char*));
635 }
636
637 compiler->modules[compiler->num_modules++] = strdup (module);
638 }
639
640 int
pkl_module_loaded_p(pkl_compiler compiler,const char * path)641 pkl_module_loaded_p (pkl_compiler compiler, const char *path)
642 {
643 const char *basename = last_component (path);
644 int i;
645
646 for (i = 0; i < compiler->num_modules; ++i)
647 {
648 if (STREQ (compiler->modules[i], basename))
649 return 1;
650 }
651
652 return 0;
653 }
654
655 char *
pkl_resolve_module(pkl_compiler compiler,const char * module,int filename_p)656 pkl_resolve_module (pkl_compiler compiler,
657 const char *module,
658 int filename_p)
659 {
660 const char *load_path;
661 char *full_filename = NULL;
662
663 /* Get the load path from the run-time environment. */
664 {
665 pvm_val val;
666 int back, over;
667
668 pkl_env compiler_env = pkl_get_env (compiler);
669 pvm_env runtime_env = pvm_get_env (pkl_get_vm (compiler));
670
671 if (NULL == pkl_env_lookup (compiler_env,
672 PKL_ENV_NS_MAIN,
673 "load_path",
674 &back, &over))
675 return NULL;
676
677 val = pvm_env_lookup (runtime_env, back, over);
678 assert (val != PVM_NULL);
679
680 load_path = PVM_VAL_STR (val);
681 }
682
683 /* Traverse the directories in the load path and try to load the
684 requested module. */
685 {
686 const char *ext = filename_p ? "" : ".pk";
687 const char *s, *e;
688
689 char *fixed_load_path = pk_str_replace (load_path, "%DATADIR%", PKGDATADIR);
690
691 for (s = fixed_load_path, e = s; *e; s = e + 1)
692 {
693 /* Ignore empty entries. */
694 if ((e = strchrnul (s, ':')) == s)
695 continue;
696
697 asprintf (&full_filename, "%.*s/%s%s", (int) (e - s), s, module, ext);
698
699 if (pk_file_readable (full_filename) == NULL)
700 break;
701
702 free (full_filename);
703 full_filename = NULL;
704 }
705
706 if (fixed_load_path != load_path)
707 free (fixed_load_path);
708 }
709
710 return full_filename;
711 }
712
713 int
pkl_load(pkl_compiler compiler,const char * module)714 pkl_load (pkl_compiler compiler, const char *module)
715 {
716 char *module_filename = pkl_resolve_module (compiler,
717 module,
718 0 /* filename_p */);
719 if (!module_filename)
720 return 0;
721
722 if (pkl_module_loaded_p (compiler, module_filename))
723 return 1;
724
725 if (!pkl_execute_file (compiler, module_filename, NULL))
726 {
727 pkl_add_module (compiler, module_filename);
728 return 0;
729 }
730
731 return 1;
732 }
733
734 static pkl_ast_node
pvm_type_to_ast_type(pkl_ast ast,pvm_val type)735 pvm_type_to_ast_type (pkl_ast ast, pvm_val type)
736 {
737 switch (PVM_VAL_TYP_CODE (type))
738 {
739 case PVM_TYPE_INTEGRAL:
740 {
741 size_t size = PVM_VAL_ULONG (PVM_VAL_TYP_I_SIZE (type));
742 int signed_p = PVM_VAL_INT (PVM_VAL_TYP_I_SIGNED_P (type));
743
744 return pkl_ast_make_integral_type (ast, size, signed_p);
745 break;
746 }
747 case PVM_TYPE_STRING:
748 return pkl_ast_make_string_type (ast);
749 break;
750 case PVM_TYPE_ARRAY:
751 {
752 pkl_ast_node elem_type
753 =pvm_type_to_ast_type (ast, PVM_VAL_TYP_A_ETYPE (type));
754 pkl_ast_node bound = NULL; /* XXX no bound in pvm types for now. */
755
756 return pkl_ast_make_array_type (ast, elem_type, bound);
757 break;
758 }
759 case PVM_TYPE_OFFSET:
760 {
761 pkl_ast_node base_type
762 = pvm_type_to_ast_type (ast, PVM_VAL_TYP_O_BASE_TYPE (type));
763 pkl_ast_node unit
764 = pkl_ast_make_integer (ast, PVM_VAL_ULONG (PVM_VAL_TYP_O_UNIT (type)));
765
766 return pkl_ast_make_offset_type (ast, base_type, unit);
767 break;
768 }
769 case PVM_TYPE_ANY:
770 return pkl_ast_make_any_type (ast);
771 break;
772 case PVM_TYPE_STRUCT:
773 /* XXX writeme */
774 assert (0);
775 break;
776 case PVM_TYPE_CLOSURE:
777 /* XXX writeme */
778 assert (0);
779 break;
780 default:
781 break;
782 }
783
784 return NULL;
785 }
786
787 int
pkl_defvar(pkl_compiler compiler,const char * varname,pvm_val val)788 pkl_defvar (pkl_compiler compiler,
789 const char *varname, pvm_val val)
790 {
791 pkl_ast ast = NULL;
792 pkl_ast_node name = NULL;
793 pkl_ast_node initial = NULL;
794 pkl_ast_node initial_type = NULL;
795 pkl_ast_node decl = NULL;
796
797 ast = pkl_ast_init ();
798 if (!ast)
799 goto error;
800
801 name = pkl_ast_make_identifier (ast, varname);
802 if (!name)
803 goto error;
804
805 /* The type of the initial. */
806 initial_type = pvm_type_to_ast_type (ast, pvm_typeof (val));
807 if (!initial_type)
808 goto error;
809
810 /* This ast is not to be compiled. */
811 PKL_AST_TYPE_COMPILED (initial_type) = 1;
812 /* Initial is a dummy, with the right type. */
813 initial = pkl_ast_make_integer (ast, 0);
814 if (!initial)
815 goto error;
816
817 PKL_AST_TYPE (initial) = ASTREF (initial_type);
818 decl = pkl_ast_make_decl (ast,
819 PKL_AST_DECL_KIND_VAR,
820 name,
821 initial,
822 "<libpoke>");
823 if (!decl)
824 goto error;
825
826 if (!pkl_env_register (compiler->env,
827 PKL_ENV_NS_MAIN,
828 varname,
829 decl))
830 /* A variable with the given name is already registered. */
831 goto error;
832
833 return 1;
834
835 error:
836 pkl_ast_free (ast);
837 return 0;
838 }
839