clear_temp_allocator :: () {
arena.clear(^temp_state);
}
-
}
}
-push_end :: (list: ^List, x: list.Elem_Type) {
+push_end :: (list: ^List, x: list.Elem_Type) {
new_elem := allocate_elem(list);
new_elem.data = x;
}
}
-#local iter :: package core.iter
-#match iter.as_iterator get_iterator
+#match core.iter.as_iterator get_iterator
get_iterator :: (list: ^List($T)) -> Iterator(T) {
iterator_next :: (list_iter: ^ListIterator($T)) -> (T, bool) {
if list_iter.current == null do return .{}, false;
return .None, bytes_read;
},
+ write_byte = (use s: ^Socket, byte: u8) -> io.Error {
+ if handle == 0 do return .BadFile;
+
+ bytes_written := __net_send(handle, .[ byte ]);
+ if bytes_written < 0 { s.vtable = null; return .BufferFull; }
+ return .None;
+ },
+
write = (use s: ^Socket, buffer: [] u8) -> (io.Error, u32) {
if handle == 0 do return .BadFile, 0;
Version :: SemVer.{0, 1, 1}
use core
-use core.intrinsics.onyx {__initialize}
global_arguments: struct {
#tag "--config-file"
} = .{};
main :: (args: [] cstr) {
- __initialize(^config);
+ config = .{};
arg_parse.arg_parse(args, ^global_arguments);
}
}
-#tag Command.{ "remove", "Remove a dependency.", "package-or-url",
+#tag Command.{ "remove", "Remove a dependency.", "package-or-url",
"""
package-or-url Git repository name or package name on disk to remove.
"""
attempt_remove_native_library(package_folder);
os.remove_directory(package_folder);
}
-
+
return true;
}
if result != .Success do return false;
if string.is_empty(inner_config.native_library.library) do return false;
- os.remove_file(tprintf("{}/{}{}", config.config.lib_bin_directory, inner_config.native_library.library, native_library_suffix));
+ os.remove_file(tprintf("{}/{}{}", config.config.lib_bin_directory, inner_config.native_library.library, native_library_suffix));
}
return true;
eprintf("Failed to build native library in {}.\n", folder);
return false;
}
-
+
if !os.dir_exists(config.config.lib_bin_directory) {
if !os.dir_create(config.config.lib_bin_directory) {
eprintf("Failed to create native library directory, {}.\n", config.config.lib_bin_directory);
source_path := tprintf("{}/{}{}", installed_dest, inner_config.native_library.library, native_library_suffix);
dest_path := tprintf("{}/{}{}", config.config.lib_bin_directory, inner_config.native_library.library, native_library_suffix);
success := os.rename_file(source_path, dest_path);
-
+
if !success {
eprintf("Failed to move native library to final destination.\n {} -> {}\n", source_path, dest_path);
}
parse :: (semver: ^SemVer, to_parse_: str, _: Allocator) -> bool {
to_parse := to_parse_;
-
+
major := string.read_until(^to_parse, #char ".") |> conv.str_to_i64();
string.advance(^to_parse);
minor := string.read_until(^to_parse, #char ".") |> conv.str_to_i64();
r->skip_whitespace();
if r->is_empty() do return true;
if p, _ := r->peek_byte(); p == #char "[" do return true;
-
+
dep := r->read_until(#char "=") |> string.strip_trailing_whitespace();
r->read_byte();
r->skip_whitespace();
return true;
}
-
-
-
-
-
return 1;
}
}
-
+
onyx_report_error(num->token->pos, Error_Critical, "Unsigned integer constant with value '%l' does not fit into %d-bits.",
num->value.l,
type->Basic.size * 8);
// Here are some of the ways you can unify a node with a type if the type of the
// node does not match the given type:
- //
+ //
// If the nodes type is a function type and that function has an automatic return
// value placeholder, fill in that placeholder with the actual type.
// :AutoReturnType
}
compound->type = type_build_compound_type(context.ast_alloc, compound);
-
+
return TYPE_MATCH_SUCCESS;
}
if (address_of->can_be_removed) {
if (!permanent) {
return unify_node_and_type_(&address_of->expr, type, permanent);
-
+
} else {
*pnode = (AstTyped *) address_of->expr;
return unify_node_and_type_(pnode, type, permanent);
if (elem_type) {
node->type = type_make_array(context.ast_alloc, elem_type, bh_arr_length(al->values));
node->flags |= Ast_Flag_Array_Literal_Typed;
-
+
if (node->entity == NULL) {
add_entities_for_node(NULL, (AstNode *) node, NULL, NULL);
}
if (node->kind == Ast_Kind_Struct_Literal && node->type == NULL) {
AstStructLiteral* sl = (AstStructLiteral *) node;
- assert(sl->stnode == NULL);
- assert(sl->type_node == NULL);
+ if (sl->stnode || sl->type_node) return NULL;
// If values without names are given to a struct literal without
// a type, then we cannot implicitly build the type of the struct
if (node->token) ao->token = node->token;
ao->expr = node;
- return ao;
+ return ao;
}
AstLocal* make_local(bh_allocator a, OnyxToken* token, AstType* type_node) {
void arguments_copy(Arguments* dest, Arguments* src) {
dest->used_argument_count = -1;
dest->named_values = src->named_values;
-
+
bh_arr_grow(dest->values, (u32) bh_arr_length(src->values));
bh_arr_set_length(dest->values, (u32) bh_arr_length(src->values));
bh_arr_each(AstTyped*, arg, dest->values) *arg = NULL;
bh_dir_close(dir);
return success;
-
+
} else if (include->kind == Ast_Kind_Load_Path) {
bh_arr_push(context.options->included_folders, include->name);