Changeset 883fedc in mainline
- Timestamp:
- 2010-04-23T23:09:56Z (14 years ago)
- Branches:
- lfn, master, serial, ticket/834-toolchain-update, topic/msim-upgrade, topic/simplify-dev-export
- Children:
- 37c9fc8
- Parents:
- 80badbe (diff), 6c39a907 (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the(diff)
links above to see all the changes relative to each parent. - Location:
- uspace
- Files:
-
- 5 added
- 39 edited
Legend:
- Unmodified
- Added
- Removed
-
uspace/app/sbi/Makefile
r80badbe r883fedc 34 34 35 35 SOURCES = \ 36 src/builtin/bi_boxed.c \ 36 37 src/builtin/bi_error.c \ 37 38 src/builtin/bi_fun.c \ -
uspace/app/sbi/src/builtin.c
r80badbe r883fedc 40 40 #include <stdlib.h> 41 41 #include <assert.h> 42 #include " ancr.h"42 #include "builtin/bi_boxed.h" 43 43 #include "builtin/bi_error.h" 44 44 #include "builtin/bi_fun.h" … … 90 90 bi_fun_declare(bi); 91 91 bi_textfile_declare(bi); 92 93 /* Need to process ancestry so that symbol lookups work. */ 94 ancr_module_process(program, program->module); 95 92 } 93 94 /** Bind internal interpreter references to symbols in the program. 95 * 96 * This is performed in separate phase for several reasons. First, 97 * symbol lookups do not work until ancestry is processed. Second, 98 * this gives a chance to process the library first and thus bind 99 * to symbols defined there. 100 */ 101 void builtin_bind(builtin_t *bi) 102 { 103 bi_boxed_bind(bi); 96 104 bi_error_bind(bi); 97 105 bi_fun_bind(bi); … … 300 308 stree_ident_t *ident; 301 309 stree_fun_t *fun; 310 stree_fun_sig_t *sig; 302 311 stree_csimbr_t *csimbr; 303 312 stree_symbol_t *fun_sym; … … 310 319 fun->proc = stree_proc_new(); 311 320 fun->proc->body = NULL; 312 list_init(&fun->args); 321 sig = stree_fun_sig_new(); 322 fun->sig = sig; 323 324 list_init(&fun->sig->args); 313 325 314 326 csimbr = stree_csimbr_new(csimbr_fun); … … 348 360 proc_arg->type = NULL; /* XXX */ 349 361 350 list_append(&fun-> args, proc_arg);351 } 362 list_append(&fun->sig->args, proc_arg); 363 } -
uspace/app/sbi/src/builtin.h
r80badbe r883fedc 33 33 34 34 void builtin_declare(stree_program_t *program); 35 void builtin_bind(builtin_t *bi); 35 36 void builtin_code_snippet(builtin_t *bi, const char *snippet); 36 37 -
uspace/app/sbi/src/builtin/bi_error.c
r80badbe r883fedc 36 36 #include "bi_error.h" 37 37 38 /** Declare error class hierarchy. */ 38 /** Declare error class hierarchy. 39 * 40 * @param bi Builtin object 41 */ 39 42 void bi_error_declare(builtin_t *bi) 40 43 { … … 57 60 "end\n");} 58 61 59 /** Bind error class hierarchy. */ 62 /** Bind error class hierarchy. 63 * 64 * @param bi Builtin object 65 */ 60 66 void bi_error_bind(builtin_t *bi) 61 67 { -
uspace/app/sbi/src/builtin/bi_fun.c
r80badbe r883fedc 44 44 #include "bi_fun.h" 45 45 46 static void bi_fun_builtin_write(run_t *run); 46 47 static void bi_fun_builtin_writeline(run_t *run); 47 48 static void bi_fun_task_exec(run_t *run); 48 49 49 /** Declare builtin functions. */ 50 /** Declare builtin functions. 51 * 52 * @param bi Builtin object 53 */ 50 54 void bi_fun_declare(builtin_t *bi) 51 55 { … … 63 67 csi = stree_csi_new(csi_class); 64 68 csi->name = ident; 69 list_init(&csi->targ); 65 70 list_init(&csi->members); 66 71 … … 75 80 list_append(&bi->program->module->members, modm); 76 81 82 /* Declare Builtin.Write(). */ 83 84 fun_sym = builtin_declare_fun(csi, "Write"); 85 builtin_fun_add_arg(fun_sym, "arg"); 86 77 87 /* Declare Builtin.WriteLine(). */ 78 88 … … 88 98 } 89 99 90 /** Bind builtin functions. */ 100 /** Bind builtin functions. 101 * 102 * @param bi Builtin object 103 */ 91 104 void bi_fun_bind(builtin_t *bi) 92 105 { 106 builtin_fun_bind(bi, "Builtin", "Write", bi_fun_builtin_write); 93 107 builtin_fun_bind(bi, "Builtin", "WriteLine", bi_fun_builtin_writeline); 94 108 builtin_fun_bind(bi, "Task", "Exec", bi_fun_task_exec); 95 109 } 96 110 97 /** Write a line of output. */ 98 static void bi_fun_builtin_writeline(run_t *run) 111 /** Write to the console. 112 * 113 * @param run Runner object 114 */ 115 static void bi_fun_builtin_write(run_t *run) 99 116 { 100 117 rdata_var_t *var; … … 103 120 104 121 #ifdef DEBUG_RUN_TRACE 105 printf("Called Builtin.Write Line()\n");122 printf("Called Builtin.Write()\n"); 106 123 #endif 107 124 var = run_local_vars_lookup(run, strtab_get_sid("arg")); … … 109 126 110 127 switch (var->vc) { 128 case vc_bool: 129 printf("%s", var->u.bool_v->value ? "true" : "false"); 130 break; 111 131 case vc_char: 112 132 rc = bigint_get_value_int(&var->u.char_v->value, &char_val); 113 133 if (rc == EOK) 114 printf("%lc \n", char_val);134 printf("%lc", char_val); 115 135 else 116 printf("??? \n");136 printf("???"); 117 137 break; 118 138 case vc_int: 119 139 bigint_print(&var->u.int_v->value); 120 putchar('\n');121 140 break; 122 141 case vc_string: 123 printf("%s \n", var->u.string_v->value);142 printf("%s", var->u.string_v->value); 124 143 break; 125 144 default: 126 printf("Unimplemented: writeLine() with unsupported type.\n"); 127 exit(1); 128 } 129 } 130 131 /** Start an executable and wait for it to finish. */ 145 printf("Unimplemented: Write() with unsupported type.\n"); 146 exit(1); 147 } 148 } 149 150 /** Write a line of output. 151 * 152 * @param run Runner object 153 */ 154 static void bi_fun_builtin_writeline(run_t *run) 155 { 156 #ifdef DEBUG_RUN_TRACE 157 printf("Called Builtin.WriteLine()\n"); 158 #endif 159 bi_fun_builtin_write(run); 160 putchar('\n'); 161 } 162 163 /** Start an executable and wait for it to finish. 164 * 165 * @param run Runner object 166 */ 132 167 static void bi_fun_task_exec(run_t *run) 133 168 { … … 137 172 rdata_var_t *arg; 138 173 int idx, dim; 139 c har **cmd;174 const char **cmd; 140 175 141 176 #ifdef DEBUG_RUN_TRACE … … 178 213 cmd[dim] = '\0'; 179 214 180 if (os_exec( cmd) != EOK) {215 if (os_exec((char * const *)cmd) != EOK) { 181 216 printf("Error: Exec failed.\n"); 182 217 exit(1); -
uspace/app/sbi/src/builtin/bi_textfile.c
r80badbe r883fedc 53 53 static void bi_textfile_is_eof(run_t *run); 54 54 55 /** Declare TextFile builtin. */ 55 /** Declare TextFile builtin. 56 * 57 * @param bi Builtin object 58 */ 56 59 void bi_textfile_declare(builtin_t *bi) 57 60 { … … 79 82 } 80 83 81 /** Bind TextFile builtin. */ 84 /** Bind TextFile builtin. 85 * 86 * @param bi Builtin object 87 */ 82 88 void bi_textfile_bind(builtin_t *bi) 83 89 { … … 90 96 } 91 97 92 /** Open a text file for reading. */ 98 /** Open a text file for reading. 99 * 100 * @param run Runner object 101 */ 93 102 static void bi_textfile_openread(run_t *run) 94 103 { 95 104 rdata_var_t *fname_var; 96 c har *fname;105 const char *fname; 97 106 FILE *file; 98 107 … … 130 139 } 131 140 132 /** Open a text file for writing. */ 141 /** Open a text file for writing. 142 * 143 * @param run Runner object 144 */ 133 145 static void bi_textfile_openwrite(run_t *run) 134 146 { 135 147 rdata_var_t *fname_var; 136 c har *fname;148 const char *fname; 137 149 FILE *file; 138 150 … … 170 182 } 171 183 172 /** Close a text file. */ 184 /** Close a text file. 185 * 186 * @param run Runner object 187 */ 173 188 static void bi_textfile_close(run_t *run) 174 189 { … … 205 220 206 221 207 /** Read one line from a text file. */ 222 /** Read one line from a text file. 223 * 224 * @param run Runner object 225 */ 208 226 static void bi_textfile_readline(run_t *run) 209 227 { … … 272 290 } 273 291 274 /** Write one line to a text file. */ 292 /** Write one line to a text file. 293 * 294 * @param run Runner object 295 */ 275 296 static void bi_textfile_writeline(run_t *run) 276 297 { … … 278 299 rdata_var_t *self_f_var; 279 300 rdata_var_t *line_var; 280 c har *line;301 const char *line; 281 302 282 303 run_proc_ar_t *proc_ar; … … 312 333 } 313 334 314 /** Return value of EOF flag. */ 335 /** Return value of EOF flag. 336 * 337 * @param run Runner object 338 */ 315 339 static void bi_textfile_is_eof(run_t *run) 316 340 { -
uspace/app/sbi/src/builtin_t.h
r80badbe r883fedc 43 43 struct stree_symbol *gf_class; 44 44 45 /** Error class for nil reference access. */ 45 /** Boxed variants of primitive types */ 46 struct stree_symbol *boxed_bool; 47 struct stree_symbol *boxed_char; 48 struct stree_symbol *boxed_int; 49 struct stree_symbol *boxed_string; 50 51 /** Error class for nil reference access */ 46 52 struct stree_csi *error_nilreference; 47 53 48 /** Error class for out-of-bounds array access .*/54 /** Error class for out-of-bounds array access */ 49 55 struct stree_csi *error_outofbounds; 50 56 } builtin_t; -
uspace/app/sbi/src/debug.h
r80badbe r883fedc 34 34 35 35 /** 36 * Uncomment this to get extra verbose messages from parser's lexing36 * Uncomment this to get extra verbose messages from parser's lexing 37 37 * primitives. 38 38 */ -
uspace/app/sbi/src/imode.c
r80badbe r883fedc 98 98 ancr_module_process(program, program->module); 99 99 100 /* Bind internal interpreter references to symbols. */ 101 builtin_bind(program->builtin); 102 103 /* Resolve ancestry. */ 104 ancr_module_process(program, program->module); 105 100 106 /* Construct typing context. */ 101 107 stype.program = program; -
uspace/app/sbi/src/lex.c
r80badbe r883fedc 80 80 { lc_class, "class" }, 81 81 { lc_constructor, "constructor" }, 82 { lc_deleg, "deleg" }, 82 83 { lc_do, "do" }, 83 84 { lc_else, "else" }, … … 210 211 switch (lem->lclass) { 211 212 case lc_ident: 212 printf("( %d)", lem->u.ident.sid);213 printf("('%s')", strtab_get_str(lem->u.ident.sid)); 213 214 break; 214 215 case lc_lit_int: -
uspace/app/sbi/src/lex_t.h
r80badbe r883fedc 49 49 lc_class, 50 50 lc_constructor, 51 lc_deleg, 51 52 lc_do, 52 53 lc_else, -
uspace/app/sbi/src/main.c
r80badbe r883fedc 92 92 return 1; 93 93 94 /* Resolve ancestry. */ 95 ancr_module_process(program, program->module); 96 97 /* Bind internal interpreter references to symbols. */ 98 builtin_bind(program->builtin); 99 94 100 /* Process all source files specified in command-line arguments. */ 95 101 while (argc > 0) { -
uspace/app/sbi/src/os/helenos.c
r80badbe r883fedc 48 48 static tinput_t *tinput = NULL; 49 49 50 /** Concatenate two strings. */ 50 /** Concatenate two strings. 51 * 52 * @param a First string 53 * @param b Second string 54 * @return New string, concatenation of @a a and @a b. 55 */ 51 56 char *os_str_acat(const char *a, const char *b) 52 57 { … … 70 75 } 71 76 72 /** Compare two strings. */ 77 /** Compare two strings. 78 * 79 * @param a First string 80 * @param b Second string 81 * @return Zero if equal, nonzero if not equal 82 */ 73 83 int os_str_cmp(const char *a, const char *b) 74 84 { … … 76 86 } 77 87 78 /** Return number of characters in string. */ 88 /** Return number of characters in string. 89 * 90 * @param str String 91 * @return Number of characters in @a str. 92 */ 79 93 size_t os_str_length(const char *str) 80 94 { … … 82 96 } 83 97 84 /** Duplicate string. */ 98 /** Duplicate string. 99 * 100 * @param str String 101 * @return New string, duplicate of @a str. 102 */ 85 103 char *os_str_dup(const char *str) 86 104 { … … 88 106 } 89 107 90 /** Get character from string at the given index. */ 108 /** Get character from string at the given index. 109 * 110 * @param str String 111 * @param index Character index (starting from zero). 112 * @param out_char Place to store character. 113 * @return EOK on success, EINVAL if index is out of bounds, 114 * EIO on decoding error. 115 */ 91 116 int os_str_get_char(const char *str, int index, int *out_char) 92 117 { … … 117 142 } 118 143 119 /** Read one line of input from the user. */ 144 /** Read one line of input from the user. 145 * 146 * @param ptr Place to store pointer to new string. 147 */ 120 148 int os_input_line(char **ptr) 121 149 { … … 148 176 } 149 177 150 /** Simple command execution. */ 178 /** Simple command execution. 179 * 180 * @param cmd Command and arguments (NULL-terminated list of strings.) 181 * Command is present just one, not duplicated. 182 */ 151 183 int os_exec(char *const cmd[]) 152 184 { … … 168 200 } 169 201 170 /** Store the executable file path via which we were executed. */ 202 /** Store the executable file path via which we were executed. 203 * 204 * @param path Executable path via which we were executed. 205 */ 171 206 void os_store_ef_path(char *path) 172 207 { -
uspace/app/sbi/src/os/os.h
r80badbe r883fedc 37 37 void os_input_disp_help(void); 38 38 int os_input_line(char **ptr); 39 int os_exec(char * const cmd[]);39 int os_exec(char * const cmd[]); 40 40 41 41 void os_store_ef_path(char *path); -
uspace/app/sbi/src/os/posix.c
r80badbe r883fedc 47 47 * The string functions are in fact standard C, but would not work under 48 48 * HelenOS. 49 */ 50 51 /** Concatenate two strings. */ 49 * 50 * XXX String functions used here only work with 8-bit text encoding. 51 */ 52 53 /** Concatenate two strings. 54 * 55 * @param a First string 56 * @param b Second string 57 * @return New string, concatenation of @a a and @a b. 58 */ 52 59 char *os_str_acat(const char *a, const char *b) 53 60 { … … 71 78 } 72 79 73 /** Compare two strings. */ 80 /** Compare two strings. 81 * 82 * @param a First string 83 * @param b Second string 84 * @return Zero if equal, nonzero if not equal 85 */ 74 86 int os_str_cmp(const char *a, const char *b) 75 87 { … … 77 89 } 78 90 79 /** Return number of characters in string. */ 91 /** Return number of characters in string. 92 * 93 * @param str String 94 * @return Number of characters in @a str. 95 */ 80 96 size_t os_str_length(const char *str) 81 97 { … … 83 99 } 84 100 85 /** Duplicate string. */ 101 /** Duplicate string. 102 * 103 * @param str String 104 * @return New string, duplicate of @a str. 105 */ 86 106 char *os_str_dup(const char *str) 87 107 { … … 89 109 } 90 110 91 /** Get character from string at the given index. */ 111 /** Get character from string at the given index. 112 * 113 * @param str String 114 * @param index Character index (starting from zero). 115 * @param out_char Place to store character. 116 * @return EOK on success, EINVAL if index is out of bounds, 117 * EIO on decoding error. 118 */ 92 119 int os_str_get_char(const char *str, int index, int *out_char) 93 120 { … … 111 138 } 112 139 113 /** Read one line of input from the user. */ 140 /** Read one line of input from the user. 141 * 142 * @param ptr Place to store pointer to new string. 143 */ 114 144 int os_input_line(char **ptr) 115 145 { … … 126 156 } 127 157 128 /** Simple command execution. */ 158 /** Simple command execution. 159 * 160 * @param cmd Command and arguments (NULL-terminated list of strings.) 161 * Command is present just one, not duplicated. 162 */ 129 163 int os_exec(char *const cmd[]) 130 164 { … … 157 191 } 158 192 159 /** Store the executable file path via which we were executed. */ 193 /** Store the executable file path via which we were executed. 194 * 195 * @param path Executable path via which we were executed. 196 */ 160 197 void os_store_ef_path(char *path) 161 198 { -
uspace/app/sbi/src/parse.c
r80badbe r883fedc 54 54 static stree_csimbr_t *parse_csimbr(parse_t *parse, stree_csi_t *outer_csi); 55 55 56 static stree_deleg_t *parse_deleg(parse_t *parse, stree_csi_t *outer_csi); 56 57 static stree_fun_t *parse_fun(parse_t *parse, stree_csi_t *outer_csi); 57 58 static stree_var_t *parse_var(parse_t *parse, stree_csi_t *outer_csi); … … 62 63 static stree_proc_arg_t *parse_proc_arg(parse_t *parse); 63 64 static stree_arg_attr_t *parse_arg_attr(parse_t *parse); 65 static stree_fun_sig_t *parse_fun_sig(parse_t *parse); 66 64 67 65 68 /* … … 157 160 stree_symbol_t *symbol; 158 161 stree_ident_t *targ_name; 162 stree_targ_t *targ; 159 163 160 164 switch (dclass) { … … 170 174 csi->name = parse_ident(parse); 171 175 172 list_init(&csi->targ _names);176 list_init(&csi->targ); 173 177 174 178 while (lcur_lc(parse) == lc_slash) { 175 179 lskip(parse); 176 180 targ_name = parse_ident(parse); 177 list_append(&csi->targ_names, targ_name); 181 182 targ = stree_targ_new(); 183 targ->name = targ_name; 184 185 list_append(&csi->targ, targ); 178 186 } 179 187 … … 201 209 while (lcur_lc(parse) != lc_end && !parse_is_error(parse)) { 202 210 csimbr = parse_csimbr(parse, csi); 211 if (csimbr == NULL) 212 break; 213 203 214 list_append(&csi->members, csimbr); 204 215 } … … 213 224 * @param parse Parser object. 214 225 * @param outer_csi CSI containing this declaration or @c NULL if global. 215 * @return New syntax tree node. 226 * @return New syntax tree node. In case of parse error, 227 * @c NULL may (but need not) be returned. 216 228 */ 217 229 static stree_csimbr_t *parse_csimbr(parse_t *parse, stree_csi_t *outer_csi) … … 220 232 221 233 stree_csi_t *csi; 234 stree_deleg_t *deleg; 222 235 stree_fun_t *fun; 223 236 stree_var_t *var; … … 232 245 csimbr->u.csi = csi; 233 246 break; 247 case lc_deleg: 248 deleg = parse_deleg(parse, outer_csi); 249 csimbr = stree_csimbr_new(csimbr_deleg); 250 csimbr->u.deleg = deleg; 251 break; 234 252 case lc_fun: 235 253 fun = parse_fun(parse, outer_csi); … … 250 268 lunexpected_error(parse); 251 269 lex_next(parse->lex); 270 csimbr = NULL; 271 break; 252 272 } 253 273 … … 255 275 } 256 276 277 /** Parse delegate. 278 * 279 * @param parse Parser object. 280 * @param outer_csi CSI containing this declaration or @c NULL if global. 281 * @return New syntax tree node. 282 */ 283 static stree_deleg_t *parse_deleg(parse_t *parse, stree_csi_t *outer_csi) 284 { 285 stree_deleg_t *deleg; 286 stree_symbol_t *symbol; 287 stree_symbol_attr_t *attr; 288 289 deleg = stree_deleg_new(); 290 symbol = stree_symbol_new(sc_deleg); 291 292 symbol->u.deleg = deleg; 293 symbol->outer_csi = outer_csi; 294 deleg->symbol = symbol; 295 296 lmatch(parse, lc_deleg); 297 deleg->name = parse_ident(parse); 298 299 #ifdef DEBUG_PARSE_TRACE 300 printf("Parsing delegate '%s'.\n", strtab_get_str(deleg->name->sid)); 301 #endif 302 303 deleg->sig = parse_fun_sig(parse); 304 305 list_init(&symbol->attr); 306 307 /* Parse attributes. */ 308 while (lcur_lc(parse) == lc_comma && !parse_is_error(parse)) { 309 lskip(parse); 310 attr = parse_symbol_attr(parse); 311 list_append(&symbol->attr, attr); 312 } 313 314 lmatch(parse, lc_scolon); 315 316 return deleg; 317 } 257 318 258 319 /** Parse member function. … … 265 326 { 266 327 stree_fun_t *fun; 267 stree_proc_arg_t *arg;268 328 stree_symbol_t *symbol; 269 329 stree_symbol_attr_t *attr; … … 278 338 lmatch(parse, lc_fun); 279 339 fun->name = parse_ident(parse); 280 lmatch(parse, lc_lparen);281 340 282 341 #ifdef DEBUG_PARSE_TRACE 283 342 printf("Parsing function '%s'.\n", strtab_get_str(fun->name->sid)); 284 343 #endif 285 286 list_init(&fun->args); 287 288 if (lcur_lc(parse) != lc_rparen) { 289 290 /* Parse formal parameters. */ 291 while (!parse_is_error(parse)) { 292 arg = parse_proc_arg(parse); 293 294 if (stree_arg_has_attr(arg, aac_packed)) { 295 fun->varg = arg; 296 break; 297 } else { 298 list_append(&fun->args, arg); 299 } 300 301 if (lcur_lc(parse) == lc_rparen) 302 break; 303 304 lmatch(parse, lc_scolon); 305 } 306 } 307 308 lmatch(parse, lc_rparen); 309 310 if (lcur_lc(parse) == lc_colon) { 311 lskip(parse); 312 fun->rtype = parse_texpr(parse); 313 } else { 314 fun->rtype = NULL; 315 } 344 fun->sig = parse_fun_sig(parse); 316 345 317 346 list_init(&symbol->attr); … … 522 551 arg->type = parse_texpr(parse); 523 552 524 list_init(&arg->attr); 553 #ifdef DEBUG_PARSE_TRACE 554 printf("Parse procedure argument.\n"); 555 #endif 556 list_init(&arg->attr); 525 557 526 558 /* Parse attributes. */ … … 531 563 } 532 564 533 #ifdef DEBUG_PARSE_TRACE534 printf("Parsed arg attr, type=%p.\n", arg->type);535 #endif536 565 return arg; 537 566 } … … 557 586 attr = stree_arg_attr_new(aac_packed); 558 587 return attr; 588 } 589 590 /** Parse function signature. 591 * 592 * @param parse Parser object. 593 * @return New syntax tree node. 594 */ 595 static stree_fun_sig_t *parse_fun_sig(parse_t *parse) 596 { 597 stree_fun_sig_t *sig; 598 stree_proc_arg_t *arg; 599 600 sig = stree_fun_sig_new(); 601 602 lmatch(parse, lc_lparen); 603 604 #ifdef DEBUG_PARSE_TRACE 605 printf("Parsing function signature.\n"); 606 #endif 607 608 list_init(&sig->args); 609 610 if (lcur_lc(parse) != lc_rparen) { 611 612 /* Parse formal parameters. */ 613 while (!parse_is_error(parse)) { 614 arg = parse_proc_arg(parse); 615 616 if (stree_arg_has_attr(arg, aac_packed)) { 617 sig->varg = arg; 618 break; 619 } else { 620 list_append(&sig->args, arg); 621 } 622 623 if (lcur_lc(parse) == lc_rparen) 624 break; 625 626 lmatch(parse, lc_scolon); 627 } 628 } 629 630 lmatch(parse, lc_rparen); 631 632 if (lcur_lc(parse) == lc_colon) { 633 lskip(parse); 634 sig->rtype = parse_texpr(parse); 635 } else { 636 sig->rtype = NULL; 637 } 638 639 return sig; 559 640 } 560 641 -
uspace/app/sbi/src/rdata.c
r80badbe r883fedc 529 529 static void rdata_deleg_copy(rdata_deleg_t *src, rdata_deleg_t **dest) 530 530 { 531 (void) src; (void) dest;532 printf("Unimplemented: Copy delegate.\n");533 exit(1);531 *dest = rdata_deleg_new(); 532 (*dest)->obj = src->obj; 533 (*dest)->sym = src->sym; 534 534 } 535 535 … … 711 711 break; 712 712 case vc_ref: 713 printf("ref("); 714 rdata_var_print(var->u.ref_v->vref); 715 printf(")"); 713 if (var->u.ref_v->vref != NULL) { 714 printf("ref("); 715 rdata_var_print(var->u.ref_v->vref); 716 printf(")"); 717 } else { 718 printf("nil"); 719 } 716 720 break; 717 721 case vc_deleg: 718 722 printf("deleg("); 719 if (var->u.deleg_v->obj != NULL) { 720 rdata_var_print(var->u.deleg_v->obj); 721 printf(","); 723 if (var->u.deleg_v->sym != NULL) { 724 if (var->u.deleg_v->obj != NULL) { 725 rdata_var_print(var->u.deleg_v->obj); 726 printf(","); 727 } 728 symbol_print_fqn(var->u.deleg_v->sym); 729 } else { 730 printf("nil"); 722 731 } 723 symbol_print_fqn(var->u.deleg_v->sym);724 732 printf(")"); 725 733 break; -
uspace/app/sbi/src/rdata_t.h
r80badbe r883fedc 60 60 /** String variable */ 61 61 typedef struct { 62 c har *value;62 const char *value; 63 63 } rdata_string_t; 64 64 -
uspace/app/sbi/src/run.c
r80badbe r883fedc 67 67 rdata_value_t *value); 68 68 69 /** Initialize runner instance. */ 69 static void run_var_new_tprimitive(run_t *run, tdata_primitive_t *tprimitive, 70 rdata_var_t **rvar); 71 static void run_var_new_null_ref(run_t *run, rdata_var_t **rvar); 72 static void run_var_new_deleg(run_t *run, rdata_var_t **rvar); 73 74 75 /** Initialize runner instance. 76 * 77 * @param run Runner object 78 */ 70 79 void run_init(run_t *run) 71 80 { … … 73 82 } 74 83 75 /** Run program */ 84 /** Run program. 85 * 86 * Associates the program @a prog with the runner object and executes 87 * it. If a run-time error occurs during the execution (e.g. an unhandled 88 * exception), @a run->error will be set to @c b_true when this function 89 * returns. 90 * 91 * @param run Runner object 92 * @param prog Program to run 93 */ 76 94 void run_program(run_t *run, stree_program_t *prog) 77 95 { … … 119 137 } 120 138 121 /** Run procedure. */ 139 /** Run procedure. 140 * 141 * Inserts the provided procedure AR @a proc_ar on the execution stack 142 * (in the thread AR) and executes the procedure. The return value 143 * of the procedure is stored to *(@a res). @c NULL is stored if the 144 * procedure returns no value. 145 * 146 * If the procedure execution bails out due to an exception, this 147 * can be determined by looking at @c bo_mode in thread AR. Also, 148 * in this case @c NULL is stored into *(@a res). 149 * 150 * @param run Runner object 151 * @param proc_ar Procedure activation record 152 * @param res Place to store procedure return value 153 */ 122 154 void run_proc(run_t *run, run_proc_ar_t *proc_ar, rdata_item_t **res) 123 155 { … … 171 203 } 172 204 173 /** Run code block */ 205 /** Run code block. 206 * 207 * @param run Runner object 208 * @param block Block to run 209 */ 174 210 static void run_block(run_t *run, stree_block_t *block) 175 211 { … … 218 254 * @a res. 219 255 * 220 * @param run Runner object .221 * @param stat Statement to run .222 * @param res Place to store exps result or NULL if not interested .256 * @param run Runner object 257 * @param stat Statement to run 258 * @param res Place to store exps result or NULL if not interested 223 259 */ 224 260 void run_stat(run_t *run, stree_stat_t *stat, rdata_item_t **res) … … 266 302 * of the expression (or NULL if it has no value) will be stored to @a res. 267 303 * 268 * @param run Runner object .269 * @param exps Expression statement to run .270 * @param res Place to store exps result or NULL if not interested .304 * @param run Runner object 305 * @param exps Expression statement to run 306 * @param res Place to store exps result or NULL if not interested 271 307 */ 272 308 static void run_exps(run_t *run, stree_exps_t *exps, rdata_item_t **res) … … 283 319 } 284 320 285 /** Run variable declaration statement. */ 321 /** Run variable declaration statement. 322 * 323 * @param run Runner object 324 * @param vdecl Variable declaration statement to run 325 */ 286 326 static void run_vdecl(run_t *run, stree_vdecl_t *vdecl) 287 327 { 288 328 run_block_ar_t *block_ar; 289 329 rdata_var_t *var, *old_var; 290 rdata_int_t *int_v;330 tdata_item_t *var_ti; 291 331 292 332 #ifdef DEBUG_RUN_TRACE 293 333 printf("Executing variable declaration statement.\n"); 294 334 #endif 295 296 /* XXX Need to support other variables than int. */ 297 298 var = rdata_var_new(vc_int); 299 int_v = rdata_int_new(); 300 301 var->u.int_v = int_v; 302 bigint_init(&int_v->value, 0); 335 /* Compute variable type. XXX Memoize. */ 336 run_texpr(run->program, run_get_current_csi(run), vdecl->type, 337 &var_ti); 338 339 /* Create variable and initialize with default value. */ 340 run_var_new(run, var_ti, &var); 303 341 304 342 block_ar = run_get_current_block_ar(run); … … 318 356 } 319 357 320 /** Run @c if statement. */ 358 /** Run @c if statement. 359 * 360 * @param run Runner object 361 * @param if_s If statement to run 362 */ 321 363 static void run_if(run_t *run, stree_if_t *if_s) 322 364 { … … 348 390 } 349 391 350 /** Run @c while statement. */ 392 /** Run @c while statement. 393 * 394 * @param run Runner object 395 * @param while_s While statement to run 396 */ 351 397 static void run_while(run_t *run, stree_while_t *while_s) 352 398 { … … 375 421 } 376 422 377 /** Run @c raise statement. */ 423 /** Run @c raise statement. 424 * 425 * @param run Runner object 426 * @param raise_s Raise statement to run 427 */ 378 428 static void run_raise(run_t *run, stree_raise_t *raise_s) 379 429 { … … 397 447 } 398 448 399 /** Run @c return statement. */ 449 /** Run @c return statement. 450 * 451 * Sets the return value in procedure AR and forces control to return 452 * from the function by setting bailout mode to @c bm_proc. 453 * 454 * @param run Runner object 455 * @param raise_s Return statement to run 456 */ 400 457 static void run_return(run_t *run, stree_return_t *return_s) 401 458 { … … 413 470 run_cvt_value_item(run, rexpr, &rexpr_vi); 414 471 415 /* Store expression result in functionAR. */472 /* Store expression result in procedure AR. */ 416 473 proc_ar = run_get_current_proc_ar(run); 417 474 proc_ar->retval = rexpr_vi; … … 422 479 } 423 480 424 /** Run @c with-except-finally statement. */ 481 /** Run @c with-except-finally statement. 482 * 483 * Note: 'With' clause is not implemented. 484 * 485 * @param run Runner object 486 * @param wef_s With-except-finally statement to run 487 */ 425 488 static void run_wef(run_t *run, stree_wef_t *wef_s) 426 489 { … … 489 552 * matches except clause @c except_c. 490 553 * 491 * @param run Runner object .492 * @param except_c @c except clause .493 * @return @c b_true if there is a match, @c b_false otherwise .554 * @param run Runner object 555 * @param except_c @c except clause 556 * @return @c b_true if there is a match, @c b_false otherwise 494 557 */ 495 558 static bool_t run_exc_match(run_t *run, stree_except_t *except_c) … … 506 569 507 570 /* Determine if active exc. is derived from type in exc. clause. */ 571 /* XXX This is wrong, it does not work with generics. */ 508 572 return tdata_is_csi_derived_from_ti(exc_csi, etype); 509 573 } … … 511 575 /** Return CSI of the active exception. 512 576 * 513 * @param run Runner object .514 * @return CSI of the active exception .577 * @param run Runner object 578 * @return CSI of the active exception 515 579 */ 516 580 static stree_csi_t *run_exc_payload_get_csi(run_t *run) … … 557 621 * error message and raises a run-time error. 558 622 * 559 * @param run Runner object .623 * @param run Runner object 560 624 */ 561 625 void run_exc_check_unhandled(run_t *run) … … 579 643 * 580 644 * Raises an error that cannot be handled by the user program. 645 * 646 * @param run Runner object 581 647 */ 582 648 void run_raise_error(run_t *run) … … 586 652 } 587 653 588 /** Construct a special recovery item. */ 654 /** Construct a special recovery item. 655 * 656 * @param run Runner object 657 */ 589 658 rdata_item_t *run_recovery_item(run_t *run) 590 659 { … … 593 662 } 594 663 595 /** Find a local variable in the currently active function. */ 664 /** Find a local variable in the currently active function. 665 * 666 * @param run Runner object 667 * @param name Name SID of the local variable 668 * @return Pointer to var node or @c NULL if not found 669 */ 596 670 rdata_var_t *run_local_vars_lookup(run_t *run, sid_t name) 597 671 { … … 618 692 } 619 693 620 /** Get current function activation record. */ 694 /** Get current procedure activation record. 695 * 696 * @param run Runner object 697 * @return Active procedure AR 698 */ 621 699 run_proc_ar_t *run_get_current_proc_ar(run_t *run) 622 700 { … … 627 705 } 628 706 629 /** Get current block activation record. */ 707 /** Get current block activation record. 708 * 709 * @param run Runner object 710 * @return Active block AR 711 */ 630 712 run_block_ar_t *run_get_current_block_ar(run_t *run) 631 713 { … … 639 721 } 640 722 641 /** Get current CSI. */ 723 /** Get current CSI. 724 * 725 * @param run Runner object 726 * @return Active CSI 727 */ 642 728 stree_csi_t *run_get_current_csi(run_t *run) 643 729 { … … 654 740 * (1) Create a variable of the desired type. 655 741 * (2) Initialize the variable with the provided value. 742 * 743 * @param item Value item (initial value for variable). 744 * @param var Place to store new var node. 656 745 */ 657 746 void run_value_item_to_var(rdata_item_t *item, rdata_var_t **var) 658 747 { 748 rdata_bool_t *bool_v; 659 749 rdata_char_t *char_v; 750 rdata_deleg_t *deleg_v; 660 751 rdata_int_t *int_v; 661 752 rdata_string_t *string_v; … … 667 758 668 759 switch (in_var->vc) { 760 case vc_bool: 761 *var = rdata_var_new(vc_bool); 762 bool_v = rdata_bool_new(); 763 764 (*var)->u.bool_v = bool_v; 765 bool_v->value = item->u.value->var->u.bool_v->value; 766 break; 669 767 case vc_char: 670 768 *var = rdata_var_new(vc_char); … … 675 773 &char_v->value); 676 774 break; 775 case vc_deleg: 776 *var = rdata_var_new(vc_deleg); 777 deleg_v = rdata_deleg_new(); 778 779 (*var)->u.deleg_v = deleg_v; 780 deleg_v->obj = item->u.value->var->u.deleg_v->obj; 781 deleg_v->sym = item->u.value->var->u.deleg_v->sym; 782 break; 677 783 case vc_int: 678 784 *var = rdata_var_new(vc_int); … … 704 810 } 705 811 706 /** Construct a function AR. */ 812 /** Construct a procedure AR. 813 * 814 * @param run Runner object 815 * @param obj Object whose procedure is being activated 816 * @param proc Procedure that is being activated 817 * @param rproc_ar Place to store pointer to new activation record 818 */ 707 819 void run_proc_ar_create(run_t *run, rdata_var_t *obj, stree_proc_t *proc, 708 820 run_proc_ar_t **rproc_ar) … … 733 845 * When invoking a procedure this is used to store the argument values 734 846 * in the activation record. 847 * 848 * @param run Runner object 849 * @param proc_ar Existing procedure activation record where to store 850 * the values 851 * @param arg_vals List of value items (rdata_item_t *) -- real 852 * argument values 735 853 */ 736 854 void run_proc_ar_set_args(run_t *run, run_proc_ar_t *proc_ar, list_t *arg_vals) … … 767 885 case sc_fun: 768 886 fun = symbol_to_fun(outer_symbol); 769 args = &fun-> args;770 varg = fun-> varg;887 args = &fun->sig->args; 888 varg = fun->sig->varg; 771 889 break; 772 890 case sc_prop: … … 865 983 * When invoking a setter this is used to store its argument value in its 866 984 * procedure activation record. 985 * 986 * @param run Runner object 987 * @param proc_ar Existing procedure activation record where to store 988 * the setter argument 989 * @param arg_val Value items (rdata_item_t *) -- real argument value 867 990 */ 868 991 void run_proc_ar_set_setter_arg(run_t *run, run_proc_ar_t *proc_ar, … … 898 1021 } 899 1022 900 /** Print function activation backtrace. */ 1023 /** Print function activation backtrace. 1024 * 1025 * Prints a backtrace of activated functions for debugging purposes. 1026 * 1027 * @param run Runner object 1028 */ 901 1029 void run_print_fun_bt(run_t *run) 902 1030 { … … 920 1048 * If @a item is a value, we just return a copy. If @a item is an address, 921 1049 * we read from the address. 1050 * 1051 * @param run Runner object 1052 * @param item Input item (value or address) 1053 * @param ritem Place to store pointer to new value item 922 1054 */ 923 1055 void run_cvt_value_item(run_t *run, rdata_item_t *item, rdata_item_t **ritem) … … 951 1083 * Get var-class of @a item, regardless whether it is a value or address. 952 1084 * (I.e. the var class of the value or variable at the given address). 1085 * 1086 * @param run Runner object 1087 * @param item Value or address item 1088 * @return Varclass of @a item 953 1089 */ 954 1090 var_class_t run_item_get_vc(run_t *run, rdata_item_t *item) … … 992 1128 * copy. 993 1129 * 994 * @param run Runner object .995 * @param addr Address of class @c ac_prop .996 * @ param Pointer to var node.1130 * @param run Runner object 1131 * @param addr Address of class @c ac_prop 1132 * @return Pointer to var node 997 1133 */ 998 1134 static rdata_var_t *run_aprop_get_tpos(run_t *run, rdata_address_t *addr) … … 1015 1151 /** Read data from an address. 1016 1152 * 1017 * Return value stored in a variable at the specified address. 1153 * Read value from the specified address. 1154 * 1155 * @param run Runner object 1156 * @param address Address to read 1157 * @param ritem Place to store pointer to the value that was read 1018 1158 */ 1019 1159 void run_address_read(run_t *run, rdata_address_t *address, … … 1036 1176 /** Write data to an address. 1037 1177 * 1038 * Store @a value to the variable at @a address. 1178 * Store value @a value at address @a address. 1179 * 1180 * @param run Runner object 1181 * @param address Address to write 1182 * @param value Value to store at the address 1039 1183 */ 1040 1184 void run_address_write(run_t *run, rdata_address_t *address, … … 1053 1197 } 1054 1198 1199 /** Read data from a property address. 1200 * 1201 * This involves invoking the property getter procedure. 1202 * 1203 * @param run Runner object. 1204 * @param addr_prop Property address to read. 1205 * @param ritem Place to store pointer to the value that was read. 1206 */ 1055 1207 static void run_aprop_read(run_t *run, rdata_addr_prop_t *addr_prop, 1056 1208 rdata_item_t **ritem) … … 1116 1268 } 1117 1269 1270 /** Write data to a property address. 1271 * 1272 * This involves invoking the property setter procedure. 1273 * 1274 * @param run Runner object 1275 * @param addr_prop Property address to write 1276 * @param value Value to store at the address 1277 */ 1118 1278 static void run_aprop_write(run_t *run, rdata_addr_prop_t *addr_prop, 1119 1279 rdata_value_t *value) … … 1181 1341 * 1182 1342 * Constructs a reference (value item) pointing to @a var. 1343 * 1344 * @param run Runner object 1345 * @param var Variable node that is being referenced 1346 * @param res Place to store pointer to new reference. 1183 1347 */ 1184 1348 void run_reference(run_t *run, rdata_var_t *var, rdata_item_t **res) … … 1210 1374 * Takes a reference (address or value) and returns the address (item) of 1211 1375 * the target of the reference. 1376 * 1377 * @param run Runner object 1378 * @param ref Reference 1379 * @param rtitem Place to store pointer to the resulting address. 1212 1380 */ 1213 1381 void run_dereference(run_t *run, rdata_item_t *ref, rdata_item_t **ritem) … … 1252 1420 * error (not for the @c raise statement). 1253 1421 * 1254 * @param run Runner object .1255 * @param csi Exception class .1422 * @param run Runner object 1423 * @param csi Exception class 1256 1424 */ 1257 1425 void run_raise_exc(run_t *run, stree_csi_t *csi) … … 1270 1438 } 1271 1439 1272 /** Determine if we are bailing out. */ 1440 /** Determine if we are bailing out. 1441 * 1442 * @param run Runner object 1443 * @return @c b_true if we are bailing out, @c b_false otherwise 1444 */ 1273 1445 bool_t run_is_bo(run_t *run) 1274 1446 { … … 1276 1448 } 1277 1449 1450 /** Construct a new variable of the given type. 1451 * 1452 * The variable is allocated and initialized with a default value 1453 * based on type item @a ti. For reference types the default value 1454 * is a null reference. At this point this does not work for generic 1455 * types (we need RTTI). 1456 * 1457 * @param run Runner object 1458 * @param ti Type of variable to create (type item) 1459 * @param rvar Place to store pointer to new variable 1460 */ 1461 void run_var_new(run_t *run, tdata_item_t *ti, rdata_var_t **rvar) 1462 { 1463 rdata_var_t *var; 1464 1465 switch (ti->tic) { 1466 case tic_tprimitive: 1467 run_var_new_tprimitive(run, ti->u.tprimitive, rvar); 1468 break; 1469 case tic_tobject: 1470 case tic_tarray: 1471 run_var_new_null_ref(run, rvar); 1472 break; 1473 case tic_tdeleg: 1474 case tic_tfun: 1475 run_var_new_deleg(run, rvar); 1476 break; 1477 case tic_tvref: 1478 /* 1479 * XXX Need to obtain run-time value of type argument to 1480 * initialize variable properly. 1481 */ 1482 var = rdata_var_new(vc_int); 1483 var->u.int_v = rdata_int_new(); 1484 bigint_init(&var->u.int_v->value, 0); 1485 *rvar = var; 1486 break; 1487 case tic_ignore: 1488 assert(b_false); 1489 } 1490 } 1491 1492 /** Construct a new variable of primitive type. 1493 * 1494 * The variable is allocated and initialized with a default value 1495 * based on primitive type item @a tprimitive. 1496 * 1497 * @param run Runner object 1498 * @param ti Primitive type of variable to create 1499 * @param rvar Place to store pointer to new variable 1500 */ 1501 static void run_var_new_tprimitive(run_t *run, tdata_primitive_t *tprimitive, 1502 rdata_var_t **rvar) 1503 { 1504 rdata_var_t *var; 1505 1506 (void) run; 1507 1508 /* Make compiler happy. */ 1509 var = NULL; 1510 1511 switch (tprimitive->tpc) { 1512 case tpc_bool: 1513 var = rdata_var_new(vc_bool); 1514 var->u.bool_v = rdata_bool_new(); 1515 var->u.bool_v->value = b_false; 1516 break; 1517 case tpc_char: 1518 var = rdata_var_new(vc_char); 1519 var->u.char_v = rdata_char_new(); 1520 bigint_init(&var->u.char_v->value, 0); 1521 break; 1522 case tpc_int: 1523 var = rdata_var_new(vc_int); 1524 var->u.int_v = rdata_int_new(); 1525 bigint_init(&var->u.int_v->value, 0); 1526 break; 1527 case tpc_nil: 1528 assert(b_false); 1529 case tpc_string: 1530 var = rdata_var_new(vc_string); 1531 var->u.string_v = rdata_string_new(); 1532 var->u.string_v->value = ""; 1533 break; 1534 case tpc_resource: 1535 var = rdata_var_new(vc_resource); 1536 var->u.resource_v = rdata_resource_new(); 1537 var->u.resource_v->data = NULL; 1538 break; 1539 } 1540 1541 *rvar = var; 1542 } 1543 1544 /** Construct a new variable containing null reference. 1545 * 1546 * @param run Runner object 1547 * @param rvar Place to store pointer to new variable 1548 */ 1549 static void run_var_new_null_ref(run_t *run, rdata_var_t **rvar) 1550 { 1551 rdata_var_t *var; 1552 1553 (void) run; 1554 1555 /* Return null reference. */ 1556 var = rdata_var_new(vc_ref); 1557 var->u.ref_v = rdata_ref_new(); 1558 1559 *rvar = var; 1560 } 1561 1562 /** Construct a new variable containing invalid delegate. 1563 * 1564 * @param run Runner object 1565 * @param rvar Place to store pointer to new variable 1566 */ 1567 static void run_var_new_deleg(run_t *run, rdata_var_t **rvar) 1568 { 1569 rdata_var_t *var; 1570 1571 (void) run; 1572 1573 /* Return null reference. */ 1574 var = rdata_var_new(vc_deleg); 1575 var->u.deleg_v = rdata_deleg_new(); 1576 1577 *rvar = var; 1578 } 1579 1580 /** Construct a new thread activation record. 1581 * 1582 * @param run Runner object 1583 * @return New thread AR. 1584 */ 1278 1585 run_thread_ar_t *run_thread_ar_new(void) 1279 1586 { … … 1289 1596 } 1290 1597 1598 /** Construct a new procedure activation record. 1599 * 1600 * @param run Runner object 1601 * @return New procedure AR. 1602 */ 1291 1603 run_proc_ar_t *run_proc_ar_new(void) 1292 1604 { … … 1302 1614 } 1303 1615 1616 /** Construct a new block activation record. 1617 * 1618 * @param run Runner object 1619 * @return New block AR. 1620 */ 1304 1621 run_block_ar_t *run_block_ar_new(void) 1305 1622 { -
uspace/app/sbi/src/run.h
r80badbe r883fedc 68 68 bool_t run_is_bo(run_t *run); 69 69 70 void run_var_new(run_t *run, tdata_item_t *ti, rdata_var_t **rvar); 71 70 72 run_thread_ar_t *run_thread_ar_new(void); 71 73 run_proc_ar_t *run_proc_ar_new(void); -
uspace/app/sbi/src/run_expr.c
r80badbe r883fedc 27 27 */ 28 28 29 /** @file Run ner (executes the code). */29 /** @file Run expressions. */ 30 30 31 31 #include <stdio.h> … … 109 109 static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res); 110 110 static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res); 111 112 /** Evaluate expression. */ 111 static void run_box(run_t *run, stree_box_t *box, rdata_item_t **res); 112 113 /** Evaluate expression. 114 * 115 * Run the expression @a expr and store pointer to the result in *(@a res). 116 * If the expression has on value (assignment) then @c NULL is returned. 117 * @c NULL is also returned if an error or exception occurs. 118 * 119 * @param run Runner object 120 * @param expr Expression to run 121 * @param res Place to store result 122 */ 113 123 void run_expr(run_t *run, stree_expr_t *expr, rdata_item_t **res) 114 124 { … … 151 161 run_as(run, expr->u.as_op, res); 152 162 break; 163 case ec_box: 164 run_box(run, expr->u.box, res); 165 break; 153 166 } 154 167 … … 160 173 } 161 174 162 /** Evaluate name reference expression. */ 175 /** Evaluate name reference expression. 176 * 177 * @param run Runner object 178 * @param nameref Name reference 179 * @param res Place to store result 180 */ 163 181 static void run_nameref(run_t *run, stree_nameref_t *nameref, 164 182 rdata_item_t **res) … … 247 265 assert(csi != NULL); 248 266 249 if (sym->outer_csi != csi) { 267 if (symbol_search_csi(run->program, csi, nameref->name) 268 == NULL) { 250 269 /* Function is not in the current object. */ 251 270 printf("Error: Cannot access non-static member " … … 283 302 assert(obj != NULL); 284 303 285 if (sym->outer_csi != csi) { 304 if (symbol_search_csi(run->program, csi, nameref->name) 305 == NULL) { 286 306 /* Variable is not in the current object. */ 287 307 printf("Error: Cannot access non-static member " … … 316 336 } 317 337 318 /** Evaluate literal. */ 338 /** Evaluate literal. 339 * 340 * @param run Runner object 341 * @param literal Literal 342 * @param res Place to store result 343 */ 319 344 static void run_literal(run_t *run, stree_literal_t *literal, 320 345 rdata_item_t **res) … … 342 367 } 343 368 344 /** Evaluate Boolean literal. */ 369 /** Evaluate Boolean literal. 370 * 371 * @param run Runner object 372 * @param lit_bool Boolean literal 373 * @param res Place to store result 374 */ 345 375 static void run_lit_bool(run_t *run, stree_lit_bool_t *lit_bool, 346 376 rdata_item_t **res) … … 396 426 } 397 427 398 /** Evaluate integer literal. */ 428 /** Evaluate integer literal. 429 * 430 * @param run Runner object 431 * @param lit_int Integer literal 432 * @param res Place to store result 433 */ 399 434 static void run_lit_int(run_t *run, stree_lit_int_t *lit_int, 400 435 rdata_item_t **res) … … 423 458 } 424 459 425 /** Evaluate reference literal (@c nil). */ 460 /** Evaluate reference literal (@c nil). 461 * 462 * @param run Runner object 463 * @param lit_ref Reference literal 464 * @param res Place to store result 465 */ 426 466 static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref, 427 467 rdata_item_t **res) … … 451 491 } 452 492 453 /** Evaluate string literal. */ 493 /** Evaluate string literal. 494 * 495 * @param run Runner object 496 * @param lit_string String literal 497 * @param res Place to store result 498 */ 454 499 static void run_lit_string(run_t *run, stree_lit_string_t *lit_string, 455 500 rdata_item_t **res) … … 478 523 } 479 524 480 /** Evaluate @c self reference. */ 525 /** Evaluate @c self reference. 526 * 527 * @param run Runner object 528 * @param self_ref Self reference 529 * @param res Place to store result 530 */ 481 531 static void run_self_ref(run_t *run, stree_self_ref_t *self_ref, 482 532 rdata_item_t **res) … … 494 544 } 495 545 496 /** Evaluate binary operation. */ 546 /** Evaluate binary operation. 547 * 548 * @param run Runner object 549 * @param binop Binary operation 550 * @param res Place to store result 551 */ 497 552 static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res) 498 553 { … … 574 629 } 575 630 576 /** Evaluate binary operation on bool arguments. */ 631 /** Evaluate binary operation on bool arguments. 632 * 633 * @param run Runner object 634 * @param binop Binary operation 635 * @param v1 Value of first argument 636 * @param v2 Value of second argument 637 * @param res Place to store result 638 */ 577 639 static void run_binop_bool(run_t *run, stree_binop_t *binop, rdata_value_t *v1, 578 640 rdata_value_t *v2, rdata_item_t **res) … … 628 690 } 629 691 630 /** Evaluate binary operation on char arguments. */ 692 /** Evaluate binary operation on char arguments. 693 * 694 * @param run Runner object 695 * @param binop Binary operation 696 * @param v1 Value of first argument 697 * @param v2 Value of second argument 698 * @param res Place to store result 699 */ 631 700 static void run_binop_char(run_t *run, stree_binop_t *binop, rdata_value_t *v1, 632 701 rdata_value_t *v2, rdata_item_t **res) … … 691 760 } 692 761 693 /** Evaluate binary operation on int arguments. */ 762 /** Evaluate binary operation on int arguments. 763 * 764 * @param run Runner object 765 * @param binop Binary operation 766 * @param v1 Value of first argument 767 * @param v2 Value of second argument 768 * @param res Place to store result 769 */ 694 770 static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1, 695 771 rdata_value_t *v2, rdata_item_t **res) … … 781 857 } 782 858 783 /** Evaluate binary operation on string arguments. */ 859 /** Evaluate binary operation on string arguments. 860 * 861 * @param run Runner object 862 * @param binop Binary operation 863 * @param v1 Value of first argument 864 * @param v2 Value of second argument 865 * @param res Place to store result 866 */ 784 867 static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1, 785 868 rdata_value_t *v2, rdata_item_t **res) … … 790 873 rdata_string_t *string_v; 791 874 792 c har *s1, *s2;875 const char *s1, *s2; 793 876 794 877 (void) run; … … 820 903 } 821 904 822 /** Evaluate binary operation on ref arguments. */ 905 /** Evaluate binary operation on ref arguments. 906 * 907 * @param run Runner object 908 * @param binop Binary operation 909 * @param v1 Value of first argument 910 * @param v2 Value of second argument 911 * @param res Place to store result 912 */ 823 913 static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1, 824 914 rdata_value_t *v2, rdata_item_t **res) … … 862 952 863 953 864 /** Evaluate unary operation. */ 954 /** Evaluate unary operation. 955 * 956 * @param run Runner object 957 * @param unop Unary operation 958 * @param res Place to store result 959 */ 865 960 static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res) 866 961 { … … 898 993 } 899 994 900 /** Evaluate unary operation on int argument. */ 995 /** Evaluate unary operation on int argument. 996 * 997 * @param run Runner object 998 * @param unop Unary operation 999 * @param val Value of argument 1000 * @param res Place to store result 1001 */ 901 1002 static void run_unop_int(run_t *run, stree_unop_t *unop, rdata_value_t *val, 902 1003 rdata_item_t **res) … … 932 1033 933 1034 934 /** Evaluate @c new operation. */ 1035 /** Evaluate @c new operation. 1036 * 1037 * Evaluates operation per the @c new operator that creates a new 1038 * instance of some type. 1039 * 1040 * @param run Runner object 1041 * @param unop Unary operation 1042 * @param res Place to store result 1043 */ 935 1044 static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res) 936 1045 { … … 958 1067 } 959 1068 960 /** Create new array. */ 1069 /** Create new array. 1070 * 1071 * @param run Runner object 1072 * @param new_op New operation 1073 * @param titem Type of new var node (tic_tarray) 1074 * @param res Place to store result 1075 */ 961 1076 static void run_new_array(run_t *run, stree_new_t *new_op, 962 1077 tdata_item_t *titem, rdata_item_t **res) … … 1046 1161 /* Create member variables */ 1047 1162 for (i = 0; i < length; ++i) { 1048 /* XXX Depends on member variable type. */ 1049 elem_var = rdata_var_new(vc_int); 1050 elem_var->u.int_v = rdata_int_new(); 1051 bigint_init(&elem_var->u.int_v->value, 0); 1163 /* Create and initialize element. */ 1164 run_var_new(run, tarray->base_ti, &elem_var); 1052 1165 1053 1166 array->element[i] = elem_var; … … 1062 1175 } 1063 1176 1064 /** Create new object. */ 1177 /** Create new object. 1178 * 1179 * @param run Runner object 1180 * @param new_op New operation 1181 * @param titem Type of new var node (tic_tobject) 1182 * @param res Place to store result 1183 */ 1065 1184 static void run_new_object(run_t *run, stree_new_t *new_op, 1066 1185 tdata_item_t *titem, rdata_item_t **res) … … 1081 1200 } 1082 1201 1083 /** Evaluate member acccess. */ 1202 /** Evaluate member acccess. 1203 * 1204 * Evaluate operation per the member access ('.') operator. 1205 * 1206 * @param run Runner object 1207 * @param access Access operation 1208 * @param res Place to store result 1209 */ 1084 1210 static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res) 1085 1211 { … … 1103 1229 } 1104 1230 1105 /** Evaluate member acccess (with base already evaluated). */ 1231 /** Evaluate member acccess (with base already evaluated). 1232 * 1233 * @param run Runner object 1234 * @param access Access operation 1235 * @param arg Evaluated base expression 1236 * @param res Place to store result 1237 */ 1106 1238 static void run_access_item(run_t *run, stree_access_t *access, 1107 1239 rdata_item_t *arg, rdata_item_t **res) … … 1131 1263 } 1132 1264 1133 /** Evaluate reference acccess. */ 1265 /** Evaluate reference acccess. 1266 * 1267 * @param run Runner object 1268 * @param access Access operation 1269 * @param arg Evaluated base expression 1270 * @param res Place to store result 1271 */ 1134 1272 static void run_access_ref(run_t *run, stree_access_t *access, 1135 1273 rdata_item_t *arg, rdata_item_t **res) … … 1149 1287 } 1150 1288 1151 /** Evaluate delegate-member acccess. */ 1289 /** Evaluate delegate-member acccess. 1290 * 1291 * @param run Runner object 1292 * @param access Access operation 1293 * @param arg Evaluated base expression 1294 * @param res Place to store result 1295 */ 1152 1296 static void run_access_deleg(run_t *run, stree_access_t *access, 1153 1297 rdata_item_t *arg, rdata_item_t **res) … … 1192 1336 } 1193 1337 1194 /** Evaluate object member acccess. */ 1338 /** Evaluate object member acccess. 1339 * 1340 * @param run Runner object 1341 * @param access Access operation 1342 * @param arg Evaluated base expression 1343 * @param res Place to store result 1344 */ 1195 1345 static void run_access_object(run_t *run, stree_access_t *access, 1196 1346 rdata_item_t *arg, rdata_item_t **res) … … 1236 1386 #endif 1237 1387 1388 /* Make compiler happy. */ 1389 ritem = NULL; 1390 1238 1391 switch (member->sc) { 1239 1392 case sc_csi: 1240 1393 printf("Error: Accessing object member which is nested CSI.\n"); 1241 1394 exit(1); 1395 case sc_deleg: 1396 printf("Error: Accessing object member which is a delegate.\n"); 1397 exit(1); 1242 1398 case sc_fun: 1243 /* Construct delegate. */1399 /* Construct anonymous delegate. */ 1244 1400 ritem = rdata_item_new(ic_value); 1245 1401 value = rdata_value_new(); … … 1281 1437 addr_prop->u.named->prop_d = deleg_p; 1282 1438 break; 1283 default:1284 ritem = NULL;1285 1439 } 1286 1440 … … 1288 1442 } 1289 1443 1290 /** Call a function. */ 1444 /** Call a function. 1445 * 1446 * Call a function and return the result in @a res. 1447 * 1448 * @param run Runner object 1449 * @param call Call operation 1450 * @param res Place to store result 1451 */ 1291 1452 static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res) 1292 1453 { 1293 rdata_item_t *r fun;1454 rdata_item_t *rdeleg, *rdeleg_vi; 1294 1455 rdata_deleg_t *deleg_v; 1295 1456 list_t arg_vals; … … 1304 1465 printf("Run call operation.\n"); 1305 1466 #endif 1306 run_expr(run, call->fun, &r fun);1467 run_expr(run, call->fun, &rdeleg); 1307 1468 if (run_is_bo(run)) { 1308 1469 *res = NULL; … … 1315 1476 } 1316 1477 1317 if (rfun->ic != ic_value || rfun->u.value->var->vc != vc_deleg) { 1318 printf("Unimplemented: Call expression of this type.\n"); 1478 run_cvt_value_item(run, rdeleg, &rdeleg_vi); 1479 assert(rdeleg_vi->ic == ic_value); 1480 1481 if (rdeleg_vi->u.value->var->vc != vc_deleg) { 1482 printf("Unimplemented: Call expression of this type ("); 1483 rdata_item_print(rdeleg_vi); 1484 printf(").\n"); 1319 1485 exit(1); 1320 1486 } 1321 1487 1322 deleg_v = r fun->u.value->var->u.deleg_v;1488 deleg_v = rdeleg_vi->u.value->var->u.deleg_v; 1323 1489 1324 1490 if (deleg_v->sym->sc != sc_fun) { … … 1367 1533 } 1368 1534 1369 /** Run index operation. */ 1535 /** Run index operation. 1536 * 1537 * Evaluate operation per the indexing ('[', ']') operator. 1538 * 1539 * @param run Runner object 1540 * @param index Index operation 1541 * @param res Place to store result 1542 */ 1370 1543 static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res) 1371 1544 { … … 1433 1606 } 1434 1607 1435 /** Run index operation on array. */ 1608 /** Run index operation on array. 1609 * 1610 * @param run Runner object 1611 * @param index Index operation 1612 * @param base Evaluated base expression 1613 * @param args Evaluated indices (list of rdata_item_t) 1614 * @param res Place to store result 1615 */ 1436 1616 static void run_index_array(run_t *run, stree_index_t *index, 1437 1617 rdata_item_t *base, list_t *args, rdata_item_t **res) … … 1525 1705 } 1526 1706 1527 /** Index an object (via its indexer). */ 1707 /** Index an object (via its indexer). 1708 * 1709 * @param run Runner object 1710 * @param index Index operation 1711 * @param base Evaluated base expression 1712 * @param args Evaluated indices (list of rdata_item_t) 1713 * @param res Place to store result 1714 */ 1528 1715 static void run_index_object(run_t *run, stree_index_t *index, 1529 1716 rdata_item_t *base, list_t *args, rdata_item_t **res) … … 1597 1784 } 1598 1785 1599 /** Run index operation on string. */ 1786 /** Run index operation on string. 1787 * 1788 * @param run Runner object 1789 * @param index Index operation 1790 * @param base Evaluated base expression 1791 * @param args Evaluated indices (list of rdata_item_t) 1792 * @param res Place to store result 1793 */ 1600 1794 static void run_index_string(run_t *run, stree_index_t *index, 1601 1795 rdata_item_t *base, list_t *args, rdata_item_t **res) … … 1690 1884 } 1691 1885 1692 /** Execute assignment. */ 1886 /** Run assignment. 1887 * 1888 * Executes an assignment. @c NULL is always stored to @a res because 1889 * an assignment does not have a value. 1890 * 1891 * @param run Runner object 1892 * @param assign Assignment expression 1893 * @param res Place to store result 1894 */ 1693 1895 static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res) 1694 1896 { … … 1727 1929 } 1728 1930 1729 /** Execute @c as conversion. */ 1931 /** Execute @c as conversion. 1932 * 1933 * @param run Runner object 1934 * @param as_op @c as conversion expression 1935 * @param res Place to store result 1936 */ 1730 1937 static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res) 1731 1938 { … … 1794 2001 } 1795 2002 1796 /** Create new CSI instance. */ 2003 /** Execute boxing operation. 2004 * 2005 * XXX We can scrap this special operation once we have constructors. 2006 * 2007 * @param run Runner object 2008 * @param box Boxing operation 2009 * @param res Place to store result 2010 */ 2011 static void run_box(run_t *run, stree_box_t *box, rdata_item_t **res) 2012 { 2013 rdata_item_t *rarg_i; 2014 rdata_item_t *rarg_vi; 2015 2016 stree_symbol_t *csi_sym; 2017 stree_csi_t *csi; 2018 builtin_t *bi; 2019 rdata_var_t *var; 2020 rdata_object_t *object; 2021 2022 sid_t mbr_name_sid; 2023 rdata_var_t *mbr_var; 2024 2025 #ifdef DEBUG_RUN_TRACE 2026 printf("Run boxing operation.\n"); 2027 #endif 2028 run_expr(run, box->arg, &rarg_i); 2029 if (run_is_bo(run)) { 2030 *res = NULL; 2031 return; 2032 } 2033 2034 run_cvt_value_item(run, rarg_i, &rarg_vi); 2035 assert(rarg_vi->ic == ic_value); 2036 2037 bi = run->program->builtin; 2038 2039 /* Just to keep the compiler happy. */ 2040 csi_sym = NULL; 2041 2042 switch (rarg_vi->u.value->var->vc) { 2043 case vc_bool: csi_sym = bi->boxed_bool; break; 2044 case vc_char: csi_sym = bi->boxed_char; break; 2045 case vc_int: csi_sym = bi->boxed_int; break; 2046 case vc_string: csi_sym = bi->boxed_string; break; 2047 2048 case vc_ref: 2049 case vc_deleg: 2050 case vc_array: 2051 case vc_object: 2052 case vc_resource: 2053 assert(b_false); 2054 } 2055 2056 csi = symbol_to_csi(csi_sym); 2057 assert(csi != NULL); 2058 2059 /* Construct object of the relevant boxed type. */ 2060 run_new_csi_inst(run, csi, res); 2061 2062 /* Set the 'Value' field */ 2063 2064 assert((*res)->ic == ic_value); 2065 assert((*res)->u.value->var->vc == vc_ref); 2066 var = (*res)->u.value->var->u.ref_v->vref; 2067 assert(var->vc == vc_object); 2068 object = var->u.object_v; 2069 2070 mbr_name_sid = strtab_get_sid("Value"); 2071 mbr_var = intmap_get(&object->fields, mbr_name_sid); 2072 assert(mbr_var != NULL); 2073 2074 rdata_var_write(mbr_var, rarg_vi->u.value); 2075 } 2076 2077 /** Create new CSI instance. 2078 * 2079 * Create a new object, instance of @a csi. 2080 * XXX This does not work with generics as @a csi cannot specify a generic 2081 * type. 2082 * 2083 * Initialize the fields with default values of their types, but do not 2084 * run any constructor. 2085 * 2086 * @param run Runner object 2087 * @param as_op @c as conversion expression 2088 * @param res Place to store result 2089 */ 1797 2090 void run_new_csi_inst(run_t *run, stree_csi_t *csi, rdata_item_t **res) 1798 2091 { … … 1804 2097 1805 2098 rdata_var_t *mbr_var; 1806 1807 2099 list_node_t *node; 2100 tdata_item_t *field_ti; 1808 2101 1809 2102 csi_sym = csi_to_symbol(csi); … … 1824 2117 1825 2118 /* Create object fields. */ 1826 node = list_first(&csi->members); 1827 while (node != NULL) { 1828 csimbr = list_node_data(node, stree_csimbr_t *); 1829 if (csimbr->cc == csimbr_var) { 1830 /* XXX Depends on member variable type. */ 1831 mbr_var = rdata_var_new(vc_int); 1832 mbr_var->u.int_v = rdata_int_new(); 1833 bigint_init(&mbr_var->u.int_v->value, 0); 1834 1835 intmap_set(&obj->fields, csimbr->u.var->name->sid, 1836 mbr_var); 2119 while (csi != NULL) { 2120 node = list_first(&csi->members); 2121 while (node != NULL) { 2122 csimbr = list_node_data(node, stree_csimbr_t *); 2123 if (csimbr->cc == csimbr_var) { 2124 /* Compute field type. XXX Memoize. */ 2125 run_texpr(run->program, csi, 2126 csimbr->u.var->type, 2127 &field_ti); 2128 2129 /* Create and initialize field. */ 2130 run_var_new(run, field_ti, &mbr_var); 2131 2132 /* Add to field map. */ 2133 intmap_set(&obj->fields, 2134 csimbr->u.var->name->sid, 2135 mbr_var); 2136 } 2137 2138 node = list_next(&csi->members, node); 1837 2139 } 1838 2140 1839 node = list_next(&csi->members, node); 2141 /* Continue with base CSI */ 2142 csi = csi->base_csi; 1840 2143 } 1841 2144 … … 1846 2149 /** Return boolean value of an item. 1847 2150 * 1848 * Tries to interpret @a item as a boolean value. If it is not a boolean 1849 * value, this generates an error. 2151 * Try to interpret @a item as a boolean value. If it is not a boolean 2152 * value, generate an error. 2153 * 2154 * @param run Runner object 2155 * @param item Input item 2156 * @return Resulting boolean value 1850 2157 */ 1851 2158 bool_t run_item_boolean_value(run_t *run, rdata_item_t *item) -
uspace/app/sbi/src/run_texpr.c
r80badbe r883fedc 27 27 */ 28 28 29 /** @file Evaluate stype expressions. */29 /** @file Evaluate type expressions. */ 30 30 31 31 #include <assert.h> 32 32 #include <stdlib.h> 33 #include "debug.h" 33 34 #include "list.h" 34 35 #include "mytypes.h" 36 #include "stree.h" 35 37 #include "strtab.h" 36 38 #include "symbol.h" … … 50 52 stree_tapply_t *tapply, tdata_item_t **res); 51 53 54 /** Evaluate type expression. 55 * 56 * Evaluate type expression (this produces a type item). If a type error 57 * occurs, the resulting type item is of class @c tic_ignore. 58 * 59 * @param prog Program 60 * @param ctx Current CSI (context) 61 * @param texpr Type expression to evaluate 62 * @param res Place to store type result 63 */ 52 64 void run_texpr(stree_program_t *prog, stree_csi_t *ctx, stree_texpr_t *texpr, 53 65 tdata_item_t **res) … … 72 84 } 73 85 86 /** Evaluate type access expression. 87 * 88 * Evaluate operation per the type access ('.') operator. 89 * 90 * @param prog Program 91 * @param ctx Current CSI (context) 92 * @param taccess Type access expression to evaluate 93 * @param res Place to store type result 94 */ 74 95 static void run_taccess(stree_program_t *prog, stree_csi_t *ctx, 75 96 stree_taccess_t *taccess, tdata_item_t **res) … … 79 100 tdata_item_t *titem; 80 101 tdata_object_t *tobject; 102 tdata_deleg_t *tdeleg; 81 103 stree_csi_t *base_csi; 82 104 … … 111 133 } 112 134 113 if (sym->sc != sc_csi) { 135 switch (sym->sc) { 136 case sc_csi: 137 /* Construct type item. */ 138 titem = tdata_item_new(tic_tobject); 139 tobject = tdata_object_new(); 140 titem->u.tobject = tobject; 141 142 tobject->static_ref = b_false; 143 tobject->csi = sym->u.csi; 144 list_init(&tobject->targs); /* XXX */ 145 break; 146 case sc_deleg: 147 /* Construct type item. */ 148 titem = tdata_item_new(tic_tdeleg); 149 tdeleg = tdata_deleg_new(); 150 titem->u.tdeleg = tdeleg; 151 152 tdeleg->deleg = sym->u.deleg; 153 break; 154 case sc_fun: 155 case sc_var: 156 case sc_prop: 114 157 printf("Error: Symbol '"); 115 158 symbol_print_fqn(sym); 116 printf("' is not a CSI.\n"); 117 *res = tdata_item_new(tic_ignore); 118 return; 119 } 120 121 /* Construct type item. */ 122 titem = tdata_item_new(tic_tobject); 123 tobject = tdata_object_new(); 124 titem->u.tobject = tobject; 125 126 tobject->static_ref = b_false; 127 tobject->csi = sym->u.csi; 159 printf("' is not a type.\n"); 160 titem = tdata_item_new(tic_ignore); 161 break; 162 } 128 163 129 164 *res = titem; 130 165 } 131 166 167 /** Evaluate type indexing expression. 168 * 169 * Evaluate operation per the type indexing ('[', ']') operator. 170 * A type indexing operation may have extents specified or only rank 171 * specified. 172 * 173 * @param prog Program 174 * @param ctx Current CSI (context) 175 * @param tindex Type indexing expression to evaluate 176 * @param res Place to store type result 177 */ 132 178 static void run_tindex(stree_program_t *prog, stree_csi_t *ctx, 133 179 stree_tindex_t *tindex, tdata_item_t **res) … … 171 217 } 172 218 219 /** Evaluate type literal expression. 220 * 221 * @param prog Program 222 * @param ctx Current CSI (context) 223 * @param tliteral Type literal 224 * @param res Place to store type result 225 */ 173 226 static void run_tliteral(stree_program_t *prog, stree_csi_t *ctx, 174 227 stree_tliteral_t *tliteral, tdata_item_t **res) … … 207 260 tdata_item_t *titem; 208 261 tdata_object_t *tobject; 262 stree_targ_t *targ; 263 tdata_vref_t *tvref; 264 stree_deleg_t *deleg; 265 tdata_deleg_t *tdeleg; 209 266 210 267 #ifdef DEBUG_RUN_TRACE 211 268 printf("Evaluating type name reference.\n"); 212 #endif 269 printf("'%s'\n", strtab_get_str(tnameref->name->sid)); 270 #endif 271 /* In interactive mode we are not in a class */ 272 if (ctx != NULL) { 273 /* Look for type argument */ 274 targ = stree_csi_find_targ(ctx, tnameref->name); 275 276 if (targ != NULL) { 277 /* Found type argument */ 278 #ifdef DEBUG_RUN_TRACE 279 printf("Found type argument '%s'.\n", 280 strtab_get_str(tnameref->name->sid)); 281 #endif 282 titem = tdata_item_new(tic_tvref); 283 tvref = tdata_vref_new(); 284 titem->u.tvref = tvref; 285 tvref->targ = targ; 286 287 *res = titem; 288 return; 289 } 290 } 291 292 /* Look for symbol */ 213 293 sym = symbol_lookup_in_csi(prog, ctx, tnameref->name); 214 294 if (sym == NULL) { … … 219 299 } 220 300 221 if (sym->sc != sc_csi) { 301 switch (sym->sc) { 302 case sc_csi: 303 /* Construct type item. */ 304 titem = tdata_item_new(tic_tobject); 305 tobject = tdata_object_new(); 306 titem->u.tobject = tobject; 307 308 tobject->static_ref = b_false; 309 tobject->csi = sym->u.csi; 310 list_init(&tobject->targs); /* XXX */ 311 break; 312 case sc_deleg: 313 /* Fetch stored delegate type. */ 314 deleg = symbol_to_deleg(sym); 315 assert(deleg != NULL); 316 if (deleg->titem == NULL) { 317 /* 318 * Prepare a partial delegate which will be completed 319 * later. 320 */ 321 titem = tdata_item_new(tic_tdeleg); 322 tdeleg = tdata_deleg_new(); 323 titem->u.tdeleg = tdeleg; 324 tdeleg->deleg = deleg; 325 tdeleg->tsig = NULL; 326 327 deleg->titem = titem; 328 } else { 329 titem = deleg->titem; 330 } 331 break; 332 case sc_fun: 333 case sc_var: 334 case sc_prop: 222 335 printf("Error: Symbol '"); 223 336 symbol_print_fqn(sym); 224 printf("' is not a CSI.\n"); 225 *res = tdata_item_new(tic_ignore); 226 return; 227 } 228 337 printf("' is not a type.\n"); 338 titem = tdata_item_new(tic_ignore); 339 break; 340 } 341 342 *res = titem; 343 } 344 345 /** Evaluate type application expression. 346 * 347 * In a type application expression type arguments are applied to a generic 348 * CSI. 349 * 350 * @param prog Program 351 * @param ctx Current CSI (context) 352 * @param tapply Type application expression 353 * @param res Place to store type result 354 */ 355 static void run_tapply(stree_program_t *prog, stree_csi_t *ctx, 356 stree_tapply_t *tapply, tdata_item_t **res) 357 { 358 tdata_item_t *base_ti; 359 tdata_item_t *arg_ti; 360 tdata_item_t *titem; 361 tdata_object_t *tobject; 362 363 list_node_t *arg_n; 364 stree_texpr_t *arg; 365 366 list_node_t *farg_n; 367 stree_targ_t *farg; 368 369 #ifdef DEBUG_RUN_TRACE 370 printf("Evaluating type apply operation.\n"); 371 #endif 229 372 /* Construct type item. */ 230 373 titem = tdata_item_new(tic_tobject); … … 232 375 titem->u.tobject = tobject; 233 376 234 tobject->static_ref = b_false;235 tobject->csi = sym->u.csi;236 237 *res = titem;238 }239 240 static void run_tapply(stree_program_t *prog, stree_csi_t *ctx,241 stree_tapply_t *tapply, tdata_item_t **res)242 {243 tdata_item_t *base_ti;244 tdata_item_t *arg_ti;245 tdata_item_t *titem;246 tdata_object_t *tobject;247 248 list_node_t *arg_n;249 stree_texpr_t *arg;250 251 #ifdef DEBUG_RUN_TRACE252 printf("Evaluating type apply operation.\n");253 #endif254 /* Construct type item. */255 titem = tdata_item_new(tic_tobject);256 tobject = tdata_object_new();257 titem->u.tobject = tobject;258 259 377 /* Evaluate base (generic) type. */ 260 378 run_texpr(prog, ctx, tapply->gtype, &base_ti); … … 272 390 273 391 /* Evaluate type arguments. */ 392 farg_n = list_first(&tobject->csi->targ); 274 393 arg_n = list_first(&tapply->targs); 275 while (arg_n != NULL) { 394 while (farg_n != NULL && arg_n != NULL) { 395 farg = list_node_data(farg_n, stree_targ_t *); 276 396 arg = list_node_data(arg_n, stree_texpr_t *); 397 277 398 run_texpr(prog, ctx, arg, &arg_ti); 278 399 … … 284 405 list_append(&tobject->targs, arg_ti); 285 406 407 farg_n = list_next(&tobject->csi->targ, farg_n); 286 408 arg_n = list_next(&tapply->targs, arg_n); 287 409 } 288 410 411 if (farg_n != NULL || arg_n != NULL) { 412 printf("Error: Incorrect number of type arguments.\n"); 413 *res = tdata_item_new(tic_ignore); 414 return; 415 } 416 289 417 *res = titem; 290 418 } -
uspace/app/sbi/src/stree.c
r80badbe r883fedc 37 37 #include "stree.h" 38 38 39 /** Allocate new module. 40 * 41 * @return New module 42 */ 39 43 stree_module_t *stree_module_new(void) 40 44 { … … 51 55 } 52 56 57 /** Allocate new module member. 58 * 59 * @param mc Module member class 60 * @return New module member 61 */ 53 62 stree_modm_t *stree_modm_new(modm_class_t mc) 54 63 { … … 65 74 } 66 75 76 /** Allocate new CSI. 77 * 78 * @param cc CSI class 79 * @return New CSI 80 */ 67 81 stree_csi_t *stree_csi_new(csi_class_t cc) 68 82 { … … 83 97 } 84 98 99 /** Allocate new CSI member. 100 * 101 * @param cc CSI member class 102 * @return New CSI member 103 */ 85 104 stree_csimbr_t *stree_csimbr_new(csimbr_class_t cc) 86 105 { … … 97 116 } 98 117 118 /** Allocate new member delegate. 119 * 120 * @return New member delegate 121 */ 122 stree_deleg_t *stree_deleg_new(void) 123 { 124 stree_deleg_t *deleg; 125 126 deleg = calloc(1, sizeof(stree_deleg_t)); 127 if (deleg == NULL) { 128 printf("Memory allocation failed.\n"); 129 exit(1); 130 } 131 132 return deleg; 133 } 134 135 /** Allocate new member function. 136 * 137 * @return New member function 138 */ 99 139 stree_fun_t *stree_fun_new(void) 100 140 { … … 110 150 } 111 151 152 /** Allocate new member variable. 153 * 154 * @return New member variable 155 */ 112 156 stree_var_t *stree_var_new(void) 113 157 { … … 123 167 } 124 168 169 /** Allocate new property. 170 * 171 * @return New property 172 */ 125 173 stree_prop_t *stree_prop_new(void) 126 174 { … … 136 184 } 137 185 186 /** Allocate new type argument. 187 * 188 * @return New type argument 189 */ 190 stree_targ_t *stree_targ_new(void) 191 { 192 stree_targ_t *targ; 193 194 targ = calloc(1, sizeof(stree_targ_t)); 195 if (targ == NULL) { 196 printf("Memory allocation failed.\n"); 197 exit(1); 198 } 199 200 return targ; 201 } 202 203 /** Allocate new symbol attribute. 204 * 205 * @param sac Symbol attribute class 206 * @return New symbol attribute 207 */ 138 208 stree_symbol_attr_t *stree_symbol_attr_new(symbol_attr_class_t sac) 139 209 { … … 150 220 } 151 221 222 /** Allocate new procedure. 223 * 224 * @return New procedure 225 */ 152 226 stree_proc_t *stree_proc_new(void) 153 227 { … … 163 237 } 164 238 239 /** Allocate new procedure argument. 240 * 241 * @return New procedure argument 242 */ 165 243 stree_proc_arg_t *stree_proc_arg_new(void) 166 244 { … … 176 254 } 177 255 256 /** Allocate new function signature. 257 * 258 * @return New procedure argument 259 */ 260 stree_fun_sig_t *stree_fun_sig_new(void) 261 { 262 stree_fun_sig_t *fun_sig; 263 264 fun_sig = calloc(1, sizeof(stree_fun_sig_t)); 265 if (fun_sig == NULL) { 266 printf("Memory allocation failed.\n"); 267 exit(1); 268 } 269 270 return fun_sig; 271 } 272 273 /** Allocate new procedure argument attribute. 274 * 275 * @param Argument attribute class 276 * @return New procedure argument attribute 277 */ 178 278 stree_arg_attr_t *stree_arg_attr_new(arg_attr_class_t aac) 179 279 { … … 190 290 } 191 291 292 /** Allocate new statement. 293 * 294 * @param sc Statement class 295 * @return New statement 296 */ 192 297 stree_stat_t *stree_stat_new(stat_class_t sc) 193 298 { … … 204 309 } 205 310 311 /** Allocate new local variable declaration. 312 * 313 * @return New local variable declaration 314 */ 206 315 stree_vdecl_t *stree_vdecl_new(void) 207 316 { … … 217 326 } 218 327 328 /** Allocate new @c if statement. 329 * 330 * @return New @c if statement 331 */ 219 332 stree_if_t *stree_if_new(void) 220 333 { … … 230 343 } 231 344 345 /** Allocate new @c while statement. 346 * 347 * @return New @c while statement 348 */ 232 349 stree_while_t *stree_while_new(void) 233 350 { … … 243 360 } 244 361 362 /** Allocate new @c for statement. 363 * 364 * @return New @c for statement 365 */ 245 366 stree_for_t *stree_for_new(void) 246 367 { … … 256 377 } 257 378 379 /** Allocate new @c raise statement. 380 * 381 * @return New @c raise statement 382 */ 258 383 stree_raise_t *stree_raise_new(void) 259 384 { … … 269 394 } 270 395 396 /** Allocate new @c return statement. 397 * 398 * @return New @c return statement 399 */ 271 400 stree_return_t *stree_return_new(void) 272 401 { … … 282 411 } 283 412 413 /** Allocate new with-except-finally statement. 414 * 415 * @return New with-except-finally statement. 416 */ 284 417 stree_wef_t *stree_wef_new(void) 285 418 { … … 295 428 } 296 429 430 /** Allocate new expression statement. 431 * 432 * @return New expression statement 433 */ 297 434 stree_exps_t *stree_exps_new(void) 298 435 { … … 308 445 } 309 446 447 /** Allocate new @c except clause. 448 * 449 * @return New @c except clause 450 */ 310 451 stree_except_t *stree_except_new(void) 311 452 { … … 321 462 } 322 463 464 /** Allocate new statement block. 465 * 466 * @return New statement block 467 */ 323 468 stree_block_t *stree_block_new(void) 324 469 { … … 334 479 } 335 480 481 /** Allocate new expression. 482 * 483 * @param ec Expression class 484 * @return New expression 485 */ 336 486 stree_expr_t *stree_expr_new(expr_class_t ec) 337 487 { … … 348 498 } 349 499 500 /** Allocate new assignment. 501 * 502 * @param ac Assignment class 503 * @return New assignment 504 */ 350 505 stree_assign_t *stree_assign_new(assign_class_t ac) 351 506 { … … 362 517 } 363 518 519 /** Allocate new binary operation. 520 * 521 * @return New binary operation 522 */ 364 523 stree_binop_t *stree_binop_new(binop_class_t bc) 365 524 { … … 376 535 } 377 536 537 /** Allocate new unary operation. 538 * 539 * @param uc Unary operation class 540 * @return New unary operation 541 */ 378 542 stree_unop_t *stree_unop_new(unop_class_t uc) 379 543 { … … 390 554 } 391 555 556 /** Allocate new @c new operation. 557 * 558 * @return New @c new operation 559 */ 392 560 stree_new_t *stree_new_new(void) 393 561 { … … 403 571 } 404 572 573 /** Allocate new . 574 * 575 * @return New 576 */ 405 577 stree_access_t *stree_access_new(void) 406 578 { … … 416 588 } 417 589 590 /** Allocate new function call operation. 591 * 592 * @return New function call operation 593 */ 418 594 stree_call_t *stree_call_new(void) 419 595 { … … 429 605 } 430 606 607 /** Allocate new indexing operation. 608 * 609 * @return New indexing operation 610 */ 431 611 stree_index_t *stree_index_new(void) 432 612 { … … 442 622 } 443 623 624 /** Allocate new as conversion. 625 * 626 * @return New as conversion 627 */ 444 628 stree_as_t *stree_as_new(void) 445 629 { … … 455 639 } 456 640 641 /** Allocate new boxing operation. 642 * 643 * @return New boxing operation 644 */ 645 stree_box_t *stree_box_new(void) 646 { 647 stree_box_t *box_expr; 648 649 box_expr = calloc(1, sizeof(stree_box_t)); 650 if (box_expr == NULL) { 651 printf("Memory allocation failed.\n"); 652 exit(1); 653 } 654 655 return box_expr; 656 } 657 658 /** Allocate new name reference operation. 659 * 660 * @return New name reference operation 661 */ 457 662 stree_nameref_t *stree_nameref_new(void) 458 663 { … … 468 673 } 469 674 675 /** Allocate new identifier. 676 * 677 * @return New identifier 678 */ 470 679 stree_ident_t *stree_ident_new(void) 471 680 { … … 481 690 } 482 691 692 /** Allocate new literal. 693 * 694 * @param ltc Literal class 695 * @return New literal 696 */ 483 697 stree_literal_t *stree_literal_new(literal_class_t ltc) 484 698 { … … 495 709 } 496 710 711 /** Allocate new @c self reference. 712 * 713 * @return New @c self reference 714 */ 497 715 stree_self_ref_t *stree_self_ref_new(void) 498 716 { … … 508 726 } 509 727 728 /** Allocate new type expression 729 * 730 * @return New type expression 731 */ 510 732 stree_texpr_t *stree_texpr_new(texpr_class_t tc) 511 733 { … … 522 744 } 523 745 746 /** Allocate new type access operation. 747 * 748 * @return New type access operation 749 */ 524 750 stree_taccess_t *stree_taccess_new(void) 525 751 { … … 535 761 } 536 762 763 /** Allocate new type application operation. 764 * 765 * @return New type application operation 766 */ 537 767 stree_tapply_t *stree_tapply_new(void) 538 768 { … … 548 778 } 549 779 780 /** Allocate new type indexing operation. 781 * 782 * @return New type indexing operation 783 */ 550 784 stree_tindex_t *stree_tindex_new(void) 551 785 { … … 561 795 } 562 796 797 /** Allocate new type literal. 798 * 799 * @return New type literal 800 */ 563 801 stree_tliteral_t *stree_tliteral_new(tliteral_class_t tlc) 564 802 { … … 575 813 } 576 814 815 /** Allocate new type name reference. 816 * 817 * @return New type name reference 818 */ 577 819 stree_tnameref_t *stree_tnameref_new(void) 578 820 { … … 588 830 } 589 831 832 /** Allocate new symbol. 833 * 834 * @return New symbol 835 */ 590 836 stree_symbol_t *stree_symbol_new(symbol_class_t sc) 591 837 { … … 602 848 } 603 849 850 /** Allocate new program. 851 * 852 * @return New program 853 */ 604 854 stree_program_t *stree_program_new(void) 605 855 { … … 615 865 } 616 866 617 /** Determine if @a symbol has attribute of class @a sac. */ 867 /** Determine if @a symbol has attribute of class @a sac. 868 * 869 * @param symbol Symbol 870 * @param sac Symbol attribute class 871 * @return @c b_true if yes, @c b_false if no. 872 */ 618 873 bool_t stree_symbol_has_attr(stree_symbol_t *symbol, symbol_attr_class_t sac) 619 874 { … … 633 888 } 634 889 635 /** Determine if argument @a arg has attribute of class @a aac. */ 890 /** Determine if argument @a arg has attribute of class @a aac. 891 * 892 * @param arg Formal procedure argument 893 * @param aac Argument attribute class 894 * @return @c b_true if yes, @c b_false if no. 895 */ 636 896 bool_t stree_arg_has_attr(stree_proc_arg_t *arg, arg_attr_class_t aac) 637 897 { … … 653 913 /** Determine wheter @a a is derived (transitively) from @a b. 654 914 * 915 * XXX This does not work right with generics. 916 * 655 917 * @param a Derived CSI. 656 918 * @param b Base CSI. … … 673 935 return b_false; 674 936 } 937 938 /** Search for CSI type argument of the given name. 939 * 940 * @param csi CSI to look in. 941 * @param ident Identifier of the type argument. 942 * @return Type argument definition or @c NULL if not found. 943 */ 944 stree_targ_t *stree_csi_find_targ(stree_csi_t *csi, stree_ident_t *ident) 945 { 946 list_node_t *targ_n; 947 stree_targ_t *targ; 948 949 targ_n = list_first(&csi->targ); 950 while (targ_n != NULL) { 951 targ = list_node_data(targ_n, stree_targ_t *); 952 if (targ->name->sid == ident->sid) 953 return targ; 954 955 targ_n = list_next(&csi->targ, targ_n); 956 } 957 958 /* No match */ 959 return NULL; 960 } -
uspace/app/sbi/src/stree.h
r80badbe r883fedc 36 36 stree_csi_t *stree_csi_new(csi_class_t cc); 37 37 stree_csimbr_t *stree_csimbr_new(csimbr_class_t cc); 38 stree_deleg_t *stree_deleg_new(void); 38 39 stree_fun_t *stree_fun_new(void); 39 40 stree_var_t *stree_var_new(void); 40 41 stree_prop_t *stree_prop_new(void); 42 stree_targ_t *stree_targ_new(void); 41 43 42 44 stree_symbol_attr_t *stree_symbol_attr_new(symbol_attr_class_t sac); … … 44 46 stree_proc_t *stree_proc_new(void); 45 47 stree_proc_arg_t *stree_proc_arg_new(void); 48 stree_fun_sig_t *stree_fun_sig_new(void); 46 49 stree_arg_attr_t *stree_arg_attr_new(arg_attr_class_t aac); 47 50 … … 68 71 stree_index_t *stree_index_new(void); 69 72 stree_as_t *stree_as_new(void); 73 stree_box_t *stree_box_new(void); 70 74 stree_nameref_t *stree_nameref_new(void); 71 75 … … 87 91 bool_t stree_arg_has_attr(stree_proc_arg_t *arg, arg_attr_class_t aac); 88 92 bool_t stree_is_csi_derived_from_csi(stree_csi_t *a, stree_csi_t *b); 93 stree_targ_t *stree_csi_find_targ(stree_csi_t *csi, stree_ident_t *ident); 89 94 90 95 #endif -
uspace/app/sbi/src/stree_t.h
r80badbe r883fedc 186 186 } stree_as_t; 187 187 188 /** Boxing of primitive type (pseudo) 189 * 190 * This pseudo-node is used internally to box a value of primitive type. 191 * It is implicitly inserted by stype_convert(). It does not correspond 192 * to a an explicit program construct. 193 */ 194 typedef struct { 195 /* Primitive type expression */ 196 struct stree_expr *arg; 197 } stree_box_t; 198 188 199 /** Arithmetic expression class */ 189 200 typedef enum { … … 198 209 ec_assign, 199 210 ec_index, 200 ec_as 211 ec_as, 212 ec_box 201 213 } expr_class_t; 202 214 … … 219 231 stree_assign_t *assign; 220 232 stree_as_t *as_op; 233 stree_box_t *box; 221 234 } u; 222 235 } stree_expr_t; … … 415 428 } stree_proc_arg_t; 416 429 430 /** Function signature. 431 * 432 * Foormal parameters and return type. This is common to function and delegate 433 * delcarations. 434 */ 435 typedef struct { 436 /** Formal parameters */ 437 list_t args; /* of stree_proc_arg_t */ 438 439 /** Variadic argument or @c NULL if none. */ 440 stree_proc_arg_t *varg; 441 442 /** Return type */ 443 stree_texpr_t *rtype; 444 } stree_fun_sig_t; 445 417 446 /** Procedure 418 447 * … … 432 461 } stree_proc_t; 433 462 463 /** Delegate declaration */ 464 typedef struct stree_deleg { 465 /** Delegate name */ 466 stree_ident_t *name; 467 468 /** Symbol */ 469 struct stree_symbol *symbol; 470 471 /** Signature (arguments and return type) */ 472 stree_fun_sig_t *sig; 473 474 /** Type item describing the delegate */ 475 struct tdata_item *titem; 476 } stree_deleg_t; 477 434 478 /** Member function declaration */ 435 479 typedef struct stree_fun { … … 440 484 struct stree_symbol *symbol; 441 485 442 /** Formal parameters */ 443 list_t args; /* of stree_proc_arg_t */ 444 445 /** Variadic argument or @c NULL if none. */ 446 stree_proc_arg_t *varg; 447 448 /** Return type */ 449 stree_texpr_t *rtype; 486 /** Signature (arguments and return type) */ 487 stree_fun_sig_t *sig; 450 488 451 489 /** Function implementation */ 452 490 stree_proc_t *proc; 491 492 /** Type item describing the function */ 493 struct tdata_item *titem; 453 494 } stree_fun_t; 454 495 … … 486 527 typedef enum { 487 528 csimbr_csi, 529 csimbr_deleg, 488 530 csimbr_fun, 489 531 csimbr_var, … … 497 539 union { 498 540 struct stree_csi *csi; 541 stree_deleg_t *deleg; 499 542 stree_fun_t *fun; 500 543 stree_var_t *var; … … 509 552 } csi_class_t; 510 553 554 /** CSI formal type argument */ 555 typedef struct stree_targ { 556 stree_ident_t *name; 557 struct stree_symbol *symbol; 558 } stree_targ_t; 559 511 560 /** Class, struct or interface declaration */ 512 561 typedef struct stree_csi { … … 517 566 stree_ident_t *name; 518 567 519 /** List of type argument names */520 list_t targ _names; /* of stree_ident_t */568 /** List of type arguments */ 569 list_t targ; /* of stree_targ_t */ 521 570 522 571 /** Symbol for this CSI */ … … 566 615 } stree_symbol_attr_t; 567 616 568 569 typedef enum { 617 typedef enum { 618 /** CSI (class, struct or interface) */ 570 619 sc_csi, 620 /** Member delegate */ 621 sc_deleg, 622 /** Member function */ 571 623 sc_fun, 624 /** Member variable */ 572 625 sc_var, 626 /** Member property */ 573 627 sc_prop 574 628 } symbol_class_t; … … 584 638 union { 585 639 struct stree_csi *csi; 640 stree_deleg_t *deleg; 586 641 stree_fun_t *fun; 587 642 stree_var_t *var; -
uspace/app/sbi/src/strtab.c
r80badbe r883fedc 30 30 * 31 31 * Converts strings to more compact SID (string ID, integer) and back. 32 * The string table is not an object as there will never be a need for 32 * (The point is that this deduplicates the strings. Using SID might actually 33 * not be such a big win.) 34 * 35 * The string table is a singleton as there will never be a need for 33 36 * more than one. 37 * 38 * Current implementation uses a linked list and thus it is slow. 34 39 */ 35 40 … … 43 48 static list_t str_list; 44 49 50 /** Initialize string table. */ 45 51 void strtab_init(void) 46 52 { … … 48 54 } 49 55 56 /** Get SID of a string. 57 * 58 * Return SID of @a str. If @a str is not in the string table yet, 59 * it is added and thus a new SID is assigned. 60 * 61 * @param str String 62 * @return SID of @a str. 63 */ 50 64 sid_t strtab_get_sid(const char *str) 51 65 { … … 70 84 } 71 85 86 /** Get string with the given SID. 87 * 88 * Returns string that has SID @a sid. If no such string exists, this 89 * causes a fatal error in the interpreter. 90 * 91 * @param sid SID of the string. 92 * @return Pointer to the string. 93 */ 72 94 char *strtab_get_str(sid_t sid) 73 95 { -
uspace/app/sbi/src/stype.c
r80badbe r883fedc 30 30 * @file Implements a walk on the program that computes and checks static 31 31 * types. 'Types' the program. 32 * 33 * If a type error is encountered, stype_note_error() is called to set 34 * the typing error flag. 32 35 */ 33 36 … … 53 56 static void stype_prop(stype_t *stype, stree_prop_t *prop); 54 57 58 static void stype_fun_sig(stype_t *stype, stree_csi_t *outer_csi, 59 stree_fun_sig_t *sig, tdata_fun_sig_t **rtsig); 60 static void stype_fun_body(stype_t *stype, stree_fun_t *fun); 55 61 static void stype_block(stype_t *stype, stree_block_t *block); 56 62 … … 64 70 static void stype_wef(stype_t *stype, stree_wef_t *wef_s); 65 71 66 /** Type module */ 72 static stree_expr_t *stype_convert_tprimitive(stype_t *stype, 73 stree_expr_t *expr, tdata_item_t *dest); 74 static stree_expr_t *stype_convert_tprim_tobj(stype_t *stype, 75 stree_expr_t *expr, tdata_item_t *dest); 76 static stree_expr_t *stype_convert_tobject(stype_t *stype, stree_expr_t *expr, 77 tdata_item_t *dest); 78 static stree_expr_t *stype_convert_tarray(stype_t *stype, stree_expr_t *expr, 79 tdata_item_t *dest); 80 static stree_expr_t *stype_convert_tdeleg(stype_t *stype, stree_expr_t *expr, 81 tdata_item_t *dest); 82 static stree_expr_t *stype_convert_tfun_tdeleg(stype_t *stype, 83 stree_expr_t *expr, tdata_item_t *dest); 84 static stree_expr_t *stype_convert_tvref(stype_t *stype, stree_expr_t *expr, 85 tdata_item_t *dest); 86 static void stype_convert_failure(stype_t *stype, tdata_item_t *src, 87 tdata_item_t *dest); 88 89 static bool_t stype_fun_sig_equal(stype_t *stype, tdata_fun_sig_t *asig, 90 tdata_fun_sig_t *sdig); 91 92 /** Type module. 93 * 94 * If the module contains a type error, @a stype->error will be set 95 * when this function returns. 96 * 97 * @param stype Static typing object 98 * @param module Module to type 99 */ 67 100 void stype_module(stype_t *stype, stree_module_t *module) 68 101 { … … 87 120 } 88 121 89 /** Type CSI */ 122 /** Type CSI. 123 * 124 * @param stype Static typing object 125 * @param csi CSI to type 126 */ 90 127 static void stype_csi(stype_t *stype, stree_csi_t *csi) 91 128 { … … 108 145 switch (csimbr->cc) { 109 146 case csimbr_csi: stype_csi(stype, csimbr->u.csi); break; 147 case csimbr_deleg: stype_deleg(stype, csimbr->u.deleg); break; 110 148 case csimbr_fun: stype_fun(stype, csimbr->u.fun); break; 111 149 case csimbr_var: stype_var(stype, csimbr->u.var); break; … … 119 157 } 120 158 121 /** Type function */ 159 /** Type delegate. 160 * 161 * @param stype Static typing object. 162 * @param deleg Delegate to type. 163 */ 164 void stype_deleg(stype_t *stype, stree_deleg_t *deleg) 165 { 166 stree_symbol_t *deleg_sym; 167 tdata_item_t *deleg_ti; 168 tdata_deleg_t *tdeleg; 169 tdata_fun_sig_t *tsig; 170 171 #ifdef DEBUG_TYPE_TRACE 172 printf("Type delegate '"); 173 symbol_print_fqn(deleg_to_symbol(deleg)); 174 printf("'.\n"); 175 #endif 176 if (deleg->titem == NULL) { 177 deleg_ti = tdata_item_new(tic_tdeleg); 178 deleg->titem = deleg_ti; 179 tdeleg = tdata_deleg_new(); 180 deleg_ti->u.tdeleg = tdeleg; 181 } else { 182 deleg_ti = deleg->titem; 183 assert(deleg_ti->u.tdeleg != NULL); 184 tdeleg = deleg_ti->u.tdeleg; 185 } 186 187 if (tdeleg->tsig != NULL) 188 return; /* Delegate has already been typed. */ 189 190 deleg_sym = deleg_to_symbol(deleg); 191 192 /* Type function signature. Store result in deleg->titem. */ 193 stype_fun_sig(stype, deleg_sym->outer_csi, deleg->sig, &tsig); 194 195 tdeleg->deleg = deleg; 196 tdeleg->tsig = tsig; 197 } 198 199 /** Type function. 200 * 201 * We split typing of function header and body because at the point we 202 * are typing the body of some function we may encounter function calls. 203 * To type a function call we first need to type the header of the function 204 * being called. 205 * 206 * @param stype Static typing object. 207 * @param fun Function to type. 208 */ 122 209 static void stype_fun(stype_t *stype, stree_fun_t *fun) 123 210 { 124 list_node_t *arg_n;125 stree_proc_arg_t *arg;126 stree_symbol_t *fun_sym;127 tdata_item_t *titem;128 129 211 #ifdef DEBUG_TYPE_TRACE 130 212 printf("Type function '"); … … 132 214 printf("'.\n"); 133 215 #endif 216 if (fun->titem == NULL) 217 stype_fun_header(stype, fun); 218 219 stype_fun_body(stype, fun); 220 } 221 222 /** Type function header. 223 * 224 * Types the header of @a fun (but not its body). 225 * 226 * @param stype Static typing object 227 * @param fun Funtction 228 */ 229 void stype_fun_header(stype_t *stype, stree_fun_t *fun) 230 { 231 stree_symbol_t *fun_sym; 232 tdata_item_t *fun_ti; 233 tdata_fun_t *tfun; 234 tdata_fun_sig_t *tsig; 235 236 #ifdef DEBUG_TYPE_TRACE 237 printf("Type function '"); 238 symbol_print_fqn(fun_to_symbol(fun)); 239 printf("' header.\n"); 240 #endif 241 if (fun->titem != NULL) 242 return; /* Function header has already been typed. */ 243 134 244 fun_sym = fun_to_symbol(fun); 245 246 /* Type function signature. */ 247 stype_fun_sig(stype, fun_sym->outer_csi, fun->sig, &tsig); 248 249 fun_ti = tdata_item_new(tic_tfun); 250 tfun = tdata_fun_new(); 251 fun_ti->u.tfun = tfun; 252 tfun->tsig = tsig; 253 254 fun->titem = fun_ti; 255 } 256 257 /** Type function signature. 258 * 259 * Types the function signature @a sig. 260 * 261 * @param stype Static typing object 262 * @param outer_csi CSI within which the signature is defined. 263 * @param sig Function signature 264 */ 265 static void stype_fun_sig(stype_t *stype, stree_csi_t *outer_csi, 266 stree_fun_sig_t *sig, tdata_fun_sig_t **rtsig) 267 { 268 list_node_t *arg_n; 269 stree_proc_arg_t *arg; 270 tdata_item_t *titem; 271 tdata_fun_sig_t *tsig; 272 273 #ifdef DEBUG_TYPE_TRACE 274 printf("Type function signature.\n"); 275 #endif 276 tsig = tdata_fun_sig_new(); 277 278 list_init(&tsig->arg_ti); 135 279 136 280 /* 137 281 * Type formal arguments. 138 * XXX Save the results.139 282 */ 140 arg_n = list_first(& fun->args);283 arg_n = list_first(&sig->args); 141 284 while (arg_n != NULL) { 142 285 arg = list_node_data(arg_n, stree_proc_arg_t *); … … 144 287 /* XXX Because of overloaded builtin WriteLine. */ 145 288 if (arg->type == NULL) { 146 arg_n = list_next(&fun->args, arg_n); 289 list_append(&tsig->arg_ti, NULL); 290 arg_n = list_next(&sig->args, arg_n); 147 291 continue; 148 292 } 149 293 150 run_texpr(stype->program, fun_sym->outer_csi, arg->type,151 &titem);152 153 arg_n = list_next(& fun->args, arg_n);294 run_texpr(stype->program, outer_csi, arg->type, &titem); 295 list_append(&tsig->arg_ti, titem); 296 297 arg_n = list_next(&sig->args, arg_n); 154 298 } 155 299 156 300 /* Variadic argument */ 157 if ( fun->varg != NULL) {301 if (sig->varg != NULL) { 158 302 /* Check type and verify it is an array. */ 159 run_texpr(stype->program, fun_sym->outer_csi, fun->varg->type,160 &titem);303 run_texpr(stype->program, outer_csi, sig->varg->type, &titem); 304 tsig->varg_ti = titem; 161 305 162 306 if (titem->tic != tic_tarray && titem->tic != tic_ignore) { … … 166 310 } 167 311 168 /* 169 * Type function body. 170 */ 312 /* Return type */ 313 if (sig->rtype != NULL) { 314 run_texpr(stype->program, outer_csi, sig->rtype, &titem); 315 tsig->rtype = titem; 316 } 317 318 *rtsig = tsig; 319 } 320 321 /** Type function body. 322 * 323 * Types the body of function @a fun (if it has one). 324 * 325 * @param stype Static typing object 326 * @param fun Funtction 327 */ 328 static void stype_fun_body(stype_t *stype, stree_fun_t *fun) 329 { 330 #ifdef DEBUG_TYPE_TRACE 331 printf("Type function '"); 332 symbol_print_fqn(fun_to_symbol(fun)); 333 printf("' body.\n"); 334 #endif 335 assert(stype->proc_vr == NULL); 171 336 172 337 /* Builtin functions do not have a body. */ … … 184 349 } 185 350 186 /** Type member variable */ 351 /** Type member variable. 352 * 353 * @param stype Static typing object 354 * @param var Member variable 355 */ 187 356 static void stype_var(stype_t *stype, stree_var_t *var) 188 357 { … … 201 370 } 202 371 203 /** Type property */ 372 /** Type property. 373 * 374 * @param stype Static typing object 375 * @param prop Property 376 */ 204 377 static void stype_prop(stype_t *stype, stree_prop_t *prop) 205 378 { … … 226 399 } 227 400 228 /** Type statement block */ 401 /** Type statement block. 402 * 403 * @param stype Static typing object 404 * @param block Statement block 405 */ 229 406 static void stype_block(stype_t *stype, stree_block_t *block) 230 407 { … … 265 442 * for nested statemens). This is used in interactive mode. 266 443 * 267 * @param stype Static typ er object.268 * @param stat Statement to type .269 * @param want_value @c b_true to allow ignoring expression value .444 * @param stype Static typing object 445 * @param stat Statement to type 446 * @param want_value @c b_true to allow ignoring expression value 270 447 */ 271 448 void stype_stat(stype_t *stype, stree_stat_t *stat, bool_t want_value) … … 286 463 } 287 464 288 /** Type local variable declaration */ 465 /** Type local variable declaration statement. 466 * 467 * @param stype Static typing object 468 * @param vdecl_s Variable delcaration statement 469 */ 289 470 static void stype_vdecl(stype_t *stype, stree_vdecl_t *vdecl_s) 290 471 { … … 317 498 } 318 499 319 /** Type @c if statement */ 500 /** Type @c if statement. 501 * 502 * @param stype Static typing object 503 * @param if_s @c if statement 504 */ 320 505 static void stype_if(stype_t *stype, stree_if_t *if_s) 321 506 { … … 340 525 } 341 526 342 /** Type @c while statement */ 527 /** Type @c while statement 528 * 529 * @param stype Static typing object 530 * @param while_s @c while statement 531 */ 343 532 static void stype_while(stype_t *stype, stree_while_t *while_s) 344 533 { … … 360 549 } 361 550 362 /** Type @c for statement */ 551 /** Type @c for statement. 552 * 553 * @param stype Static typing object 554 * @param for_s @c for statement 555 */ 363 556 static void stype_for(stype_t *stype, stree_for_t *for_s) 364 557 { … … 369 562 } 370 563 371 /** Type @c raise statement */ 564 /** Type @c raise statement. 565 * 566 * @param stype Static typing object 567 * @param raise_s @c raise statement 568 */ 372 569 static void stype_raise(stype_t *stype, stree_raise_t *raise_s) 373 570 { … … 402 599 403 600 /* XXX Memoize to avoid recomputing. */ 404 run_texpr(stype->program, outer_sym->outer_csi, fun->rtype,405 &dtype);601 run_texpr(stype->program, outer_sym->outer_csi, 602 fun->sig->rtype, &dtype); 406 603 break; 407 604 case sc_prop: … … 430 627 } 431 628 432 /** Type expression statement */ 629 /** Type expression statement. 630 * 631 * @param stype Static typing object 632 * @param exp_s Expression statement 633 */ 433 634 static void stype_exps(stype_t *stype, stree_exps_t *exp_s, bool_t want_value) 434 635 { … … 442 643 } 443 644 444 /** Type With-Except-Finally statement */ 645 /** Type with-except-finally statement. 646 * 647 * @param stype Static typing object 648 * @param wef_s With-except-finally statement 649 */ 445 650 static void stype_wef(stype_t *stype, stree_wef_t *wef_s) 446 651 { … … 482 687 * Note: No conversion that would require modifying @a expr is implemented 483 688 * yet. 689 * 690 * @param stype Static typing object 691 * @param expr Expression 692 * @param dest Destination type 484 693 */ 485 694 stree_expr_t *stype_convert(stype_t *stype, stree_expr_t *expr, … … 488 697 tdata_item_t *src; 489 698 490 (void) stype;491 699 src = expr->titem; 700 701 #ifdef DEBUG_TYPE_TRACE 702 printf("Convert '"); 703 tdata_item_print(src); 704 printf("' to '"); 705 tdata_item_print(dest); 706 printf("'.\n"); 707 #endif 492 708 493 709 if (dest == NULL) { … … 514 730 } 515 731 516 if (src->tic != dest->tic) 517 goto failure; 732 if (src->tic == tic_tprimitive && dest->tic == tic_tobject) { 733 return stype_convert_tprim_tobj(stype, expr, dest); 734 } 735 736 if (src->tic == tic_tfun && dest->tic == tic_tdeleg) { 737 return stype_convert_tfun_tdeleg(stype, expr, dest); 738 } 739 740 if (src->tic != dest->tic) { 741 stype_convert_failure(stype, src, dest); 742 return expr; 743 } 518 744 519 745 switch (src->tic) { 520 746 case tic_tprimitive: 521 /* Check if both have the same tprimitive class. */ 522 if (src->u.tprimitive->tpc != dest->u.tprimitive->tpc) 523 goto failure; 747 expr = stype_convert_tprimitive(stype, expr, dest); 524 748 break; 525 749 case tic_tobject: 526 /* Check if @c src is derived from @c dest. */ 527 if (stree_is_csi_derived_from_csi(src->u.tobject->csi, 528 dest->u.tobject->csi) != b_true) { 529 goto failure; 530 } 750 expr = stype_convert_tobject(stype, expr, dest); 531 751 break; 532 752 case tic_tarray: 533 /* Compare rank and base type. */ 534 if (src->u.tarray->rank != dest->u.tarray->rank) 535 goto failure; 536 537 /* XXX Should we convert each element? */ 538 if (tdata_item_equal(src->u.tarray->base_ti, 539 dest->u.tarray->base_ti) != b_true) 540 goto failure; 753 expr = stype_convert_tarray(stype, expr, dest); 754 break; 755 case tic_tdeleg: 756 expr = stype_convert_tdeleg(stype, expr, dest); 541 757 break; 542 758 case tic_tfun: 543 printf("Error: Unimplemented: Converting '"); 544 tdata_item_print(src); 545 printf("' to '"); 546 tdata_item_print(dest); 547 printf("'.\n"); 548 stype_note_error(stype); 759 assert(b_false); 760 case tic_tvref: 761 expr = stype_convert_tvref(stype, expr, dest); 549 762 break; 550 763 case tic_ignore: … … 553 766 554 767 return expr; 555 556 failure: 768 } 769 770 /** Convert expression of primitive type to primitive type. 771 * 772 * @param stype Static typing object 773 * @param expr Expression 774 * @param dest Destination type 775 */ 776 static stree_expr_t *stype_convert_tprimitive(stype_t *stype, 777 stree_expr_t *expr, tdata_item_t *dest) 778 { 779 tdata_item_t *src; 780 781 #ifdef DEBUG_TYPE_TRACE 782 printf("Convert primitive type.\n"); 783 #endif 784 src = expr->titem; 785 assert(src->tic == tic_tprimitive); 786 assert(dest->tic == tic_tprimitive); 787 788 /* Check if both have the same tprimitive class. */ 789 if (src->u.tprimitive->tpc != dest->u.tprimitive->tpc) 790 stype_convert_failure(stype, src, dest); 791 792 return expr; 793 } 794 795 /** Convert expression of primitive type to object type. 796 * 797 * This function implements autoboxing. It modified the code. 798 * 799 * @param stype Static typing object 800 * @param expr Expression 801 * @param dest Destination type 802 */ 803 static stree_expr_t *stype_convert_tprim_tobj(stype_t *stype, 804 stree_expr_t *expr, tdata_item_t *dest) 805 { 806 tdata_item_t *src; 807 builtin_t *bi; 808 stree_symbol_t *csi_sym; 809 stree_symbol_t *bp_sym; 810 stree_box_t *box; 811 stree_expr_t *bexpr; 812 813 #ifdef DEBUG_TYPE_TRACE 814 printf("Convert primitive type to object.\n"); 815 #endif 816 src = expr->titem; 817 assert(src->tic == tic_tprimitive); 818 assert(dest->tic == tic_tobject); 819 820 bi = stype->program->builtin; 821 csi_sym = csi_to_symbol(dest->u.tobject->csi); 822 823 switch (src->u.tprimitive->tpc) { 824 case tpc_bool: bp_sym = bi->boxed_bool; break; 825 case tpc_char: bp_sym = bi->boxed_char; break; 826 case tpc_int: bp_sym = bi->boxed_int; break; 827 case tpc_nil: assert(b_false); 828 case tpc_string: bp_sym = bi->boxed_string; break; 829 case tpc_resource: 830 stype_convert_failure(stype, src, dest); 831 return expr; 832 } 833 834 /* Target type must be boxed @a src or Object */ 835 if (csi_sym != bp_sym && csi_sym != bi->gf_class) 836 stype_convert_failure(stype, src, dest); 837 838 /* Patch the code to box the primitive value */ 839 box = stree_box_new(); 840 box->arg = expr; 841 bexpr = stree_expr_new(ec_box); 842 bexpr->u.box = box; 843 844 /* No action needed to optionally convert boxed type to Object */ 845 846 return bexpr; 847 } 848 849 /** Convert expression of object type to object type. 850 * 851 * @param stype Static typing object 852 * @param expr Expression 853 * @param dest Destination type 854 */ 855 static stree_expr_t *stype_convert_tobject(stype_t *stype, stree_expr_t *expr, 856 tdata_item_t *dest) 857 { 858 tdata_item_t *src; 859 tdata_item_t *cur; 860 stree_csi_t *cur_csi; 861 tdata_tvv_t *tvv; 862 tdata_item_t *b_ti, *bs_ti; 863 864 #ifdef DEBUG_TYPE_TRACE 865 printf("Convert object type.\n"); 866 #endif 867 list_node_t *ca_n, *da_n; 868 tdata_item_t *carg, *darg; 869 870 src = expr->titem; 871 assert(src->tic == tic_tobject); 872 assert(dest->tic == tic_tobject); 873 874 cur = src; 875 876 while (cur->u.tobject->csi != dest->u.tobject->csi) { 877 878 cur_csi = cur->u.tobject->csi; 879 stype_titem_to_tvv(stype, cur, &tvv); 880 881 if (cur_csi->base_csi_ref != NULL) { 882 run_texpr(stype->program, cur_csi, cur_csi->base_csi_ref, &b_ti); 883 if (b_ti->tic == tic_ignore) { 884 /* An error occured. */ 885 stype_note_error(stype); 886 return expr; 887 } 888 889 tdata_item_subst(b_ti, tvv, &bs_ti); 890 cur = bs_ti; 891 assert(cur->tic == tic_tobject); 892 893 } else if (cur_csi->base_csi != NULL) { 894 /* No explicit reference. Use grandfather class. */ 895 cur = tdata_item_new(tic_tobject); 896 cur->u.tobject = tdata_object_new(); 897 cur->u.tobject->csi = cur_csi->base_csi; 898 cur->u.tobject->static_ref = b_false; 899 900 list_init(&cur->u.tobject->targs); 901 } else { 902 /* No match */ 903 stype_convert_failure(stype, src, dest); 904 return expr; 905 } 906 } 907 908 /* Verify that type arguments match */ 909 ca_n = list_first(&cur->u.tobject->targs); 910 da_n = list_first(&dest->u.tobject->targs); 911 912 while (ca_n != NULL && da_n != NULL) { 913 carg = list_node_data(ca_n, tdata_item_t *); 914 darg = list_node_data(da_n, tdata_item_t *); 915 916 if (tdata_item_equal(carg, darg) != b_true) { 917 /* Diferent argument type */ 918 stype_convert_failure(stype, src, dest); 919 printf("Different argument type '"); 920 tdata_item_print(carg); 921 printf("' vs. '"); 922 tdata_item_print(darg); 923 printf("'.\n"); 924 return expr; 925 } 926 927 ca_n = list_next(&cur->u.tobject->targs, ca_n); 928 da_n = list_next(&dest->u.tobject->targs, da_n); 929 } 930 931 if (ca_n != NULL || da_n != NULL) { 932 /* Diferent number of arguments */ 933 stype_convert_failure(stype, src, dest); 934 printf("Different number of arguments.\n"); 935 return expr; 936 } 937 938 return expr; 939 } 940 941 /** Convert expression of array type to array type. 942 * 943 * @param stype Static typing object 944 * @param expr Expression 945 * @param dest Destination type 946 */ 947 static stree_expr_t *stype_convert_tarray(stype_t *stype, stree_expr_t *expr, 948 tdata_item_t *dest) 949 { 950 tdata_item_t *src; 951 952 #ifdef DEBUG_TYPE_TRACE 953 printf("Convert array type.\n"); 954 #endif 955 src = expr->titem; 956 assert(src->tic == tic_tarray); 957 assert(dest->tic == tic_tarray); 958 959 /* Compare rank and base type. */ 960 if (src->u.tarray->rank != dest->u.tarray->rank) { 961 stype_convert_failure(stype, src, dest); 962 return expr; 963 } 964 965 /* XXX Should we convert each element? */ 966 if (tdata_item_equal(src->u.tarray->base_ti, 967 dest->u.tarray->base_ti) != b_true) { 968 stype_convert_failure(stype, src, dest); 969 } 970 971 return expr; 972 } 973 974 /** Convert expression of delegate type to delegate type. 975 * 976 * @param stype Static typing object 977 * @param expr Expression 978 * @param dest Destination type 979 */ 980 static stree_expr_t *stype_convert_tdeleg(stype_t *stype, stree_expr_t *expr, 981 tdata_item_t *dest) 982 { 983 tdata_item_t *src; 984 tdata_deleg_t *sdeleg, *ddeleg; 985 986 #ifdef DEBUG_TYPE_TRACE 987 printf("Convert delegate type.\n"); 988 #endif 989 src = expr->titem; 990 assert(src->tic == tic_tdeleg); 991 assert(dest->tic == tic_tdeleg); 992 993 sdeleg = src->u.tdeleg; 994 ddeleg = dest->u.tdeleg; 995 996 /* 997 * XXX We need to redesign handling of generic types to handle 998 * delegates in generic CSIs properly. 999 */ 1000 1001 /* Destination should never be anonymous delegate. */ 1002 assert(ddeleg->deleg != NULL); 1003 1004 /* Both must be the same delegate. */ 1005 if (sdeleg->deleg != ddeleg->deleg) { 1006 stype_convert_failure(stype, src, dest); 1007 return expr; 1008 } 1009 1010 return expr; 1011 } 1012 1013 /** Convert expression of function type to delegate type. 1014 * 1015 * @param stype Static typing object 1016 * @param expr Expression 1017 * @param dest Destination type 1018 */ 1019 static stree_expr_t *stype_convert_tfun_tdeleg(stype_t *stype, 1020 stree_expr_t *expr, tdata_item_t *dest) 1021 { 1022 tdata_item_t *src; 1023 tdata_fun_t *sfun; 1024 tdata_deleg_t *ddeleg; 1025 tdata_fun_sig_t *ssig, *dsig; 1026 1027 #ifdef DEBUG_TYPE_TRACE 1028 printf("Convert delegate type.\n"); 1029 #endif 1030 src = expr->titem; 1031 assert(src->tic == tic_tfun); 1032 assert(dest->tic == tic_tdeleg); 1033 1034 sfun = src->u.tfun; 1035 ddeleg = dest->u.tdeleg; 1036 1037 ssig = sfun->tsig; 1038 assert(ssig != NULL); 1039 dsig = stype_deleg_get_sig(stype, ddeleg); 1040 assert(dsig != NULL); 1041 1042 /* Signature type must match. */ 1043 1044 if (!stype_fun_sig_equal(stype, ssig, dsig)) { 1045 stype_convert_failure(stype, src, dest); 1046 return expr; 1047 } 1048 1049 /* 1050 * XXX We should also compare attributes. Either the 1051 * tdeleg should be extended or we should get them 1052 * from stree_deleg. 1053 */ 1054 1055 return expr; 1056 } 1057 1058 1059 /** Convert expression of variable type to variable type. 1060 * 1061 * @param stype Static typing object 1062 * @param expr Expression 1063 * @param dest Destination type 1064 */ 1065 static stree_expr_t *stype_convert_tvref(stype_t *stype, stree_expr_t *expr, 1066 tdata_item_t *dest) 1067 { 1068 tdata_item_t *src; 1069 1070 #ifdef DEBUG_TYPE_TRACE 1071 printf("Convert variable type.\n"); 1072 #endif 1073 src = expr->titem; 1074 1075 /* Currently only allow if both types are the same. */ 1076 if (src->u.tvref->targ != dest->u.tvref->targ) { 1077 stype_convert_failure(stype, src, dest); 1078 return expr; 1079 } 1080 1081 return expr; 1082 } 1083 1084 /** Display conversion error message and note error. 1085 * 1086 * @param stype Static typing object 1087 * @param src Original type 1088 * @param dest Destination type 1089 */ 1090 static void stype_convert_failure(stype_t *stype, tdata_item_t *src, 1091 tdata_item_t *dest) 1092 { 557 1093 printf("Error: Cannot convert "); 558 1094 tdata_item_print(src); … … 562 1098 563 1099 stype_note_error(stype); 564 return expr; 565 } 566 567 /** Return a boolean type item */ 1100 } 1101 1102 /** Determine if two type signatures are equal. 1103 * 1104 * XXX This does not compare the attributes, which are missing from 1105 * @c tdata_fun_sig_t. 1106 * 1107 * @param stype Static typing object 1108 * @param asig First function signature type 1109 * @param bsig Second function signature type 1110 */ 1111 static bool_t stype_fun_sig_equal(stype_t *stype, tdata_fun_sig_t *asig, 1112 tdata_fun_sig_t *bsig) 1113 { 1114 list_node_t *aarg_n, *barg_n; 1115 tdata_item_t *aarg_ti, *barg_ti; 1116 1117 (void) stype; 1118 1119 /* Compare types of arguments */ 1120 aarg_n = list_first(&asig->arg_ti); 1121 barg_n = list_first(&bsig->arg_ti); 1122 1123 while (aarg_n != NULL && barg_n != NULL) { 1124 aarg_ti = list_node_data(aarg_n, tdata_item_t *); 1125 barg_ti = list_node_data(barg_n, tdata_item_t *); 1126 1127 if (!tdata_item_equal(aarg_ti, barg_ti)) 1128 return b_false; 1129 1130 aarg_n = list_next(&asig->arg_ti, aarg_n); 1131 barg_n = list_next(&bsig->arg_ti, barg_n); 1132 } 1133 1134 if (aarg_n != NULL || barg_n != NULL) 1135 return b_false; 1136 1137 /* Compare variadic argument */ 1138 1139 if (asig->varg_ti != NULL || bsig->varg_ti != NULL) { 1140 if (asig->varg_ti == NULL || 1141 bsig->varg_ti == NULL) { 1142 return b_false; 1143 } 1144 1145 if (!tdata_item_equal(asig->varg_ti, bsig->varg_ti)) { 1146 return b_false; 1147 } 1148 } 1149 1150 /* Compare return type */ 1151 if (!tdata_item_equal(asig->rtype, bsig->rtype)) 1152 return b_false; 1153 1154 return b_true; 1155 } 1156 1157 /** Get function signature from delegate. 1158 * 1159 * Function signature can be missing if the delegate type is incomplete. 1160 * This is used to break circular dependency when typing delegates. 1161 * If this happens, we type the delegate, which gives us the signature. 1162 */ 1163 tdata_fun_sig_t *stype_deleg_get_sig(stype_t *stype, tdata_deleg_t *tdeleg) 1164 { 1165 if (tdeleg->tsig == NULL) 1166 stype_deleg(stype, tdeleg->deleg); 1167 1168 /* Now we should have a signature. */ 1169 assert(tdeleg->tsig != NULL); 1170 return tdeleg->tsig; 1171 } 1172 1173 /** Convert tic_tobject type item to TVV, 1174 * 1175 * We split generic type application into two steps. In the first step 1176 * we match argument names of @a ti->csi to argument values in @a ti 1177 * to produce a TVV (name to value map for type arguments). That is the 1178 * purpose of this function. 1179 * 1180 * In the second step we substitute variables in another type item 1181 * with their values using the TVV. This is performed by tdata_item_subst(). 1182 * 1183 * @param stype Static typing object. 1184 * @param ti Type item of class tic_tobject. 1185 * @param rtvv Place to store pointer to new TVV. 1186 */ 1187 void stype_titem_to_tvv(stype_t *stype, tdata_item_t *ti, tdata_tvv_t **rtvv) 1188 { 1189 tdata_tvv_t *tvv; 1190 stree_csi_t *csi; 1191 1192 list_node_t *formal_n; 1193 list_node_t *real_n; 1194 1195 stree_targ_t *formal_arg; 1196 tdata_item_t *real_arg; 1197 1198 assert(ti->tic == tic_tobject); 1199 1200 tvv = tdata_tvv_new(); 1201 intmap_init(&tvv->tvv); 1202 1203 csi = ti->u.tobject->csi; 1204 formal_n = list_first(&csi->targ); 1205 real_n = list_first(&ti->u.tobject->targs); 1206 1207 while (formal_n != NULL && real_n != NULL) { 1208 formal_arg = list_node_data(formal_n, stree_targ_t *); 1209 real_arg = list_node_data(real_n, tdata_item_t *); 1210 1211 /* Store argument value into valuation. */ 1212 tdata_tvv_set_val(tvv, formal_arg->name->sid, real_arg); 1213 1214 formal_n = list_next(&csi->targ, formal_n); 1215 real_n = list_next(&ti->u.tobject->targs, real_n); 1216 } 1217 1218 if (formal_n != NULL || real_n != NULL) { 1219 printf("Error: Incorrect number of type arguments.\n"); 1220 stype_note_error(stype); 1221 1222 /* Fill missing arguments with recovery type items. */ 1223 while (formal_n != NULL) { 1224 formal_arg = list_node_data(formal_n, stree_targ_t *); 1225 /* Store recovery value into valuation. */ 1226 tdata_tvv_set_val(tvv, formal_arg->name->sid, 1227 stype_recovery_titem(stype)); 1228 1229 formal_n = list_next(&csi->targ, formal_n); 1230 } 1231 } 1232 1233 *rtvv = tvv; 1234 } 1235 1236 /** Return a boolean type item. 1237 * 1238 * @param stype Static typing object 1239 * @return New boolean type item. 1240 */ 568 1241 tdata_item_t *stype_boolean_titem(stype_t *stype) 569 1242 { … … 580 1253 } 581 1254 582 /** Find a local variable in the current function. */ 1255 /** Find a local variable in the current function. 1256 * 1257 * @param stype Static typing object 1258 * @param name Name of variable (SID). 1259 * @return Pointer to variable declaration or @c NULL if not 1260 * found. 1261 */ 583 1262 stree_vdecl_t *stype_local_vars_lookup(stype_t *stype, sid_t name) 584 1263 { … … 605 1284 } 606 1285 607 /** Find argument of the current procedure. */ 1286 /** Find argument of the current procedure. 1287 * 1288 * @param stype Static typing object 1289 * @param name Name of argument (SID). 1290 * @return Pointer to argument declaration or @c NULL if not 1291 * found. 1292 */ 608 1293 stree_proc_arg_t *stype_proc_args_lookup(stype_t *stype, sid_t name) 609 1294 { … … 633 1318 fun = symbol_to_fun(outer_sym); 634 1319 assert(fun != NULL); 635 args = &fun-> args;636 varg = fun-> varg;1320 args = &fun->sig->args; 1321 varg = fun->sig->varg; 637 1322 break; 638 1323 case sc_prop: … … 688 1373 } 689 1374 690 /** Note a static typing error that has been immediately recovered. */ 1375 /** Note a static typing error that has been immediately recovered. 1376 * 1377 * @param stype Static typing object 1378 */ 691 1379 void stype_note_error(stype_t *stype) 692 1380 { … … 694 1382 } 695 1383 696 /** Construct a special type item for recovery. */ 1384 /** Construct a special type item for recovery. 1385 * 1386 * The recovery item is propagated towards the expression root and causes 1387 * any further typing errors in the expression to be supressed. 1388 * 1389 * @param stype Static typing object 1390 */ 697 1391 tdata_item_t *stype_recovery_titem(stype_t *stype) 698 1392 { … … 705 1399 } 706 1400 707 /** Get current block visit record. */ 1401 /** Get current block visit record. 1402 * 1403 * @param stype Static typing object 1404 */ 708 1405 stype_block_vr_t *stype_get_current_block_vr(stype_t *stype) 709 1406 { … … 714 1411 } 715 1412 1413 /** Allocate new procedure visit record. 1414 * 1415 * @return New procedure VR 1416 */ 716 1417 stype_proc_vr_t *stype_proc_vr_new(void) 717 1418 { … … 727 1428 } 728 1429 1430 /** Allocate new block visit record. 1431 * 1432 * @return New block VR 1433 */ 729 1434 stype_block_vr_t *stype_block_vr_new(void) 730 1435 { -
uspace/app/sbi/src/stype.h
r80badbe r883fedc 33 33 34 34 void stype_module(stype_t *stype, stree_module_t *module); 35 void stype_deleg(stype_t *stype, stree_deleg_t *deleg); 36 void stype_fun_header(stype_t *stype, stree_fun_t *fun); 35 37 void stype_stat(stype_t *stype, stree_stat_t *stat, bool_t want_value); 36 38 … … 40 42 stree_expr_t *stype_convert(stype_t *stype, stree_expr_t *expr, 41 43 tdata_item_t *dest); 44 45 tdata_fun_sig_t *stype_deleg_get_sig(stype_t *stype, tdata_deleg_t *tdeleg); 46 47 void stype_titem_to_tvv(stype_t *stype, tdata_item_t *ti, tdata_tvv_t **rtvv); 42 48 43 49 tdata_item_t *stype_boolean_titem(stype_t *stype); -
uspace/app/sbi/src/stype_expr.c
r80badbe r883fedc 27 27 */ 28 28 29 /** @file Type expressions. */ 29 /** @file Typing of expressions. 30 * 31 * This module types (data) expressions -- not to be confused with evaluating 32 * type expressions! Thus the type of each (sub-)expression is determined 33 * and stored in its @c titem field. 34 * 35 * It can also happen that, due to implicit conversions, the expression 36 * needs to be patched to insert these conversions. 37 * 38 * If a type error occurs within an expression, @c stype->error is set 39 * and the type of the expression will be @c tic_ignore. This type item 40 * is propagated upwards and causes further typing errors to be ignored 41 * (this prevents a type error avalanche). Type checking is thus resumed 42 * at the next expression. 43 */ 30 44 31 45 #include <stdio.h> … … 103 117 tdata_item_t **rtitem); 104 118 static void stype_as(stype_t *stype, stree_as_t *as_op, tdata_item_t **rtitem); 105 106 107 /** Type expression. */ 119 static void stype_box(stype_t *stype, stree_box_t *box, tdata_item_t **rtitem); 120 121 122 /** Type expression 123 * 124 * The type is stored in @a expr->titem. If the express contains a type error, 125 * @a stype->error will be set when this function returns. 126 * 127 * @param stype Static typing object 128 * @param expr Expression 129 */ 108 130 void stype_expr(stype_t *stype, stree_expr_t *expr) 109 131 { … … 128 150 case ec_assign: stype_assign(stype, expr->u.assign, &et); break; 129 151 case ec_as: stype_as(stype, expr->u.as_op, &et); break; 152 case ec_box: stype_box(stype, expr->u.box, &et); break; 130 153 } 131 154 … … 139 162 } 140 163 141 /** Type name reference. */ 164 /** Type name reference. 165 * 166 * @param stype Static typing object 167 * @param nameref Name reference 168 * @param rtitem Place to store result type 169 */ 142 170 static void stype_nameref(stype_t *stype, stree_nameref_t *nameref, 143 171 tdata_item_t **rtitem) … … 149 177 tdata_object_t *tobject; 150 178 stree_csi_t *csi; 179 stree_deleg_t *deleg; 151 180 stree_fun_t *fun; 152 181 … … 231 260 tobject->csi = csi; 232 261 break; 262 case sc_deleg: 263 printf("referenced name is deleg\n"); 264 deleg = symbol_to_deleg(sym); 265 assert(deleg != NULL); 266 /* Type delegate if it has not been typed yet. */ 267 stype_deleg(stype, deleg); 268 titem = deleg->titem; 269 break; 233 270 case sc_fun: 234 271 fun = symbol_to_fun(sym); 235 272 assert(fun != NULL); 236 237 titem = tdata_item_new(tic_tfun); 238 titem->u.tfun = tdata_fun_new(); 239 titem->u.tfun->fun = fun; 273 /* Type function header if it has not been typed yet. */ 274 stype_fun_header(stype, fun); 275 titem = fun->titem; 240 276 break; 241 277 } … … 244 280 } 245 281 246 /** Type a literal. */ 282 /** Type a literal. 283 * 284 * @param stype Static typing object 285 * @param literal Literal 286 * @param rtitem Place to store result type 287 */ 247 288 static void stype_literal(stype_t *stype, stree_literal_t *literal, 248 289 tdata_item_t **rtitem) … … 272 313 } 273 314 274 /** Type a self reference. */ 315 /** Type @c self reference. 316 * 317 * @param stype Static typing object 318 * @param self_ref @c self reference 319 * @param rtitem Place to store result type 320 */ 275 321 static void stype_self_ref(stype_t *stype, stree_self_ref_t *self_ref, 276 322 tdata_item_t **rtitem) … … 285 331 } 286 332 287 /** Type a binary operation. */ 333 /** Type a binary operation. 334 * 335 * @param stype Static typing object 336 * @param binop Binary operation 337 * @param rtitem Place to store result type 338 */ 288 339 static void stype_binop(stype_t *stype, stree_binop_t *binop, 289 340 tdata_item_t **rtitem) … … 345 396 } 346 397 347 /** Type a binary operation with arguments of primitive type. */ 398 /** Type a binary operation with arguments of primitive type. 399 * 400 * @param stype Static typing object 401 * @param binop Binary operation 402 * @param ta Type of first argument 403 * @param tb Type of second argument 404 * @param rtitem Place to store result type 405 */ 348 406 static void stype_binop_tprimitive(stype_t *stype, stree_binop_t *binop, 349 407 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem) … … 374 432 } 375 433 376 /** Type a binary operation with bool arguments. */ 434 /** Type a binary operation with @c bool arguments. 435 * 436 * @param stype Static typing object 437 * @param binop Binary operation 438 * @param rtitem Place to store result type 439 */ 377 440 static void stype_binop_bool(stype_t *stype, stree_binop_t *binop, 378 441 tdata_item_t **rtitem) … … 408 471 } 409 472 410 /** Type a binary operation with char arguments. */ 473 /** Type a binary operation with @c char arguments. 474 * 475 * @param stype Static typing object 476 * @param binop Binary operation 477 * @param rtitem Place to store result type 478 */ 411 479 static void stype_binop_char(stype_t *stype, stree_binop_t *binop, 412 480 tdata_item_t **rtitem) … … 444 512 } 445 513 446 /** Type a binary operation with int arguments. */ 514 /** Type a binary operation with @c int arguments. 515 * 516 * @param stype Static typing object 517 * @param binop Binary operation 518 * @param rtitem Place to store result type 519 */ 447 520 static void stype_binop_int(stype_t *stype, stree_binop_t *binop, 448 521 tdata_item_t **rtitem) … … 477 550 } 478 551 479 /** Type a binary operation with nil arguments. */ 552 /** Type a binary operation with @c nil arguments. 553 * 554 * @param stype Static typing object 555 * @param binop Binary operation 556 * @param rtitem Place to store result type 557 */ 480 558 static void stype_binop_nil(stype_t *stype, stree_binop_t *binop, 481 559 tdata_item_t **rtitem) … … 488 566 } 489 567 490 /** Type a binary operation with string arguments. */ 568 /** Type a binary operation with @c string arguments. 569 * 570 * @param stype Static typing object 571 * @param binop Binary operation 572 * @param rtitem Place to store result type 573 */ 491 574 static void stype_binop_string(stype_t *stype, stree_binop_t *binop, 492 575 tdata_item_t **rtitem) … … 511 594 } 512 595 513 /** Type a binary operation with resource arguments. */ 596 /** Type a binary operation with resource arguments. 597 * 598 * @param stype Static typing object 599 * @param binop Binary operation 600 * @param rtitem Place to store result type 601 */ 514 602 static void stype_binop_resource(stype_t *stype, stree_binop_t *binop, 515 603 tdata_item_t **rtitem) … … 530 618 } 531 619 532 /** Type a binary operation with arguments of an object type. */ 620 /** Type a binary operation with arguments of an object type. 621 * 622 * @param stype Static typing object 623 * @param binop Binary operation 624 * @param ta Type of first argument 625 * @param tb Type of second argument 626 * @param rtitem Place to store result type 627 */ 533 628 static void stype_binop_tobject(stype_t *stype, stree_binop_t *binop, 534 629 tdata_item_t *ta, tdata_item_t *tb, tdata_item_t **rtitem) … … 561 656 562 657 563 /** Type a unary operation. */ 658 /** Type a unary operation. 659 * 660 * @param stype Static typing object 661 * @param unop Unary operation 662 * @param rtitem Place to store result type 663 */ 564 664 static void stype_unop(stype_t *stype, stree_unop_t *unop, 565 665 tdata_item_t **rtitem) … … 594 694 } 595 695 596 /** Type a binary operation arguments of primitive type. */ 696 /** Type a binary operation arguments of primitive type. 697 * 698 * @param stype Static typing object 699 * @param unop Binary operation 700 * @param ta Type of argument 701 * @param rtitem Place to store result type 702 */ 597 703 static void stype_unop_tprimitive(stype_t *stype, stree_unop_t *unop, 598 704 tdata_item_t *ta, tdata_item_t **rtitem) … … 627 733 } 628 734 629 /** Type a @c new operation. */ 735 /** Type a @c new operation. 736 * 737 * @param stype Static typing object 738 * @param new_op @c new operation 739 * @param rtitem Place to store result type 740 */ 630 741 static void stype_new(stype_t *stype, stree_new_t *new_op, 631 742 tdata_item_t **rtitem) … … 646 757 } 647 758 648 /** Type a field access operation */ 759 /** Type a member access operation. 760 * 761 * @param stype Static typing object 762 * @param access Member access operation 763 * @param rtitem Place to store result type 764 */ 649 765 static void stype_access(stype_t *stype, stree_access_t *access, 650 766 tdata_item_t **rtitem) … … 675 791 stype_access_tarray(stype, access, arg_ti, rtitem); 676 792 break; 793 case tic_tdeleg: 794 printf("Error: Using '.' operator on a function.\n"); 795 stype_note_error(stype); 796 *rtitem = stype_recovery_titem(stype); 797 break; 677 798 case tic_tfun: 678 printf("Error: Using '.' operator on a function.\n"); 679 stype_note_error(stype); 799 printf("Error: Using '.' operator on a delegate.\n"); 800 stype_note_error(stype); 801 *rtitem = stype_recovery_titem(stype); 802 break; 803 case tic_tvref: 804 /* Cannot allow this without some constraint. */ 805 printf("Error: Using '.' operator on generic data.\n"); 680 806 *rtitem = stype_recovery_titem(stype); 681 807 break; … … 686 812 } 687 813 688 /** Type a primitive type access operation. */ 814 /** Type a primitive type access operation. 815 * 816 * @param stype Static typing object 817 * @param access Member access operation 818 * @param arg_ti Base type 819 * @param rtitem Place to store result type 820 */ 689 821 static void stype_access_tprimitive(stype_t *stype, stree_access_t *access, 690 822 tdata_item_t *arg_ti, tdata_item_t **rtitem) … … 701 833 } 702 834 703 /** Type an object access operation. */ 835 /** Type an object access operation. 836 * 837 * @param stype Static typing object 838 * @param access Member access operation 839 * @param arg_ti Base type 840 * @param rtitem Place to store result type 841 */ 704 842 static void stype_access_tobject(stype_t *stype, stree_access_t *access, 705 843 tdata_item_t *arg_ti, tdata_item_t **rtitem) … … 710 848 stree_prop_t *prop; 711 849 tdata_object_t *tobject; 850 tdata_item_t *mtitem; 851 tdata_tvv_t *tvv; 712 852 713 853 #ifdef DEBUG_TYPE_TRACE … … 743 883 stype_note_error(stype); 744 884 *rtitem = stype_recovery_titem(stype); 745 break; 885 return; 886 case sc_deleg: 887 printf("Error: Accessing object member which is a " 888 "delegate.\n"); 889 stype_note_error(stype); 890 *rtitem = stype_recovery_titem(stype); 891 return; 746 892 case sc_fun: 747 893 fun = symbol_to_fun(member_sym); 748 894 assert(fun != NULL); 749 *rtitem = tdata_item_new(tic_tfun);750 (*rtitem)->u.tfun = tdata_fun_new();751 (*rtitem)->u.tfun->fun = fun;895 /* Type function header now */ 896 stype_fun_header(stype, fun); 897 mtitem = fun->titem; 752 898 break; 753 899 case sc_var: 754 900 var = symbol_to_var(member_sym); 755 901 assert(var != NULL); 756 /* XXX Memoize to avoid recomputing every time. */757 902 run_texpr(stype->program, member_sym->outer_csi, 758 var->type, rtitem);903 var->type, &mtitem); 759 904 break; 760 905 case sc_prop: 761 906 prop = symbol_to_prop(member_sym); 762 907 assert(prop != NULL); 763 /* XXX Memoize to avoid recomputing every time. */764 908 run_texpr(stype->program, member_sym->outer_csi, 765 prop->type, rtitem); 766 break; 767 } 768 } 769 770 /** Type an array access operation. */ 909 prop->type, &mtitem); 910 break; 911 } 912 913 /* 914 * Substitute type arguments in member titem. 915 * 916 * Since the CSI can be generic the actual type of the member 917 * is obtained by substituting our type arguments into the 918 * (generic) type of the member. 919 */ 920 921 stype_titem_to_tvv(stype, arg_ti, &tvv); 922 tdata_item_subst(mtitem, tvv, rtitem); 923 } 924 925 /** Type an array access operation. 926 * 927 * @param stype Static typing object 928 * @param access Member access operation 929 * @param arg_ti Base type 930 * @param rtitem Place to store result type 931 */ 771 932 static void stype_access_tarray(stype_t *stype, stree_access_t *access, 772 933 tdata_item_t *arg_ti, tdata_item_t **rtitem) … … 783 944 } 784 945 785 /** Type a call operation. */ 946 /** Type a call operation. 947 * 948 * @param stype Static typing object 949 * @param call Call operation 950 * @param rtitem Place to store result type 951 */ 786 952 static void stype_call(stype_t *stype, stree_call_t *call, 787 953 tdata_item_t **rtitem) 788 954 { 789 list_node_t *farg_n; 790 stree_proc_arg_t *farg; 955 list_node_t *fargt_n; 791 956 tdata_item_t *farg_ti; 792 957 tdata_item_t *varg_ti; … … 797 962 798 963 tdata_item_t *fun_ti; 799 stree_fun_t *fun; 800 stree_symbol_t *fun_sym; 964 tdata_fun_sig_t *tsig; 965 966 int cnt; 801 967 802 968 #ifdef DEBUG_TYPE_TRACE … … 807 973 808 974 /* Check type item class */ 809 810 975 fun_ti = call->fun->titem; 811 976 switch (fun_ti->tic) { 977 case tic_tdeleg: 978 tsig = stype_deleg_get_sig(stype, fun_ti->u.tdeleg); 979 assert(tsig != NULL); 980 break; 812 981 case tic_tfun: 813 /* The expected case */982 tsig = fun_ti->u.tfun->tsig; 814 983 break; 815 984 case tic_ignore: … … 826 995 } 827 996 828 fun = fun_ti->u.tfun->fun;829 fun_sym = fun_to_symbol(fun);830 831 997 /* Type and check the arguments. */ 832 farg _n = list_first(&fun->args);998 fargt_n = list_first(&tsig->arg_ti); 833 999 arg_n = list_first(&call->args); 834 while (farg_n != NULL && arg_n != NULL) { 835 farg = list_node_data(farg_n, stree_proc_arg_t *); 1000 1001 cnt = 0; 1002 while (fargt_n != NULL && arg_n != NULL) { 1003 farg_ti = list_node_data(fargt_n, tdata_item_t *); 836 1004 arg = list_node_data(arg_n, stree_expr_t *); 837 1005 stype_expr(stype, arg); 838 1006 839 1007 /* XXX Because of overloaded bultin WriteLine */ 840 if (farg ->type== NULL) {1008 if (farg_ti == NULL) { 841 1009 /* Skip the check */ 842 farg _n = list_next(&fun->args, farg_n);1010 fargt_n = list_next(&tsig->arg_ti, fargt_n); 843 1011 arg_n = list_next(&call->args, arg_n); 844 1012 continue; 845 1013 } 846 1014 847 /* XXX Memoize to avoid recomputing every time. */848 run_texpr(stype->program, fun_sym->outer_csi, farg->type,849 &farg_ti);850 851 1015 /* Convert expression to type of formal argument. */ 852 1016 carg = stype_convert(stype, arg, farg_ti); … … 855 1019 list_node_setdata(arg_n, carg); 856 1020 857 farg _n = list_next(&fun->args, farg_n);1021 fargt_n = list_next(&tsig->arg_ti, fargt_n); 858 1022 arg_n = list_next(&call->args, arg_n); 859 1023 } 860 1024 861 1025 /* Type and check variadic arguments. */ 862 if (fun->varg != NULL) { 863 /* XXX Memoize to avoid recomputing every time. */ 864 run_texpr(stype->program, fun_sym->outer_csi, fun->varg->type, 865 &farg_ti); 1026 if (tsig->varg_ti != NULL) { 1027 /* Obtain type of packed argument. */ 1028 farg_ti = tsig->varg_ti; 866 1029 867 1030 /* Get array element type */ … … 883 1046 } 884 1047 885 if (farg_n != NULL) { 886 printf("Error: Too few arguments to function '"); 887 symbol_print_fqn(fun_to_symbol(fun)); 888 printf("'.\n"); 1048 if (fargt_n != NULL) { 1049 printf("Error: Too few arguments to function.\n"); 889 1050 stype_note_error(stype); 890 1051 } 891 1052 892 1053 if (arg_n != NULL) { 893 printf("Error: Too many arguments to function '"); 894 symbol_print_fqn(fun_to_symbol(fun)); 895 printf("'.\n"); 896 stype_note_error(stype); 897 } 898 899 if (fun->rtype != NULL) { 900 /* XXX Memoize to avoid recomputing every time. */ 901 run_texpr(stype->program, fun_sym->outer_csi, fun->rtype, 902 rtitem); 1054 printf("Error: Too many arguments to function.\n"); 1055 stype_note_error(stype); 1056 } 1057 1058 if (tsig->rtype != NULL) { 1059 /* XXX Might be better to clone here. */ 1060 *rtitem = tsig->rtype; 903 1061 } else { 904 1062 *rtitem = NULL; … … 906 1064 } 907 1065 908 /** Type an indexing operation. */ 1066 /** Type an indexing operation. 1067 * 1068 * @param stype Static typing object 1069 * @param index Indexing operation 1070 * @param rtitem Place to store result type 1071 */ 909 1072 static void stype_index(stype_t *stype, stree_index_t *index, 910 1073 tdata_item_t **rtitem) … … 939 1102 stype_index_tarray(stype, index, base_ti, rtitem); 940 1103 break; 1104 case tic_tdeleg: 1105 printf("Error: Indexing a delegate.\n"); 1106 stype_note_error(stype); 1107 *rtitem = stype_recovery_titem(stype); 1108 break; 941 1109 case tic_tfun: 942 1110 printf("Error: Indexing a function.\n"); … … 944 1112 *rtitem = stype_recovery_titem(stype); 945 1113 break; 1114 case tic_tvref: 1115 /* Cannot allow this without some constraint. */ 1116 printf("Error: Indexing generic data.\n"); 1117 *rtitem = stype_recovery_titem(stype); 1118 break; 946 1119 case tic_ignore: 947 1120 *rtitem = stype_recovery_titem(stype); … … 950 1123 } 951 1124 952 /** Type a primitive indexing operation. */ 1125 /** Type a primitive indexing operation. 1126 * 1127 * @param stype Static typing object 1128 * @param index Indexing operation 1129 * @param base_ti Base type (primitive being indexed) 1130 * @param rtitem Place to store result type 1131 */ 953 1132 static void stype_index_tprimitive(stype_t *stype, stree_index_t *index, 954 1133 tdata_item_t *base_ti, tdata_item_t **rtitem) … … 977 1156 } 978 1157 979 /** Type an object indexing operation. */ 1158 /** Type an object indexing operation. 1159 * 1160 * @param stype Static typing object 1161 * @param index Indexing operation 1162 * @param base_ti Base type (object being indexed) 1163 * @param rtitem Place to store result type 1164 */ 980 1165 static void stype_index_tobject(stype_t *stype, stree_index_t *index, 981 1166 tdata_item_t *base_ti, tdata_item_t **rtitem) … … 985 1170 stree_prop_t *idx; 986 1171 stree_ident_t *idx_ident; 1172 tdata_item_t *mtitem; 1173 tdata_tvv_t *tvv; 987 1174 988 1175 (void) index; … … 1015 1202 1016 1203 /* XXX Memoize to avoid recomputing every time. */ 1017 run_texpr(stype->program, idx_sym->outer_csi, idx->type, rtitem); 1018 } 1019 1020 /** Type an array indexing operation. */ 1204 run_texpr(stype->program, idx_sym->outer_csi, idx->type, &mtitem); 1205 1206 /* 1207 * Substitute type arguments in member titem. 1208 * 1209 * Since the CSI can be generic the actual type of the member 1210 * is obtained by substituting our type arguments into the 1211 * (generic) type of the member. 1212 */ 1213 1214 stype_titem_to_tvv(stype, base_ti, &tvv); 1215 tdata_item_subst(mtitem, tvv, rtitem); 1216 } 1217 1218 /** Type an array indexing operation. 1219 * 1220 * @param stype Static typing object 1221 * @param index Indexing operation 1222 * @param base_ti Base type (array being indexed) 1223 * @param rtitem Place to store result type 1224 */ 1021 1225 static void stype_index_tarray(stype_t *stype, stree_index_t *index, 1022 1226 tdata_item_t *base_ti, tdata_item_t **rtitem) … … 1058 1262 } 1059 1263 1060 /** Type an assignment. */ 1264 /** Type an assignment. 1265 * 1266 * @param stype Static typing object 1267 * @param assign Assignment operation 1268 * @param rtitem Place to store result type 1269 */ 1061 1270 static void stype_assign(stype_t *stype, stree_assign_t *assign, 1062 1271 tdata_item_t **rtitem) … … 1077 1286 } 1078 1287 1079 /** Type @c as conversion. */ 1288 /** Type @c as conversion. 1289 * 1290 * @param stype Static typing object 1291 * @param as_op @c as conversion operation 1292 * @param rtitem Place to store result type 1293 */ 1080 1294 static void stype_as(stype_t *stype, stree_as_t *as_op, tdata_item_t **rtitem) 1081 1295 { … … 1100 1314 *rtitem = titem; 1101 1315 } 1316 1317 /** Type boxing operation. 1318 * 1319 * While there is no boxing operation on the first typing pass, we do want 1320 * to allow potential re-evaluation (with same results). 1321 * 1322 * @param stype Static typing object 1323 * @param box Boxing operation 1324 * @param rtitem Place to store result type 1325 */ 1326 static void stype_box(stype_t *stype, stree_box_t *box, tdata_item_t **rtitem) 1327 { 1328 tdata_item_t *ptitem, *btitem; 1329 tdata_object_t *tobject; 1330 stree_symbol_t *csi_sym; 1331 builtin_t *bi; 1332 1333 #ifdef DEBUG_TYPE_TRACE 1334 printf("Evaluate type of boxing operation.\n"); 1335 #endif 1336 bi = stype->program->builtin; 1337 1338 stype_expr(stype, box->arg); 1339 ptitem = box->arg->titem; 1340 1341 /* Make compiler happy. */ 1342 csi_sym = NULL; 1343 1344 assert(ptitem->tic == tic_tprimitive); 1345 switch (ptitem->u.tprimitive->tpc) { 1346 case tpc_bool: csi_sym = bi->boxed_bool; break; 1347 case tpc_char: csi_sym = bi->boxed_char; break; 1348 case tpc_int: csi_sym = bi->boxed_int; break; 1349 case tpc_nil: assert(b_false); 1350 case tpc_string: csi_sym = bi->boxed_string; break; 1351 case tpc_resource: assert(b_false); 1352 } 1353 1354 btitem = tdata_item_new(tic_tobject); 1355 tobject = tdata_object_new(); 1356 1357 btitem->u.tobject = tobject; 1358 tobject->static_ref = b_false; 1359 tobject->csi = symbol_to_csi(csi_sym); 1360 assert(tobject->csi != NULL); 1361 list_init(&tobject->targs); 1362 1363 *rtitem = btitem; 1364 } -
uspace/app/sbi/src/symbol.c
r80badbe r883fedc 44 44 static stree_ident_t *symbol_get_ident(stree_symbol_t *symbol); 45 45 46 /** Lookup symbol in CSI using a type expression. */ 46 /** Lookup symbol in CSI using a type expression. 47 * 48 * XXX This should be removed in favor of full type expression evaluation 49 * (run_texpr). This cannot work properly with generics. 50 * 51 * @param prog Program 52 * @param scope CSI used as base for relative references 53 * @param texpr Type expression 54 * 55 * @return Symbol referenced by type expression or @c NULL 56 * if not found 57 */ 47 58 stree_symbol_t *symbol_xlookup_in_csi(stree_program_t *prog, 48 59 stree_csi_t *scope, stree_texpr_t *texpr) … … 77 88 /** Lookup symbol reference in CSI. 78 89 * 79 * @param prog Program to look in .80 * @param scope CSI in @a prog which is the base for references .81 * @param name Identifier of the symbol .82 * 83 * @return Symbol or @c NULL if symbol not found .90 * @param prog Program to look in 91 * @param scope CSI in @a prog which is the base for references 92 * @param name Identifier of the symbol 93 * 94 * @return Symbol or @c NULL if symbol not found 84 95 */ 85 96 stree_symbol_t *symbol_lookup_in_csi(stree_program_t *prog, stree_csi_t *scope, … … 107 118 * Look for symbol in definition of a CSI and its ancestors. (But not 108 119 * in lexically enclosing CSI.) 120 * 121 * @param prog Program to look in 122 * @param scope CSI in which to look 123 * @param name Identifier of the symbol 124 * 125 * @return Symbol or @c NULL if symbol not found. 109 126 */ 110 127 stree_symbol_t *symbol_search_csi(stree_program_t *prog, … … 125 142 while (node != NULL) { 126 143 csimbr = list_node_data(node, stree_csimbr_t *); 144 145 /* Keep compiler happy. */ 146 mbr_name = NULL; 147 127 148 switch (csimbr->cc) { 128 149 case csimbr_csi: mbr_name = csimbr->u.csi->name; break; 150 case csimbr_deleg: mbr_name = csimbr->u.deleg->name; break; 129 151 case csimbr_fun: mbr_name = csimbr->u.fun->name; break; 130 152 case csimbr_var: mbr_name = csimbr->u.var->name; break; 131 153 case csimbr_prop: mbr_name = csimbr->u.prop->name; break; 132 default: assert(b_false);133 154 } 134 155 … … 138 159 case csimbr_csi: 139 160 symbol = csi_to_symbol(csimbr->u.csi); 161 break; 162 case csimbr_deleg: 163 symbol = deleg_to_symbol(csimbr->u.deleg); 140 164 break; 141 165 case csimbr_fun: … … 170 194 } 171 195 196 /** Look for symbol in global scope. 197 * 198 * @param prog Program to look in 199 * @param name Identifier of the symbol 200 * 201 * @return Symbol or @c NULL if symbol not found. 202 */ 172 203 static stree_symbol_t *symbol_search_global(stree_program_t *prog, 173 204 stree_ident_t *name) … … 197 228 } 198 229 199 /** Find entry point. */ 230 /** Find entry point. 231 * 232 * Perform a walk of all CSIs and look for a function with the name @a name. 233 * 234 * @param prog Program to look in 235 * @param name Name of entry point 236 * 237 * @return Symbol or @c NULL if symbol not found. 238 */ 200 239 stree_symbol_t *symbol_find_epoint(stree_program_t *prog, stree_ident_t *name) 201 240 { … … 225 264 } 226 265 266 /** Find entry point under CSI. 267 * 268 * Internal part of symbol_find_epoint() that recursively walks CSIs. 269 * 270 * @param prog Program to look in 271 * @param name Name of entry point 272 * 273 * @return Symbol or @c NULL if symbol not found. 274 */ 227 275 static stree_symbol_t *symbol_find_epoint_rec(stree_program_t *prog, 228 276 stree_ident_t *name, stree_csi_t *csi) … … 267 315 } 268 316 317 /* 318 * The notion of symbol is designed as a common base class for several 319 * types of declarations with global and CSI scope. Here we simulate 320 * conversion from this base class (symbol) to derived classes (CSI, 321 * fun, ..) and vice versa. 322 */ 323 324 /** Convert symbol to delegate (base to derived). 325 * 326 * @param symbol Symbol 327 * @return Delegate or @c NULL if symbol is not a delegate 328 */ 329 stree_deleg_t *symbol_to_deleg(stree_symbol_t *symbol) 330 { 331 if (symbol->sc != sc_deleg) 332 return NULL; 333 334 return symbol->u.deleg; 335 } 336 337 /** Convert delegate to symbol (derived to base). 338 * 339 * @param deleg Delegate 340 * @return Symbol 341 */ 342 stree_symbol_t *deleg_to_symbol(stree_deleg_t *deleg) 343 { 344 assert(deleg->symbol); 345 return deleg->symbol; 346 } 347 348 /** Convert symbol to CSI (base to derived). 349 * 350 * @param symbol Symbol 351 * @return CSI or @c NULL if symbol is not a CSI 352 */ 269 353 stree_csi_t *symbol_to_csi(stree_symbol_t *symbol) 270 354 { … … 275 359 } 276 360 361 /** Convert CSI to symbol (derived to base). 362 * 363 * @param csi CSI 364 * @return Symbol 365 */ 277 366 stree_symbol_t *csi_to_symbol(stree_csi_t *csi) 278 367 { … … 281 370 } 282 371 372 /** Convert symbol to function (base to derived). 373 * 374 * @param symbol Symbol 375 * @return Function or @c NULL if symbol is not a function 376 */ 283 377 stree_fun_t *symbol_to_fun(stree_symbol_t *symbol) 284 378 { … … 289 383 } 290 384 385 /** Convert function to symbol (derived to base). 386 * 387 * @param fun Function 388 * @return Symbol 389 */ 291 390 stree_symbol_t *fun_to_symbol(stree_fun_t *fun) 292 391 { … … 295 394 } 296 395 396 /** Convert symbol to member variable (base to derived). 397 * 398 * @param symbol Symbol 399 * @return Variable or @c NULL if symbol is not a member variable 400 */ 297 401 stree_var_t *symbol_to_var(stree_symbol_t *symbol) 298 402 { … … 303 407 } 304 408 409 /** Convert variable to symbol (derived to base). 410 * 411 * @param fun Variable 412 * @return Symbol 413 */ 305 414 stree_symbol_t *var_to_symbol(stree_var_t *var) 306 415 { … … 309 418 } 310 419 420 /** Convert symbol to property (base to derived). 421 * 422 * @param symbol Symbol 423 * @return Property or @c NULL if symbol is not a property 424 */ 311 425 stree_prop_t *symbol_to_prop(stree_symbol_t *symbol) 312 426 { … … 317 431 } 318 432 433 /** Convert property to symbol (derived to base). 434 * 435 * @param fun Property 436 * @return Symbol 437 */ 319 438 stree_symbol_t *prop_to_symbol(stree_prop_t *prop) 320 439 { … … 323 442 } 324 443 325 /** Print fully qualified name of symbol. */ 444 /** Print fully qualified name of symbol. 445 * 446 * @param symbol Symbol 447 */ 326 448 void symbol_print_fqn(stree_symbol_t *symbol) 327 449 { … … 339 461 } 340 462 463 /** Return symbol identifier. 464 * 465 * @param symbol Symbol 466 * @return Symbol identifier 467 */ 341 468 static stree_ident_t *symbol_get_ident(stree_symbol_t *symbol) 342 469 { … … 345 472 switch (symbol->sc) { 346 473 case sc_csi: ident = symbol->u.csi->name; break; 474 case sc_deleg: ident = symbol->u.deleg->name; break; 347 475 case sc_fun: ident = symbol->u.fun->name; break; 348 476 case sc_var: ident = symbol->u.var->name; break; -
uspace/app/sbi/src/symbol.h
r80badbe r883fedc 40 40 stree_symbol_t *symbol_find_epoint(stree_program_t *prog, stree_ident_t *name); 41 41 42 stree_deleg_t *symbol_to_deleg(stree_symbol_t *symbol); 43 stree_symbol_t *deleg_to_symbol(stree_deleg_t *deleg); 42 44 stree_csi_t *symbol_to_csi(stree_symbol_t *symbol); 43 45 stree_symbol_t *csi_to_symbol(stree_csi_t *csi); -
uspace/app/sbi/src/tdata.c
r80badbe r883fedc 31 31 #include <stdlib.h> 32 32 #include <assert.h> 33 #include "intmap.h" 33 34 #include "list.h" 34 35 #include "mytypes.h" 35 36 #include "stree.h" 37 #include "strtab.h" 36 38 #include "symbol.h" 37 39 38 40 #include "tdata.h" 41 42 static void tdata_item_subst_tprimitive(tdata_primitive_t *torig, 43 tdata_tvv_t *tvv, tdata_item_t **res); 44 static void tdata_item_subst_tobject(tdata_object_t *torig, tdata_tvv_t *tvv, 45 tdata_item_t **res); 46 static void tdata_item_subst_tarray(tdata_array_t *torig, tdata_tvv_t *tvv, 47 tdata_item_t **res); 48 static void tdata_item_subst_tdeleg(tdata_deleg_t *torig, 49 tdata_tvv_t *tvv, tdata_item_t **res); 50 static void tdata_item_subst_tfun(tdata_fun_t *torig, 51 tdata_tvv_t *tvv, tdata_item_t **res); 52 static void tdata_item_subst_tvref(tdata_vref_t *tvref, tdata_tvv_t *tvv, 53 tdata_item_t **res); 54 55 static void tdata_item_subst_fun_sig(tdata_fun_sig_t *torig, tdata_tvv_t *tvv, 56 tdata_fun_sig_t **res); 39 57 40 58 static void tdata_tprimitive_print(tdata_primitive_t *tprimitive); 41 59 static void tdata_tobject_print(tdata_object_t *tobject); 42 60 static void tdata_tarray_print(tdata_array_t *tarray); 61 static void tdata_tdeleg_print(tdata_deleg_t *tdeleg); 43 62 static void tdata_tfun_print(tdata_fun_t *tfun); 44 45 /** Determine if CSI @a a is derived from CSI described by type item @a tb. */ 63 static void tdata_tvref_print(tdata_vref_t *tvref); 64 65 /** Determine if CSI @a a is derived from CSI described by type item @a tb. 66 * 67 * XXX This won't work with generics. 68 * 69 * @param a Potential derived CSI. 70 * @param tb Type of potentail base CSI. 71 */ 46 72 bool_t tdata_is_csi_derived_from_ti(stree_csi_t *a, tdata_item_t *tb) 47 73 { … … 63 89 * Determine if CSI described by type item @a a is derived from CSI described 64 90 * by type item @a tb. 91 * 92 * XXX This is somewhat complementary to stype_convert(). It is used for 93 * the explicit @c as conversion. It should only work for objects and only 94 * allow conversion from base to derived types. We might want to scrap this 95 * for a version specific to @c as. The current code does not work with 96 * generics. 97 * 98 * @param a Potential derived CSI. 99 * @param tb Type of potentail base CSI. 65 100 */ 66 101 bool_t tdata_is_ti_derived_from_ti(tdata_item_t *ta, tdata_item_t *tb) … … 80 115 } 81 116 82 /** Determine if two type items are equal (i.e. describe the same type). */ 117 /** Determine if two type items are equal (i.e. describe the same type). 118 * 119 * Needed to check compatibility of type arguments in which a parametrized 120 * type is not monotonous. 121 * 122 * @param a Type item 123 * @param b Type item 124 * @return @c b_true if equal, @c b_false if not. 125 */ 83 126 bool_t tdata_item_equal(tdata_item_t *a, tdata_item_t *b) 84 127 { … … 114 157 return tdata_item_equal(a->u.tarray->base_ti, 115 158 b->u.tarray->base_ti); 159 case tic_tvref: 160 /* Check if both refer to the same type argument. */ 161 return (a->u.tvref->targ == b->u.tvref->targ); 116 162 default: 117 163 printf("Warning: Unimplemented: Compare types '"); … … 124 170 } 125 171 126 /** Print type item. */ 172 /** Substitute type variables in a type item. 173 * 174 * This is the second part of generic type application. In the first part 175 * obtained a TVV using stype_titem_to_tvv() and in this second part we 176 * actually substitute type variables in a type item for their values. 177 * @a tvv must contain all variables referenced in @a ti. 178 * 179 * @param ti Type item to substitute into. 180 * @param tvv Type variable valuation (values of type variables). 181 * @param res Place to store pointer to new type item. 182 */ 183 void tdata_item_subst(tdata_item_t *ti, tdata_tvv_t *tvv, tdata_item_t **res) 184 { 185 switch (ti->tic) { 186 case tic_tprimitive: 187 tdata_item_subst_tprimitive(ti->u.tprimitive, tvv, res); 188 break; 189 case tic_tobject: 190 tdata_item_subst_tobject(ti->u.tobject, tvv, res); 191 break; 192 case tic_tarray: 193 tdata_item_subst_tarray(ti->u.tarray, tvv, res); 194 break; 195 case tic_tdeleg: 196 tdata_item_subst_tdeleg(ti->u.tdeleg, tvv, res); 197 break; 198 case tic_tfun: 199 tdata_item_subst_tfun(ti->u.tfun, tvv, res); 200 break; 201 case tic_tvref: 202 tdata_item_subst_tvref(ti->u.tvref, tvv, res); 203 break; 204 case tic_ignore: 205 *res = tdata_item_new(tic_ignore); 206 } 207 } 208 209 /** Substitute type variables in a primitive type item. 210 * 211 * @param torig Type item to substitute into. 212 * @param tvv Type variable valuation (values of type variables). 213 * @param res Place to store pointer to new type item. 214 */ 215 static void tdata_item_subst_tprimitive(tdata_primitive_t *torig, 216 tdata_tvv_t *tvv, tdata_item_t **res) 217 { 218 tdata_primitive_t *tnew; 219 220 (void) tvv; 221 222 /* Plain copy */ 223 tnew = tdata_primitive_new(torig->tpc); 224 *res = tdata_item_new(tic_tprimitive); 225 (*res)->u.tprimitive = tnew; 226 } 227 228 /** Substitute type variables in an object type item. 229 * 230 * @param torig Type item to substitute into. 231 * @param tvv Type variable valuation (values of type variables). 232 * @param res Place to store pointer to new type item. 233 */ 234 static void tdata_item_subst_tobject(tdata_object_t *torig, tdata_tvv_t *tvv, 235 tdata_item_t **res) 236 { 237 tdata_object_t *tnew; 238 list_node_t *targ_n; 239 tdata_item_t *targ; 240 tdata_item_t *new_targ; 241 242 /* Copy static ref flag and base CSI. */ 243 tnew = tdata_object_new(); 244 tnew->static_ref = torig->static_ref; 245 tnew->csi = torig->csi; 246 list_init(&tnew->targs); 247 248 /* Substitute arguments */ 249 targ_n = list_first(&torig->targs); 250 while (targ_n != NULL) { 251 targ = list_node_data(targ_n, tdata_item_t *); 252 tdata_item_subst(targ, tvv, &new_targ); 253 list_append(&tnew->targs, new_targ); 254 255 targ_n = list_next(&torig->targs, targ_n); 256 } 257 258 *res = tdata_item_new(tic_tobject); 259 (*res)->u.tobject = tnew; 260 } 261 262 /** Substitute type variables in an array type item. 263 * 264 * @param torig Type item to substitute into. 265 * @param tvv Type variable valuation (values of type variables). 266 * @param res Place to store pointer to new type item. 267 */ 268 static void tdata_item_subst_tarray(tdata_array_t *torig, tdata_tvv_t *tvv, 269 tdata_item_t **res) 270 { 271 tdata_array_t *tnew; 272 list_node_t *ext_n; 273 stree_expr_t *extent; 274 275 tnew = tdata_array_new(); 276 277 /* Substitute base type */ 278 tdata_item_subst(torig->base_ti, tvv, &tnew->base_ti); 279 280 /* Copy rank and extents */ 281 tnew->rank = torig->rank; 282 list_init(&tnew->extents); 283 284 ext_n = list_first(&torig->extents); 285 while (ext_n != NULL) { 286 extent = list_node_data(ext_n, stree_expr_t *); 287 list_append(&tnew->extents, extent); 288 289 ext_n = list_next(&tnew->extents, ext_n); 290 } 291 292 *res = tdata_item_new(tic_tarray); 293 (*res)->u.tarray = tnew; 294 } 295 296 /** Substitute type variables in a delegate type item. 297 * 298 * @param torig Type item to substitute into. 299 * @param tvv Type variable valuation (values of type variables). 300 * @param res Place to store pointer to new type item. 301 */ 302 static void tdata_item_subst_tdeleg(tdata_deleg_t *torig, tdata_tvv_t *tvv, 303 tdata_item_t **res) 304 { 305 tdata_deleg_t *tnew; 306 307 tnew = tdata_deleg_new(); 308 tnew->deleg = torig->deleg; 309 tdata_item_subst_fun_sig(torig->tsig, tvv, &tnew->tsig); 310 311 *res = tdata_item_new(tic_tdeleg); 312 (*res)->u.tdeleg = tnew; 313 } 314 315 /** Substitute type variables in a functional type item. 316 * 317 * @param torig Type item to substitute into. 318 * @param tvv Type variable valuation (values of type variables). 319 * @param res Place to store pointer to new type item. 320 */ 321 static void tdata_item_subst_tfun(tdata_fun_t *torig, tdata_tvv_t *tvv, 322 tdata_item_t **res) 323 { 324 tdata_fun_t *tnew; 325 326 tnew = tdata_fun_new(); 327 tdata_item_subst_fun_sig(torig->tsig, tvv, &tnew->tsig); 328 329 *res = tdata_item_new(tic_tfun); 330 (*res)->u.tfun = tnew; 331 } 332 333 /** Substitute type variables in a type-variable reference item. 334 * 335 * @param torig Type item to substitute into. 336 * @param tvv Type variable valuation (values of type variables). 337 * @param res Place to store pointer to new type item. 338 */ 339 static void tdata_item_subst_tvref(tdata_vref_t *tvref, tdata_tvv_t *tvv, 340 tdata_item_t **res) 341 { 342 tdata_item_t *ti_new; 343 344 ti_new = tdata_tvv_get_val(tvv, tvref->targ->name->sid); 345 assert(ti_new != NULL); 346 347 /* XXX Might be better to clone here. */ 348 *res = ti_new; 349 } 350 351 /** Substitute type variables in a function signature type fragment. 352 * 353 * @param torig Type item to substitute into. 354 * @param tvv Type variable valuation (values of type variables). 355 * @param res Place to store pointer to new type item. 356 */ 357 static void tdata_item_subst_fun_sig(tdata_fun_sig_t *torig, tdata_tvv_t *tvv, 358 tdata_fun_sig_t **res) 359 { 360 tdata_fun_sig_t *tnew; 361 list_node_t *arg_n; 362 tdata_item_t *arg_ti; 363 tdata_item_t *narg_ti; 364 365 tnew = tdata_fun_sig_new(); 366 367 /* Substitute type of each argument */ 368 list_init(&tnew->arg_ti); 369 arg_n = list_first(&torig->arg_ti); 370 while (arg_n != NULL) { 371 arg_ti = list_node_data(arg_n, tdata_item_t *); 372 373 /* XXX Because of overloaded Builtin.WriteLine */ 374 if (arg_ti == NULL) 375 narg_ti = NULL; 376 else 377 tdata_item_subst(arg_ti, tvv, &narg_ti); 378 379 list_append(&tnew->arg_ti, narg_ti); 380 381 arg_n = list_next(&torig->arg_ti, arg_n); 382 } 383 384 /* Substitute type of variadic argument */ 385 if (torig->varg_ti != NULL) 386 tdata_item_subst(torig->varg_ti, tvv, &tnew->varg_ti); 387 388 /* Substitute return type */ 389 if (torig->rtype != NULL) 390 tdata_item_subst(torig->rtype, tvv, &tnew->rtype); 391 392 *res = tnew; 393 } 394 395 396 /** Print type item. 397 * 398 * @param titem Type item 399 */ 127 400 void tdata_item_print(tdata_item_t *titem) 128 401 { … … 142 415 tdata_tarray_print(titem->u.tarray); 143 416 break; 417 case tic_tdeleg: 418 tdata_tdeleg_print(titem->u.tdeleg); 419 break; 144 420 case tic_tfun: 145 421 tdata_tfun_print(titem->u.tfun); 146 422 break; 423 case tic_tvref: 424 tdata_tvref_print(titem->u.tvref); 425 break; 147 426 case tic_ignore: 148 427 printf("ignore"); … … 151 430 } 152 431 432 /** Print primitive type item. 433 * 434 * @param tprimitive Primitive type item 435 */ 153 436 static void tdata_tprimitive_print(tdata_primitive_t *tprimitive) 154 437 { … … 163 446 } 164 447 448 /** Print object type item. 449 * 450 * @param tobject Object type item 451 */ 165 452 static void tdata_tobject_print(tdata_object_t *tobject) 166 453 { … … 182 469 } 183 470 471 /** Print array type item. 472 * 473 * @param tarray Array type item 474 */ 184 475 static void tdata_tarray_print(tdata_array_t *tarray) 185 476 { … … 194 485 } 195 486 487 /** Print delegate type item. 488 * 489 * @param tdeleg Delegate type item 490 */ 491 static void tdata_tdeleg_print(tdata_deleg_t *tdeleg) 492 { 493 stree_symbol_t *deleg_sym; 494 495 deleg_sym = deleg_to_symbol(tdeleg->deleg); 496 symbol_print_fqn(deleg_sym); 497 } 498 499 /** Print function type item. 500 * 501 * @param tfun Function type item 502 */ 196 503 static void tdata_tfun_print(tdata_fun_t *tfun) 197 504 { 198 (void) tfun; 199 printf("unimplemented(fun)"); 200 } 201 505 list_node_t *arg_n; 506 tdata_item_t *arg_ti; 507 bool_t first; 508 509 printf("fun("); 510 511 arg_n = list_first(&tfun->tsig->arg_ti); 512 first = b_true; 513 while (arg_n != NULL) { 514 if (first == b_false) 515 printf("; "); 516 else 517 first = b_false; 518 519 arg_ti = list_node_data(arg_n, tdata_item_t *); 520 tdata_item_print(arg_ti); 521 522 arg_n = list_next(&tfun->tsig->arg_ti, arg_n); 523 } 524 525 printf(") : "); 526 tdata_item_print(tfun->tsig->rtype); 527 } 528 529 /** Print type variable reference type item. 530 * 531 * @param tvref Type variable reference type item 532 */ 533 static void tdata_tvref_print(tdata_vref_t *tvref) 534 { 535 printf("%s", strtab_get_str(tvref->targ->name->sid)); 536 } 537 538 /** Allocate new type item. 539 * 540 * @param tic Type item class 541 * @return New type item 542 */ 202 543 tdata_item_t *tdata_item_new(titem_class_t tic) 203 544 { … … 214 555 } 215 556 557 /** Allocate new array type item. 558 * 559 * @return New array type item 560 */ 216 561 tdata_array_t *tdata_array_new(void) 217 562 { … … 227 572 } 228 573 574 /** Allocate new object type item. 575 * 576 * @return New object type item 577 */ 229 578 tdata_object_t *tdata_object_new(void) 230 579 { … … 240 589 } 241 590 591 /** Allocate new primitive type item. 592 * 593 * @return New primitive type item 594 */ 242 595 tdata_primitive_t *tdata_primitive_new(tprimitive_class_t tpc) 243 596 { … … 254 607 } 255 608 609 /** Allocate new delegate type item. 610 * 611 * @return New function type item 612 */ 613 tdata_deleg_t *tdata_deleg_new(void) 614 { 615 tdata_deleg_t *tdeleg; 616 617 tdeleg = calloc(1, sizeof(tdata_deleg_t)); 618 if (tdeleg == NULL) { 619 printf("Memory allocation failed.\n"); 620 exit(1); 621 } 622 623 return tdeleg; 624 } 625 626 /** Allocate new functional type item. 627 * 628 * @return New function type item 629 */