## type-types.pkg
#
# Types for core predefined stuff: void, bools, chars, ints, strings, lists, tuples, records,
# plus somewhat more exotic stuff like exceptions, fates, suspensions and spinlocks.
#
# Used pervasively, but especially in package base_types, constructed by
#
# src/lib/compiler/front/semantic/symbolmapstack/base-types-and-ops-symbolmapstack.pkg# Compiled by:
# src/lib/compiler/front/typer/typer.sublibstipulate
#
package ctt = core_type_types; # core_type_types is from src/lib/compiler/front/typer-stuff/types/core-type-types.pkg package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package ip = inverse_path; # inverse_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package ptn = basetype_numbers; # basetype_numbers is from src/lib/compiler/front/typer/basics/base-typ-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 ty = types; # types is from src/lib/compiler/front/typer-stuff/types/types.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkg fun bug msg
=
error_message::impossible("type_types: " + msg);
herein
package type_types
: (weak) Type_Types # Type_Types is from src/lib/compiler/front/typer/types/type-types.api {
# Type and valconstructor symbols:
#
bool_symbol = sy::make_type_symbol "Bool";
list_symbol = sy::make_type_symbol "List";
susp_symbol = sy::make_type_symbol "Susp"; # LAZY Support for 'lazy' functions and datastructures.
#
true_symbol = sy::make_value_symbol "TRUE";
false_symbol = sy::make_value_symbol "FALSE";
nil_symbol = sy::make_value_symbol "NIL";
antiquote_symbol = sy::make_value_symbol "ANTIQUOTE"; # An SML/NJ language extension which we don't currently support.
quote_symbol = sy::make_value_symbol "QUOTE"; # " "
frag_symbol = sy::make_type_symbol "Frag"; # " "
cons_symbol = sy::make_value_symbol "!"; # This is the only valcon which is not uppercase alphabetic.
#
dollar_symbol = sy::make_value_symbol "@@@"; # LAZY
#
void_symbol = /* sy::make_type_symbol "Void" */ ctt::void_symbol;
ref_con_symbol = /* sy::make_value_symbol "REF" */ ctt::ref_con_sym;
#
ref_typ_symbol = /* sy::make_type_symbol "Ref" */ ctt::ref_typ_sym;
# Base type constructors and types:
# Function type constructor:
#
infix my --> ;
#
arrow_stamp = /* sta::make_stale_stamp "->" */ ctt::arrow_stamp;
arrow_typ = ctt::arrow_typ;
my (-->) = ctt::(-->);
# arrowTyp
# =
# BASE_TYP { stamp = arrowStamp, path = ip::INVERSE_PATH [sy::make_type_symbol "->"],
# arity = 2, eq = REF ty::NO,
# kind = ty::BASE ptn::basetype_number_arrow,
# stub = NULL }
# fun t1 --> t2 = ty::TYPCON_TYPE (arrowTyp,[t1, t2])
fun is_arrow_type (ty::TYPCON_TYPE (ty::PLAIN_TYP { stamp, ... }, _))
=>
sta::same_stamp (stamp, arrow_stamp);
is_arrow_type (ty::TYPE_VARIABLE_REF { id, ref_typevar => REF (ty::RESOLVED_TYPE_VARIABLE type) } )
=>
is_arrow_type type;
is_arrow_type _
=>
FALSE;
end;
fun domain (ty::TYPCON_TYPE(_,[type, _]))
=>
type;
domain _
=>
bug "domain";
end;
fun range (ty::TYPCON_TYPE(_,[_, type]))
=>
type;
range _
=>
bug "range";
end;
# ** Base types **
fun make_base_typ (symbol, arity, equality_property, ptn)
=
ty::PLAIN_TYP {
#
stamp => sta::make_stale_stamp symbol,
path => ip::INVERSE_PATH [sy::make_type_symbol symbol],
arity,
#
eqtype_info => REF equality_property,
kind => ty::BASE ptn,
stub => NULL
};
# The Typ/Type distinction below is purely technical.
# Essentially, 'Typ' covers what one usually thinks of as types,
# while 'Type' contains 'Typ' plus 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/types.pkg unt1_typ = make_base_typ ("one_word_unt", 0, ty::eq_type::YES, ptn::basetype_number_int1);
unt1_type = ty::TYPCON_TYPE (unt1_typ, NIL);
w32pair_typ
=
ty::DEFINED_TYP
{
stamp => sta::make_stale_stamp "w32pair",
#
type_scheme => ty::TYPE_SCHEME { arity => 0,
body => ctt::tuple_type [unt1_type, unt1_type]
},
#
path => ip::INVERSE_PATH [sy::make_type_symbol "W32pair"],
strict => []
};
fun make64 symbol
=
ty::PLAIN_TYP
{
stamp => sta::make_stale_stamp symbol,
path => ip::INVERSE_PATH [sy::make_type_symbol symbol],
arity => 0,
#
eqtype_info => REF ty::eq_type::YES,
kind => ty::ABSTRACT w32pair_typ,
stub => NULL
};
int_typ = /* make_base_typ ("Int", 0, ty::eq_type::YES, ptn::basetype_number_tagged_int) */ ctt::int_typ;
int_type = /* ty::TYPCON_TYPE (int_typ, NIL) */ ctt::int_type;
int1_typ = make_base_typ ("Int1", 0, ty::eq_type::YES, ptn::basetype_number_int1);
int1_type = ty::TYPCON_TYPE (int1_typ, NIL);
int2_typ = make64 "Int2";
int2_type = ty::TYPCON_TYPE (int2_typ, []);
multiword_int_typ = make_base_typ ("multiword_int", 0, ty::eq_type::YES, ptn::basetype_number_integer);
multiword_int_type = ty::TYPCON_TYPE (multiword_int_typ, NIL);
float64_typ = /* make_base_typ("Float64", 0, ty::eq_type::NO, ptn::basetype_number_float64) */ ctt::float64_typ;
float64_type = /* ty::TYPCON_TYPE (float64_typ, NIL) */ ctt::float64_type;
unt_typ = make_base_typ("word", 0, ty::eq_type::YES, ptn::basetype_number_tagged_int);
unt_type = ty::TYPCON_TYPE (unt_typ, NIL);
unt8_typ = make_base_typ("word8", 0, ty::eq_type::YES, ptn::basetype_number_tagged_int);
unt8_type = ty::TYPCON_TYPE (unt8_typ, NIL);
unt2_typ = make64 "word64";
unt2_type = ty::TYPCON_TYPE (unt2_typ, []);
string_typ = /* make_base_typ("String", 0, ty::eq_type::YES, ptn::basetype_number_string) */ ctt::string_typ;
string_type = /* ty::TYPCON_TYPE (string_typ, NIL) */ ctt::string_type;
char_typ = /* make_base_typ("char", 0, ty::eq_type::YES, ptn::basetype_number_tagged_int) */ ctt::char_typ;
char_type = /* ty::TYPCON_TYPE (char_typ, NIL) */ ctt::char_type;
exception_typ = /* make_pimitive_type("Exception", 0, ty::NO, ptn::basetype_number_exn) */ ctt::exception_typ;
exception_type = /* ty::TYPCON_TYPE (exnTyp, NIL) */ ctt::exception_type;
fate_typ = make_base_typ("Fate", 1, ty::eq_type::NO, ptn::basetype_number_fate);
control_fate_typ = make_base_typ("Control_Fate", 1, ty::eq_type::NO, ptn::basetype_number_control_fate);
rw_vector_typ = /* make_base_typ( "Rw_Vector", 1, ty::eq_type::CHUNK, ptn::basetype_number_rw_vector) */ ctt::rw_vector_typ;
vector_typ = /* make_base_typ( "Vector", 1, ty::eq_type::YES, ptn::basetype_number_vector) */ ctt::vector_typ;
chunk_typ = make_base_typ( "Chunk", 0, ty::eq_type::NO, ptn::basetype_number_chunk);
c_function_typ = make_base_typ( "c_function", 0, ty::eq_type::NO, ptn::basetype_number_cfun);
un8_rw_vector_typ = make_base_typ( "word8array", 0, ty::eq_type::CHUNK, ptn::basetype_number_barray);
float64_rw_vector_typ = make_base_typ( "Float64_Rw_Vector", 0, ty::eq_type::CHUNK, ptn::basetype_number_rarray);
spinlock_typ = make_base_typ( "Spin_Lock", 0, ty::eq_type::NO, ptn::basetype_number_slock);
# ** building record and product types **
record_type = ctt::record_type;
tuple_type = ctt::tuple_type;
fun get_fields (ty::TYPCON_TYPE (ty::RECORD_TYP _, fl))
=>
THE fl;
get_fields (ty::TYPE_VARIABLE_REF { id, ref_typevar => REF (ty::RESOLVED_TYPE_VARIABLE type) } )
=>
get_fields type;
get_fields _
=>
NULL;
end;
void_typ = ctt::void_typ;
void_type = ctt::void_type; # Mathematically this is a 'unit' (not 'void')
# type since it has one (not zero) values.
# Since we use it the way C etc use 'void',
# we go with the more familiar nomenclature.
# Predefined datatypes:
#
alpha = ty::TYPE_SCHEME_ARG_I 0;
# Base datatypes
# Bool
bool_stamp = /* sta::make_stale_stamp "bool" */ ctt::bool_stamp;
bool_signature = /* CSIG (0, 2) */ ctt::bool_signature;
bool_typ = ctt::bool_typ;
bool_type = ctt::bool_type;
false_dcon = ctt::false_dcon; # "dcon" == "datatype constructor"; should be pervasively renamed to "valcon".
true_dcon = ctt::true_dcon;
ref_typ = ctt::ref_typ;
ref_pattern_type= ctt::ref_pattern_type;
ref_dcon = ctt::ref_dcon;
# Lists:
list_stamp = sta::make_stale_stamp "list";
cons_dom = tuple_type [alpha, ty::TYPCON_TYPE (ty::RECURSIVE_TYPE 0,[alpha])];
list_signature = vh::CONSTRUCTOR_SIGNATURE (1, 1); /* [UNTAGGED, CONSTANT 0], [LISTCONS, LISTNIL] */
list_eq = REF ty::eq_type::YES; # List is an "equality type".
list_kind = ty::DATATYPE
{
index => 0,
stamps => #[ list_stamp ],
free_typs => [],
root => NULL,
#
family => { property_list => property_list::make_property_list (),
mkey => list_stamp,
#
members => #[ { typ_name => list_symbol,
eqtype_info => list_eq,
is_lazy => FALSE,
arity => 1,
an_api => list_signature,
#
constructor_list => [ # Two constructors -- ! and NIL.
{ name => cons_symbol,
form => vh::UNTAGGED,
domain => THE cons_dom
},
{ name => nil_symbol,
form => vh::CONSTANT 0,
domain => NULL
}
]
}
]
}
};
list_typ
=
ty::PLAIN_TYP
{ stamp => list_stamp,
path => ip::INVERSE_PATH [list_symbol],
arity => 1,
#
eqtype_info => list_eq, # Records whether this is an "equality type" -- should be renamed "is_eqtype".
kind => list_kind,
stub => NULL
};
cons_dcon
=
ty::VALCON
{
name => cons_symbol,
is_constant => FALSE,
is_lazy => FALSE,
#
form => vh::UNTAGGED, # was LISTCONS
signature => list_signature,
#
type
=>
ty::TYPE_SCHEME_TYPE
{
type_scheme_arg_eq_properties => [FALSE],
#
type_scheme => ty::TYPE_SCHEME
{ arity => 1,
body => ty::TYPCON_TYPE
( arrow_typ,
[tuple_type [alpha, ty::TYPCON_TYPE (list_typ,[alpha])],
ty::TYPCON_TYPE (list_typ,[alpha])]
)
}
}
};
nil_dcon
=
ty::VALCON
{
name => nil_symbol,
is_constant => TRUE,
is_lazy => FALSE,
form => vh::CONSTANT 0, # was LISTNIL
signature => list_signature,
type
=>
ty::TYPE_SCHEME_TYPE { type_scheme_arg_eq_properties => [FALSE],
type_scheme => ty::TYPE_SCHEME { arity=>1, body=>ty::TYPCON_TYPE (list_typ,[alpha]) }
}
};
# unrolled lists
# should this type have a different stamp from list?
#
ulist_stamp = sta::make_stale_stamp "ulist";
ulistsign = vh::CONSTRUCTOR_SIGNATURE (1, 1); # [LISTCONS, LISTNIL]
ulist_eq = REF ty::eq_type::YES; # Probably records that unrolled-list is an "equality type".
ulist_kind = ty::DATATYPE {
index => 0,
stamps => #[ulist_stamp],
free_typs => [],
root => NULL,
family => { property_list => property_list::make_property_list (),
mkey => ulist_stamp,
members => #[ { typ_name => list_symbol,
eqtype_info =>ulist_eq,
is_lazy=>FALSE,
arity=>1,
an_api=>ulistsign,
constructor_list => [ { name => cons_symbol,
form => vh::LISTCONS,
domain => THE cons_dom
},
{ name => nil_symbol,
form => vh::LISTNIL,
domain => NULL
}
]
}
]
}
};
ulist_typ
=
ty::PLAIN_TYP
{
stamp => ulist_stamp,
path => ip::INVERSE_PATH [ list_symbol ],
arity => 1,
#
eqtype_info => ulist_eq,
kind => ulist_kind,
stub => NULL
};
ucons_dcon
=
ty::VALCON
{
name => cons_symbol,
is_constant => FALSE,
is_lazy => FALSE,
form => vh::LISTCONS,
signature => ulistsign,
type
=>
ty::TYPE_SCHEME_TYPE {
type_scheme_arg_eq_properties => [FALSE],
type_scheme => ty::TYPE_SCHEME {
arity => 1,
body => ty::TYPCON_TYPE (
arrow_typ,
[ tuple_type [ alpha, ty::TYPCON_TYPE (ulist_typ, [alpha] ) ],
ty::TYPCON_TYPE (ulist_typ, [alpha])
]
)
}
}
};
unil_dcon
=
ty::VALCON
{
name => nil_symbol,
is_constant => TRUE,
is_lazy => FALSE,
form => vh::LISTNIL,
signature => ulistsign,
#
type
=>
ty::TYPE_SCHEME_TYPE {
type_scheme_arg_eq_properties => [FALSE],
type_scheme => ty::TYPE_SCHEME {
arity => 1,
body => ty::TYPCON_TYPE (ulist_typ, [ alpha ] )
}
}
};
# frags
antiquote_dom = alpha;
quote_dom = string_type;
frag_stamp = sta::make_stale_stamp "frag";
fragsign = vh::CONSTRUCTOR_SIGNATURE (2, 0); # [TAGGED 0, TAGGED 1]
frageq = REF ty::eq_type::YES;
frag_kind
=
ty::DATATYPE {
index => 0,
stamps => #[ frag_stamp ],
free_typs => [],
root => NULL,
family => { property_list => property_list::make_property_list (),
mkey => frag_stamp,
members => #[ { typ_name => frag_symbol,
eqtype_info => frageq,
is_lazy => FALSE,
#
arity => 1,
an_api => fragsign,
constructor_list => [ { name => antiquote_symbol,
form => vh::TAGGED 0,
domain => THE antiquote_dom
},
{ name => quote_symbol,
form => vh::TAGGED 1,
domain => THE quote_dom
}
]
}
]
}
};
/* predefine path as "lib7::frag", since it will be replicated into
* the Lib7 package */
frag_typ
=
ty::PLAIN_TYP
{
stamp => frag_stamp,
path => ip::INVERSE_PATH [frag_symbol, sy::make_package_symbol "Lib7"],
arity => 1,
#
eqtype_info => frageq,
kind => frag_kind,
stub => NULL
};
antiquotedcon
=
ty::VALCON
{
name => antiquote_symbol,
is_constant => FALSE,
is_lazy => FALSE,
signature => fragsign,
form => vh::TAGGED 0,
type
=>
ty::TYPE_SCHEME_TYPE { type_scheme_arg_eq_properties => [FALSE],
type_scheme => ty::TYPE_SCHEME { arity => 1,
body => ty::TYPCON_TYPE ( arrow_typ,
[ alpha,
ty::TYPCON_TYPE (
frag_typ,
[alpha]
)
]
)
}
}
};
quotedcon
=
ty::VALCON
{
name => quote_symbol,
is_constant => FALSE,
is_lazy => FALSE,
signature => fragsign,
form => vh::TAGGED 1,
type
=>
ty::TYPE_SCHEME_TYPE { type_scheme_arg_eq_properties => [FALSE],
type_scheme => ty::TYPE_SCHEME { arity => 1,
body => ty::TYPCON_TYPE ( arrow_typ,
[ string_type,
ty::TYPCON_TYPE (
frag_typ,
[alpha]
)
]
)
}
}
};
# LAZY: suspensions for supporting lazy evaluation
#
dollar_dom = alpha;
suspension_stamp = sta::make_stale_stamp "suspension";
#
susp_signature = vh::CONSTRUCTOR_SIGNATURE (1, 0);
susp_eq = REF ty::eq_type::NO;
susp_kind = ty::DATATYPE
{
index => 0,
stamps => #[suspension_stamp],
free_typs => [],
root => NULL,
family => { property_list => property_list::make_property_list (),
mkey => suspension_stamp,
members => #[ { typ_name => dollar_symbol,
eqtype_info => susp_eq,
is_lazy => FALSE,
arity => 1,
an_api => susp_signature,
constructor_list => [ { name => dollar_symbol,
form => vh::SUSPENSION NULL,
domain => THE dollar_dom
}
]
}
]
}
};
susp_typ
=
ty::PLAIN_TYP
{
stamp => suspension_stamp,
path => ip::INVERSE_PATH [susp_symbol],
arity => 1,
eqtype_info => susp_eq,
kind => susp_kind,
stub => NULL
};
susp_tyfun
=
ty::TYPE_SCHEME { arity => 1, body => dollar_dom --> ty::TYPCON_TYPE (susp_typ, [alpha]) };
dollar_dcon
=
ty::VALCON
{
name => dollar_symbol,
is_constant => FALSE,
is_lazy => FALSE,
#
signature => susp_signature,
form => vh::SUSPENSION NULL,
type
=>
ty::TYPE_SCHEME_TYPE { type_scheme_arg_eq_properties => [FALSE],
type_scheme => susp_tyfun
}
};
susp_pattern_type
=
ty::TYPE_SCHEME_TYPE {
type_scheme_arg_eq_properties => [FALSE],
type_scheme => susp_tyfun
};
}; # package type_types
end; # stipulate