## unsafe-chunk.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublibstipulate
package ci = mythryl_callable_c_library_interface; # mythryl_callable_c_library_interface is from src/lib/std/src/unsafe/mythryl-callable-c-library-interface.pkgherein
package unsafe_chunk
: Unsafe_Chunk # Unsafe_Chunk is from src/lib/std/src/unsafe/unsafe-chunk.api {
Chunk = core::runtime::Chunk; # core is from src/lib/core/init/core.pkg # Information about the memory representation of a heapchunk.
# NOTE: some of these are not supported yet, but will be once the new
# rw_vector representation is available. XXX BUGGO FIXME
Representation
= UNBOXED # Should probably rename TAGGED_INT. XXX BUGGO FIXME
| UNT1 # Should this be UNT1...? (But it probably includes INT1 as well.)
| FLOAT64
| PAIR
| RECORD
| REF
| TYPEAGNOSTIC_RO_VECTOR
| TYPEAGNOSTIC_RW_VECTOR # Includes REF
| BYTE_RO_VECTOR # Includes vector_of_one_byte_unts::Vector and vector_of_chars::Vector
| BYTE_RW_VECTOR # Includes rw_vector_of_one_byte_unts::Rw_Vector and rw_vector_of_chars::Rw_Vector
# | FLOAT64_RO_VECTOR # Use TYPEAGNOSTIC_RO_VECTOR for now XXX BUGGO FIXME
| FLOAT64_RW_VECTOR
| LAZY_SUSPENSION
| WEAK_POINTER
;
my to_chunk: X -> Chunk = inline_t::cast;
stipulate
my make_single_slot_tuple: Chunk -> Chunk
=
ci::find_c_function { lib_name => "heap", fun_name => "make_single_slot_tuple" }; # "make_single_slot_tuple" def in src/c/lib/heap/make-single-slot-tuple.c
my concatenate_two_tuples: (Chunk, Chunk) -> Chunk # Concatenate two tuples.
=
ci::find_c_function { lib_name => "heap", fun_name => "concatenate_two_tuples" }; # "concatenate_two_tuples" def in src/c/lib/heap/concatenate-two-tuples.c
herein
fun make_tuple [] => to_chunk();
make_tuple [a] => make_single_slot_tuple a;
make_tuple [a, b] => to_chunk (a, b);
make_tuple [a, b, c] => to_chunk (a, b, c);
make_tuple [a, b, c, d] => to_chunk (a, b, c, d);
make_tuple (a ! b ! c ! d ! r) => concatenate_two_tuples (to_chunk (a, b, c, d), make_tuple r);
end;
end; # with
boxed = inline_t::boxed;
unboxed = inline_t::unboxed;
fun rep chunk
=
if (unboxed chunk)
#
UNBOXED;
else
case (inline_t::gettag chunk) # gettag returns (b-tag << 2 | a-tag) -- a-tag will always be '2' in this context.
#
0x02 => # b-tag == 0 == pairs_and_records_btag from src/lib/compiler/back/low/main/main/heap-tags.pkg #
if (inline_t::chunklength chunk == 2) PAIR;
else RECORD;
fi;
0x06 => # b-tag == 1 == ro_vector_header_btag from src/lib/compiler/back/low/main/main/heap-tags.pkg #
case (inline_t::chunklength chunk)
#
0 => TYPEAGNOSTIC_RO_VECTOR;
1 => BYTE_RO_VECTOR;
_ => raise exception FAIL "unknown vec_hdr";
esac;
0x0a => # b-tag == 2 == rw_vector_header_btag from src/lib/compiler/back/low/main/main/heap-tags.pkg #
case (inline_t::chunklength chunk)
#
0 => TYPEAGNOSTIC_RW_VECTOR;
1 => BYTE_RW_VECTOR;
6 => FLOAT64_RW_VECTOR;
_ => raise exception FAIL "unknown arr_hdr";
esac;
0x0e => # b-tag == 3 == rw_vector_data_btag / refcell_btag from src/lib/compiler/back/low/main/main/heap-tags.pkg #
if (inline_t::chunklength chunk == 1) REF;
else raise exception FAIL "Unknown arr_data";
fi;
0x12 => UNT1; # four_byte_aligned_nonpointer_data_btag from src/lib/compiler/back/low/main/main/heap-tags.pkg 0x16 => FLOAT64; # eight_byte_aligned_nonpointer_data_btag from src/lib/compiler/back/low/main/main/heap-tags.pkg 0x1a => # weak_pointer_or_suspension_btag from src/lib/compiler/back/low/main/main/heap-tags.pkg #
case (inline_t::getspecial chunk)
#
(0 | 1) => LAZY_SUSPENSION;
(2 | 3) => WEAK_POINTER;
_ => raise exception FAIL "unknown special";
esac;
_ => PAIR; # tagless pair
esac;
fi;
exception REPRESENTATION;
fun length chunk
=
case (rep chunk)
#
PAIR => 2;
UNBOXED => raise exception REPRESENTATION;
_ => inline_t::chunklength chunk;
esac;
fun nth (chunk, n)
=
case (rep chunk)
#
PAIR =>
if (0 <= n and n < 2) inline_t::record_get (chunk, n);
else raise exception REPRESENTATION;
fi;
RECORD
=>
{ len = inline_t::chunklength chunk;
if (0 <= n and n < len) inline_t::record_get (chunk, n);
else raise exception REPRESENTATION;
fi;
};
FLOAT64 =>
{ len = inline_t::ti::rshift (inline_t::chunklength chunk, 1);
if (n < 0 or len <= n) raise exception REPRESENTATION;
else
if (n == 0) chunk; # flat singleton tuple
else inline_t::cast (inline_t::raw64get (chunk, n));
fi;
fi;
};
_ => raise exception REPRESENTATION;
esac;
fun to_tuple chunk
=
case (rep chunk)
#
UNBOXED => if( ((inline_t::cast chunk) : Int) == 0 )
[];
else
raise exception REPRESENTATION;
fi;
PAIR => [
inline_t::record_get (chunk, 0),
inline_t::record_get (chunk, 1)
];
RECORD => {
fun f i = inline_t::record_get (chunk, i);
list::tabulate (inline_t::chunklength chunk, f);
};
FLOAT64 => {
len = inline_t::ti::rshift (inline_t::chunklength chunk, 1);
fun f i = (inline_t::cast (inline_t::raw64get (chunk, i)) : Chunk);
if (len == 1 )
[chunk];
else
list::tabulate (len, f);
fi;
};
_ => raise exception REPRESENTATION;
esac;
fun to_string chunk
=
case (rep chunk)
#
BYTE_RO_VECTOR => (inline_t::cast chunk): String;
_ => raise exception REPRESENTATION;
esac;
fun to_ref chunk
=
if (rep chunk == REF) (inline_t::cast chunk): Ref(Chunk);
else raise exception REPRESENTATION;
fi;
fun to_rw_vector chunk
=
case (rep chunk)
#
TYPEAGNOSTIC_RW_VECTOR => (inline_t::cast chunk): Rw_Vector(Chunk);
_ => raise exception REPRESENTATION;
esac;
fun to_float64_rw_vector chunk
=
case (rep chunk)
#
FLOAT64_RW_VECTOR => (inline_t::cast chunk): rw_vector_of_eight_byte_floats::Rw_Vector;
_ => raise exception REPRESENTATION;
esac;
fun to_byte_rw_vector chunk
=
case (rep chunk)
#
BYTE_RW_VECTOR => (inline_t::cast chunk): rw_vector_of_one_byte_unts::Rw_Vector;
_ => raise exception REPRESENTATION;
esac;
fun to_vector chunk
=
case (rep chunk)
#
TYPEAGNOSTIC_RO_VECTOR => (inline_t::cast chunk): Vector(Chunk);
_ => raise exception REPRESENTATION;
esac;
fun to_byte_vector chunk
=
case (rep chunk)
#
BYTE_RO_VECTOR => (inline_t::cast chunk): vector_of_one_byte_unts::Vector;
_ => raise exception REPRESENTATION;
esac;
fun to_exn chunk
=
if (rep chunk == RECORD
and inline_t::chunklength chunk == 3) (inline_t::cast chunk): Exception;
else raise exception REPRESENTATION;
fi;
fun to_float chunk
=
case (rep chunk)
#
FLOAT64 => (inline_t::cast chunk): Float;
_ => raise exception REPRESENTATION;
esac;
fun to_int chunk
=
if (unboxed chunk) (inline_t::cast chunk): Int;
else raise exception REPRESENTATION;
fi;
fun to_int1 chunk
=
if (rep chunk == UNT1) (inline_t::cast chunk): one_word_int::Int;
else raise exception REPRESENTATION;
fi;
fun to_unt chunk
=
if (unboxed chunk) (inline_t::cast chunk): Unt;
else raise exception REPRESENTATION;
fi;
fun to_unt8 chunk
=
if (unboxed chunk) (inline_t::cast chunk): one_byte_unt::Unt;
else raise exception REPRESENTATION;
fi;
fun to_unt1 chunk
=
if (rep chunk == UNT1) (inline_t::cast chunk): one_word_unt::Unt;
else raise exception REPRESENTATION;
fi;
};
end;