## core-type-types.pkg
#
# Define some really basic bool/int/string/... type stuff.
# Later this gets expanded upon in
#
# src/lib/compiler/front/typer/types/more-type-types.pkg# Compiled by:
# src/lib/compiler/front/typer-stuff/typecheckdata.sublib# a generic part of more-type-types.pkg (not Mythryl-specific)
stipulate
package ip = inverse_path; # inverse_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package cbn = core_basetype_numbers; # core_basetype_numbers is from src/lib/compiler/front/typer-stuff/basics/core-basetype-numbers.pkg package sta = stamp; # stamp is from src/lib/compiler/front/typer-stuff/basics/stamp.pkg package sy = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkgherein
package core_type_types: (weak) api {
arrow_stamp: sta::Stamp;
arrow_type: tdt::Type;
--> : (tdt::Typoid, tdt::Typoid) -> tdt::Typoid;
ref_stamp: sta::Stamp;
ref_type_symbol: sy::Symbol;
ref_con_symbol: sy::Symbol;
ref_type: tdt::Type;
ref_valcon: tdt::Valcon;
ref_pattern_typoid: tdt::Typoid;
bool_stamp: sta::Stamp;
bool_symbol: sy::Symbol;
false_symbol: sy::Symbol;
true_symbol: sy::Symbol;
bool_signature: vh::Valcon_Signature;
void_symbol: sy::Symbol;
# The Type/Typoid distinction below is purely technical.
# Essentially, 'Type' covers what one usually thinks of as types,
# while 'Typoid' contains 'Type' plus typelike stuff like wildcard types,
# type variables and type schemes. Depending on code context,
# sometimes we need one and sometimes the other, so we provide both.
# For details see:
#
# src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg void_type: tdt::Type;
void_typoid: tdt::Typoid;
bool_type: tdt::Type;
bool_typoid: tdt::Typoid;
false_valcon: tdt::Valcon;
true_valcon: tdt::Valcon;
int_type: tdt::Type;
int_typoid: tdt::Typoid;
string_type: tdt::Type;
string_typoid: tdt::Typoid;
char_type: tdt::Type;
char_typoid: tdt::Typoid;
float64_type: tdt::Type;
float64_typoid: tdt::Typoid;
exception_type: tdt::Type;
exception_typoid: tdt::Typoid;
rw_vector_type: tdt::Type;
ro_vector_type: tdt::Type;
tuple_typoid: List( tdt::Typoid ) -> tdt::Typoid;
record_typoid: List( (tdt::Label, tdt::Typoid) ) -> tdt::Typoid;
}
{
arrow_stamp = sta::make_static_stamp "->";
ref_stamp = sta::make_static_stamp "REF";
bool_stamp = sta::make_static_stamp "Bool";
void_symbol = sy::make_type_symbol "Void";
ref_type_symbol = sy::make_type_symbol "Ref";
ref_con_symbol = sy::make_value_symbol "REF";
bool_symbol = sy::make_type_symbol "Bool";
false_symbol = sy::make_value_symbol "FALSE";
true_symbol = sy::make_value_symbol "TRUE";
fun tc2t type
=
tdt::TYPCON_TYPOID (type, []);
void_type = tdt::NAMED_TYPE { stamp => sta::make_static_stamp "Void",
strict => [],
namepath => ip::INVERSE_PATH [void_symbol],
#
typescheme => tdt::TYPESCHEME { arity => 0,
body => tdt::TYPCON_TYPOID (tuples::make_tuple_type 0, [])
}
};
void_typoid = tc2t void_type;
fun pt2tc (symbol, arity, equality_property, ptn)
=
tdt::SUM_TYPE { stamp => sta::make_static_stamp symbol,
namepath => ip::INVERSE_PATH [sy::make_type_symbol symbol],
arity,
#
is_eqtype => REF equality_property,
kind => tdt::BASE ptn,
stub => NULL
};
fun pt2tct args
=
{ type = pt2tc args;
#
(type, tc2t type);
};
my ( int_type, int_typoid) = pt2tct ("Int", 0, tdt::e::YES, cbn::basetype_number_int );
my ( string_type, string_typoid) = pt2tct ("String", 0, tdt::e::YES, cbn::basetype_number_string );
my ( char_type, char_typoid) = pt2tct ("Char", 0, tdt::e::YES, cbn::basetype_number_int );
my ( float64_type, float64_typoid) = pt2tct ("Float", 0, tdt::e::YES, cbn::basetype_number_float64 ); # FloatAsEqualityType: Changes tdt::e::NO -> tdt::e::YES here in hope of making floats back into an equality type -- 2013-12-29 CrT
my (exception_type, exception_typoid) = pt2tct ("Exception", 0, tdt::e::NO, cbn::basetype_number_exception );
rw_vector_type = pt2tc ("Rw_Vector", 1, tdt::e::CHUNK, cbn::basetype_number_rw_vector );
ro_vector_type = pt2tc ("Vector", 1, tdt::e::YES, cbn::basetype_number_ro_vector);
arrow_type
=
tdt::SUM_TYPE
{
stamp => arrow_stamp,
namepath => ip::INVERSE_PATH [sy::make_type_symbol "->"],
arity => 2,
#
is_eqtype => REF tdt::e::NO,
kind => tdt::BASE cbn::basetype_number_arrow,
stub => NULL
};
infix my --> ;
fun t1 --> t2
=
tdt::TYPCON_TYPOID (arrow_type, [t1, t2]);
fun record_typoid (fields: List( (tdt::Label, tdt::Typoid)) )
=
tdt::TYPCON_TYPOID (tuples::make_record_type (map #1 fields), map #2 fields);
fun tuple_typoid types
=
tdt::TYPCON_TYPOID (tuples::make_tuple_type (length types), types);
my (ref_type, ref_pattern_typoid, ref_valcon)
=
{ eq_ref = REF tdt::e::CHUNK;
alpha = tdt::TYPESCHEME_ARG 0;
ref_dom = alpha;
refsign = vh::CONSTRUCTOR_SIGNATURE (1, 0);
ref_type = tdt::SUM_TYPE
{
stub => NULL,
stamp => ref_stamp,
namepath => ip::INVERSE_PATH [ ref_type_symbol ],
#
arity => 1,
is_eqtype => eq_ref,
kind => tdt::SUMTYPE
{
index => 0,
stamps => #[ref_stamp],
free_types => [],
root => NULL,
family => { property_list => property_list::make_property_list (),
mkey => ref_stamp,
members => #[ { name_symbol => ref_type_symbol,
is_eqtype => eq_ref,
is_lazy => FALSE,
arity => 1,
an_api => vh::CONSTRUCTOR_SIGNATURE (1, 0),
#
valcons => [ { name => ref_con_symbol,
form => vh::REFCELL_REP,
domain => THE ref_dom
}
]
}
]
}
}
};
ref_tyfun
=
tdt::TYPESCHEME { arity => 1, body => alpha --> tdt::TYPCON_TYPOID (ref_type, [alpha]) };
ref_pattern_typoid
=
tdt::TYPESCHEME_TYPOID {
typescheme_eqflags => [FALSE],
typescheme => ref_tyfun
};
ref_valcon = tdt::VALCON
{
name => ref_con_symbol,
is_constant => FALSE,
is_lazy => FALSE,
form => vh::REFCELL_REP,
typoid => ref_pattern_typoid,
signature => refsign
};
(ref_type, ref_pattern_typoid, ref_valcon);
};
bool_signature = vh::CONSTRUCTOR_SIGNATURE (0, 2);
my (bool_type, bool_typoid, false_valcon, true_valcon)
=
{ booleq = REF tdt::e::YES;
bool_type
=
tdt::SUM_TYPE
{
stamp => bool_stamp,
namepath => ip::INVERSE_PATH [bool_symbol],
arity => 0,
#
is_eqtype => booleq,
stub => NULL,
kind => tdt::SUMTYPE
{
index => 0,
stamps => #[ bool_stamp ],
free_types => [],
root => NULL,
family => { property_list => property_list::make_property_list (),
mkey => bool_stamp,
#
members => #[ { name_symbol => bool_symbol,
is_eqtype => booleq,
is_lazy => FALSE,
arity => 0,
an_api => bool_signature,
#
valcons => [ { name => false_symbol,
form => vh::CONSTANT 0,
domain => NULL
},
{ name => true_symbol,
form => vh::CONSTANT 1,
domain => NULL
}
]
}
]
}
}
};
bool_typoid = tdt::TYPCON_TYPOID (bool_type, []);
false_valcon = tdt::VALCON
{
name => false_symbol,
is_constant => TRUE,
is_lazy => FALSE,
form => vh::CONSTANT 0,
typoid => bool_typoid,
signature => bool_signature
};
true_valcon = tdt::VALCON
{
name => true_symbol,
is_constant => TRUE,
is_lazy => FALSE,
form => vh::CONSTANT 1,
typoid => bool_typoid,
signature => bool_signature
};
(bool_type, bool_typoid, false_valcon, true_valcon);
};
};
end;