aboutsummaryrefslogtreecommitdiff
path: root/frontend/syntax.icl
diff options
context:
space:
mode:
Diffstat (limited to 'frontend/syntax.icl')
-rw-r--r--frontend/syntax.icl177
1 files changed, 133 insertions, 44 deletions
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index 0c6b9aa..4ad082f 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -48,7 +48,8 @@ instance == FunctionOrMacroIndex
| STE_Field !Ident
| STE_Class
| STE_Member
- | STE_Generic // AA: For generic declarations
+ | STE_Generic // AA
+ | STE_GenericCase // AA
| STE_Instance !Ident // the class (for explicit imports (1.3 syntax only))
| STE_Variable !VarInfoPtr
| STE_TypeVariable !TypeVarInfoPtr
@@ -116,9 +117,10 @@ instance == FunctionOrMacroIndex
, def_macro_indices :: !IndexRange
, def_classes :: ![ClassDef]
, def_members :: ![MemberDef]
- , def_generics :: ![GenericDef] // AA
, def_funtypes :: ![FunType]
, def_instances :: ![instance_kind]
+ , def_generics :: ![GenericDef] // AA
+ , def_generic_cases :: ![GenericCaseDef] // AA
}
:: LocalDefs = LocalParsedDefs [ParsedDefinition] | CollectedLocalDefs CollectedLocalDefs
@@ -165,11 +167,13 @@ cIsNotAFunction :== False
| PD_Type ParsedTypeDef
| PD_TypeSpec Position Ident Priority (Optional SymbolType) Specials
| PD_Class ClassDef [ParsedDefinition]
- | PD_Generic GenericDef // AA
| PD_Instance (ParsedInstance ParsedDefinition)
| PD_Instances [ParsedInstance ParsedDefinition]
| PD_Import [ParsedImport]
| PD_ImportedObjects [ImportedObject]
+ | PD_Generic GenericDef // AA
+ | PD_GenericCase GenericCaseDef // AA
+ | PD_Derive [GenericCaseDef] // AA
| PD_Erroneous
:: StrictnessList = NotStrict | Strict !Int | StrictList !Int StrictnessList
@@ -206,7 +210,6 @@ cNameLocationDependent :== True
, pi_pos :: !Position
, pi_members :: ![member]
, pi_specials :: !Specials
- , pi_generate :: !Bool // AA: instance is to be generated
}
@@ -277,28 +280,62 @@ cNameLocationDependent :== True
// AA..
:: GenericDef =
- { gen_name :: !Ident // the generics name in IC_Class
- , gen_member_name :: !Ident // the generics name in IC_Member
- , gen_type :: !GenericType
+ { gen_name :: !Ident // the generics name in IC_Class
+ , gen_member_name :: !Ident // the generics name in IC_Member
, gen_pos :: !Position
- , gen_kinds_ptr :: !TypeVarInfoPtr // hack: contains all used kinds
- , gen_cons_ptr :: !TypeVarInfoPtr // hack: cons instance function
- , gen_classes :: !GenericClassInfos // generated classes
- , gen_isomap :: !DefinedSymbol // isomap function
+ , gen_type :: !SymbolType // Generic type (st_vars include generic type vars)
+ , gen_vars :: ![TypeVar] // Generic type variables
+ , gen_info_ptr :: !GenericInfoPtr
+ , gen_bimap :: !DefinedSymbol // fun def index of the bimap for the generic type
}
+:: GenericClassInfo =
+ { gci_kind :: !TypeKind // the kind
+ , gci_module :: !Index // filled with main_module_index
+ , gci_class :: !Index // class_index in the main module
+ , gci_member :: !Index // the class member index
+ }
+:: GenericClassInfos :== {[GenericClassInfo]}
+
+:: GenericInfo =
+ { gen_classes :: !GenericClassInfos
+ , gen_cases :: ![GlobalIndex]
+ , gen_var_kinds :: ![TypeKind] // kinds of all st_vars of the gen_type
+ , gen_star_case :: !GlobalIndex // general case for kind-star types
+ }
+:: GenericInfoPtr :== Ptr GenericInfo
+:: GenericHeap :== Heap GenericInfo
+
+:: TypeCons
+ = TypeConsSymb TypeSymbIdent
+ | TypeConsBasic BasicType
+ | TypeConsArrow
+ | TypeConsVar TypeVar
+
+:: GenericCaseDef =
+ { gc_name :: !Ident // name in IC_GenricInstance namespace
+ , gc_gname :: !Ident // name in IC_Generic namespace
+ , gc_generic :: !GlobalIndex // index of the generic
+ , gc_arity :: !Int // number of value arguments
+ , gc_pos :: !Position // position in the source file
+ , gc_type :: !Type // the type argument
+ , gc_type_cons :: !TypeCons // type constructor of the type argument
+ , gc_body :: !GenericCaseBody // the body function or NoIndex
+ , gc_kind :: !TypeKind // kind of the instance type
+ }
+:: GenericCaseBody
+ = GCB_None
+ | GCB_FunIndex !Index
+ | GCB_FunDef !FunDef
+ | GCB_ParsedBody ![ParsedExpr] !Rhs
+
:: GenericType =
{ gt_type :: !SymbolType
, gt_vars :: ![TypeVar] // generic arguments
, gt_arity :: !Int // number of generic arguments
}
-:: GenericClassInfo =
- { gci_kind :: !TypeKind
- , gci_class :: !DefinedSymbol
- }
-:: GenericClassInfos :== [GenericClassInfo]
-
+/*
getGenericClassForKind :: !GenericDef !TypeKind -> (!Bool, DefinedSymbol)
getGenericClassForKind {gen_classes} kind
= get_class gen_classes kind
@@ -319,7 +356,7 @@ addGenericKind generic_def=:{gen_name, gen_classes} kind
, ds_arity = 1
}
= {generic_def & gen_classes = [{gci_kind = kind, gci_class = class_ds}:gen_classes]}
-
+*/
// ..AA
:: InstanceType =
@@ -336,10 +373,7 @@ addGenericKind generic_def=:{gen_name, gen_classes} kind
, ins_members :: !{# DefinedSymbol}
, ins_specials :: !Specials
, ins_pos :: !Position
- , ins_is_generic :: !Bool //AA
- , ins_generate :: !Bool //AA
- , ins_partial :: !Bool //AA
- , ins_generic :: !Global Index //AA
+ , ins_generated :: !Bool // AA
}
:: Import from_symbol =
@@ -400,6 +434,7 @@ cIsAbstractType :== 8
{ gi_module ::!Int
, gi_index ::!Int
}
+NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex}
instance == GlobalIndex
where
@@ -485,6 +520,7 @@ FI_HasTypeSpec :== 2 // whether the function has u user defined type
| TransformedBody !TransformedBody
| Expanding ![FreeVar] // the parameters of the newly generated function
| BackendBody ![BackendBody]
+ | GeneratedBody // the body will be generated automatically - for generics
| NoBody
:: BackendBody =
@@ -883,6 +919,7 @@ cNotVarNumber :== -1
| TVI_Kind !TypeKind
| TVI_ConsInstance !DefinedSymbol //AA: generic cons instance function
| TVI_Normalized !Int /* MV - position of type variable in its definition */
+ | TVI_Expr !Expression /* AA: Expression corresponding to the type var during generic specialization */
:: TypeVarInfoPtr :== Ptr TypeVarInfo
:: TypeVarHeap :== Heap TypeVarInfo
@@ -935,7 +972,7 @@ cNotVarNumber :== -1
:: BasicValue = BVI !String | BVInt !Int |BVC !String | BVB !Bool | BVR !String | BVS !String
-:: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow ![TypeKind] | KindCycle
+:: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow ![TypeKind] | KindCycle | KindError
:: PatternVar =
{ pv_var :: !FreeVar
@@ -985,7 +1022,16 @@ cNotVarNumber :== -1
, tdi_cons_vars :: ![Int]
, tdi_index_in_group :: !Index
, tdi_classification :: !TypeClassification
+ , tdi_mark :: !Bool //AA
+ , tdi_gen_rep :: !Optional GenericTypeRep //AA
+ }
+
+// AA..
+:: GenericTypeRep =
+ { gtr_type :: AType // generic structure type
+ , gtr_iso :: DefinedSymbol // the conversion isomorphism
}
+// ..AA
:: TypeDefInfos :== {# .{# TypeDefInfo}}
@@ -1319,16 +1365,19 @@ instance needs_brackets a
where
needs_brackets _ = False
+instance toString BasicType where
+ toString BT_Int = "Int"
+ toString BT_Char = "Char"
+ toString BT_Real = "Real"
+ toString BT_Bool = "Bool"
+ toString (BT_String _) = "String"
+ toString BT_Dynamic = "Dynamic"
+ toString BT_File = "File"
+ toString BT_World = "World"
+
instance <<< BasicType
where
- (<<<) file BT_Int = file <<< "Int"
- (<<<) file BT_Char = file <<< "Char"
- (<<<) file BT_Real = file <<< "Real"
- (<<<) file BT_Bool = file <<< "Bool"
-/* (<<<) file (BT_String _) = file <<< "String" */
- (<<<) file BT_Dynamic = file <<< "Dynamic"
- (<<<) file BT_File = file <<< "File"
- (<<<) file BT_World = file <<< "World"
+ (<<<) file bt = file <<< toString bt
instance <<< TypeVar
where
@@ -1350,6 +1399,13 @@ where
(<<<) file {at_attribute,at_type}
= file <<< at_attribute <<< at_type
+instance <<< TypeCons
+where
+ (<<<) file (TypeConsSymb name) = file <<< name
+ (<<<) file (TypeConsBasic basic_type) = file <<< basic_type
+ (<<<) file TypeConsArrow = file <<< "(->)"
+ (<<<) file (TypeConsVar tv) = file <<< tv
+
instance <<< TypeAttribute
where
(<<<) file ta
@@ -1575,7 +1631,10 @@ instance <<< Expression
where
(<<<) file (Var ident) = file <<< ident
(<<<) file (App {app_symb, app_args, app_info_ptr})
- = file <<< app_symb <<< ' ' <<< app_args
+ = case app_symb.symb_kind of
+ SK_Generic _ kind
+ -> file <<< app_symb <<< kind <<< ' ' <<< app_args
+ _ -> file <<< app_symb <<< ' ' <<< app_args
(<<<) file (f_exp @ a_exp) = file <<< '(' <<< f_exp <<< " @ " <<< a_exp <<< ')'
(<<<) file (Let {let_info_ptr, let_strict_binds, let_lazy_binds, let_expr})
= write_binds "" (write_binds "!" (file <<< "let" <<< '\n') let_strict_binds) let_lazy_binds <<< "in\n" <<< let_expr
@@ -1781,6 +1840,10 @@ where
(<<<) file FK_Caf = file <<< "FK_Caf"
(<<<) file FK_Unknown = file <<< "FK_Unknown"
+instance <<< FunType
+where
+ (<<<) file {ft_symb,ft_type} = file <<< ft_symb <<< "::" <<< ft_type
+
instance <<< FunDef
where
(<<<) file {fun_symb,fun_body=ParsedBody bodies} = file <<< fun_symb <<< '.' <<< ' ' <<< bodies
@@ -1806,7 +1869,9 @@ where
(<<<) file (TransformedBody {tb_args,tb_rhs}) = file <<< "T " <<< tb_args <<< " = " <<< tb_rhs <<< '\n'
(<<<) file (BackendBody body) = file <<< body <<< '\n'
(<<<) file (Expanding vars) = file <<< "E " <<< vars
+ (<<<) file GeneratedBody = file <<< "Generic function\n"
(<<<) file NoBody = file <<< "Array function\n"
+
instance <<< FunCall
where
@@ -1843,7 +1908,6 @@ where
= write_signs (file <<< '+') (sc_pos_vect bitand (bitnot index_bit)) sc_neg_vect (inc index)
= write_signs (file <<< 'T') (sc_pos_vect bitand (bitnot index_bit)) (sc_neg_vect bitand (bitnot index_bit)) (inc index)
-// AA..
instance toString TypeKind
where
toString (KindVar _) = "**"
@@ -1854,8 +1918,6 @@ where
to_string [k] = toString k
to_string [k:ks] = (toString k) +++ "->" +++ (to_string ks)
-// ..AA
-
instance <<< TypeKind
where
@@ -1921,6 +1983,10 @@ where
= write_data_defs (file <<< d <<< '\n') ds
*/
+instance <<< GenericClassInfo
+where
+ (<<<) file {gci_kind, gci_class} = file <<< gci_kind <<< ":" <<< gci_class
+
instance <<< InstanceType
where
(<<<) file it = write_contexts it.it_context (file <<< it.it_types)
@@ -1981,6 +2047,9 @@ where
(<<<) file (PD_NodeDef _ pattern rhs) = file <<< pattern <<< " =: " <<< rhs
(<<<) file (PD_TypeSpec _ name prio st sp) = file <<< name <<< st
(<<<) file (PD_Type td) = file <<< td
+ (<<<) file (PD_Generic {gen_name}) = file <<< "generic " <<< gen_name
+ (<<<) file (PD_GenericCase {gc_name,gc_type_cons}) = file <<< gc_name <<< "{|" <<< gc_type_cons <<< "|}"
+
(<<<) file _ = file
instance <<< Rhs
@@ -2027,14 +2096,35 @@ instance <<< TypeVarInfo
where
(<<<) file TVI_Empty = file <<< "TVI_Empty"
(<<<) file (TVI_Type _) = file <<< "TVI_Type"
+ (<<<) file (TVI_TypeVar ptr) = file <<< (ptrToInt ptr)
(<<<) file (TVI_Forward _) = file <<< "TVI_Forward"
- (<<<) file (TVI_TypeKind _) = file <<< "TVI_TypeKind"
(<<<) file (TVI_SignClass _ _ _) = file <<< "TVI_SignClass"
+ (<<<) file (TVI_Attribute ta) = file <<< "TVI_Attribute " <<< ta
+ (<<<) file (TVI_CorrespondenceNumber n) = file <<< "TVI_CorrespondenceNumber " <<< n
+ (<<<) file (TVI_AType at) = file <<< "TVI_AType " <<< at
+ (<<<) file TVI_Used = file <<< "TVI_Used"
+ (<<<) file (TVI_TypeCode _) = file <<< "TVI_TypeCode"
+ (<<<) file (TVI_CPSLocalTypeVar _) = file <<< "TVI_CPSLocalTypeVar"
+ (<<<) file (TVI_Kinds _) = file <<< "TVI_Kinds"
+ (<<<) file (TVI_TypeKind _) = file <<< "TVI_TypeKind"
(<<<) file (TVI_PropClass _ _ _) = file <<< "TVI_PropClass"
(<<<) file (TVI_TypeKind kind_info_ptr) = file <<< "TVI_TypeKind " <<< (ptrToInt kind_info_ptr)
(<<<) file (TVI_Kind kind) = file <<< "TVI_Kind" <<< kind
-
+ (<<<) file (TVI_Expr expr) = file <<< "TVI_Expr " <<< expr
+instance <<< AttrVarInfo
+where
+ (<<<) file AVI_Empty = file <<< "AVI_Empty"
+ (<<<) file (AVI_Attr attr) = file <<< "AVI_Attr " <<< attr
+ (<<<) file (AVI_AttrVar av_info_ptr) = file <<< "AVI_AttrVar " <<< ptrToInt av_info_ptr
+ (<<<) file (AVI_Forward temp_attr_id) = file <<< "AVI_Forward " <<< temp_attr_id
+ (<<<) file (AVI_CorrespondenceNumber n) = file <<< "AVI_CorrespondenceNumber " <<< n
+ (<<<) file AVI_Used = file <<< "AVI_Used"
+ (<<<) file (AVI_Count n) = file <<< "AVI_Count " <<< n
+ (<<<) file (AVI_SequenceNumber n) = file <<< "AVI_SequenceNumber " <<< n
+ (<<<) file AVI_Collected = file <<< "AVI_Collected"
+
+
instance <<< (Import from_symbol) | <<< from_symbol
where
(<<<) file {import_module, import_symbols}
@@ -2104,6 +2194,9 @@ where
(<<<) file
STE_Generic
= file <<< "STE_Generic"
+ (<<<) file
+ STE_GenericCase
+ = file <<< "STE_GenericCase"
// ..AA
(<<<) file
(STE_Field _)
@@ -2196,7 +2289,7 @@ abort_empty_SymbolTableEntry = abort "empty SymbolTableEntry"
cNotAGroupNumber :== -1
EmptyTypeDefInfo :== { tdi_kinds = [], tdi_properties = cAllBitsClear, tdi_group = [], tdi_group_vars = [], tdi_cons_vars = [],
- tdi_classification = EmptyTypeClassification, tdi_group_nr = cNotAGroupNumber, tdi_index_in_group = NoIndex }
+ tdi_classification = EmptyTypeClassification, tdi_group_nr = cNotAGroupNumber, tdi_index_in_group = NoIndex, tdi_mark=False, tdi_gen_rep = No }
MakeTypeVar name :== { tv_name = name, tv_info_ptr = nilPtr }
MakeVar name :== { var_name = name, var_info_ptr = nilPtr, var_expr_ptr = nilPtr }
@@ -2241,12 +2334,8 @@ ParsedConstructorToConsDef pc :==
ParsedInstanceToClassInstance pi members :==
{ ins_class = {glob_object = MakeDefinedSymbol pi.pi_class NoIndex (length pi.pi_types), glob_module = NoIndex}, ins_ident = pi.pi_ident,
ins_type = { it_vars = [], it_types = pi.pi_types, it_attr_vars = [],
- it_context = pi.pi_context }, ins_members = members, ins_specials = pi.pi_specials, ins_pos = pi.pi_pos,
- /*AA*/
- ins_is_generic = False,
- ins_generate = pi.pi_generate,
- ins_partial = False,
- ins_generic = {glob_module = NoIndex, glob_object = NoIndex}}
+ it_context = pi.pi_context },
+ ins_members = members, ins_specials = pi.pi_specials, ins_pos = pi.pi_pos, ins_generated = False}
MakeTypeDef name lhs rhs attr contexts pos :==
{ td_name = name, td_index = -1, td_arity = length lhs, td_args = lhs, td_attrs = [], td_attribute = attr, td_context = contexts,