diff options
| author | johnvg | 2002-10-18 15:49:24 +0000 |
|---|---|---|
| committer | johnvg | 2002-10-18 15:49:24 +0000 |
| commit | aeaa7c02e0d08e980964fb2b2470bb26f36fd33b (patch) | |
| tree | 7e87a008cf2314c0cd4f251f4dab2c3dfad8801b /backend/backendconvert.icl | |
| parent | add support_dynamics flag to scanModule call (diff) | |
added code for boxed records and lhs uniqueness attribute of
type definitions
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1245 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
Diffstat (limited to 'backend/backendconvert.icl')
| -rw-r--r-- | backend/backendconvert.icl | 25 |
1 files changed, 14 insertions, 11 deletions
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl index 2fe810d..e95566f 100644 --- a/backend/backendconvert.icl +++ b/backend/backendconvert.icl @@ -309,6 +309,8 @@ beAdjustArrayFunction backendId functionIndex moduleIndex :== beApFunction0 (BEAdjustArrayFunction backendId functionIndex moduleIndex) beFlatType :== beFunction2 BEFlatType +//beFlatTypeX +// :== beFunction3 BEFlatTypeX beNoTypeVars :== beFunction0 BENoTypeVars beTypeVars @@ -796,8 +798,9 @@ defineTypes :: ModuleIndex {#ConsDef} {#SelectorDef} {#CheckedTypeDef} -> BackEn defineTypes moduleIndex constructors selectors types = foldStateWithIndexA (defineType moduleIndex constructors selectors) types -convertTypeLhs :: ModuleIndex Index [ATypeVar] -> BEMonad BEFlatTypeP -convertTypeLhs moduleIndex typeIndex args +convertTypeLhs :: ModuleIndex Index TypeAttribute [ATypeVar] -> BEMonad BEFlatTypeP +convertTypeLhs moduleIndex typeIndex attribute args +// = beFlatTypeX (beTypeSymbol typeIndex moduleIndex) (convertAttribution attribute) (convertTypeVars args) = beFlatType (beTypeSymbol typeIndex moduleIndex) (convertTypeVars args) convertTypeVars :: [ATypeVar] -> BEMonad BETypeVarListP @@ -809,18 +812,17 @@ convertTypeVar typeVar = beTypeVarListElem (beTypeVar typeVar.atv_variable.tv_name.id_name) (convertAttribution typeVar.atv_attribute) defineType :: ModuleIndex {#ConsDef} {#SelectorDef} Index CheckedTypeDef *BackEndState -> *BackEndState -defineType moduleIndex constructors _ typeIndex {td_name, td_args, td_rhs=AlgType constructorSymbols} be +defineType moduleIndex constructors _ typeIndex {td_name, td_attribute, td_args, td_rhs=AlgType constructorSymbols} be # (flatType, be) - = convertTypeLhs moduleIndex typeIndex td_args be + = convertTypeLhs moduleIndex typeIndex td_attribute td_args be # (constructors, be) = convertConstructors typeIndex td_name.id_name moduleIndex constructors constructorSymbols be = appBackEnd (BEAlgebraicType flatType constructors) be -defineType moduleIndex constructors selectors typeIndex {td_args, td_rhs=RecordType {rt_constructor, rt_fields}} be +defineType moduleIndex constructors selectors typeIndex {td_attribute, td_args, td_rhs=RecordType {rt_constructor, rt_fields, rt_is_boxed_record}} be // | trace_tn constructorDef.cons_symb # (flatType, be) - = convertTypeLhs moduleIndex typeIndex td_args be + = convertTypeLhs moduleIndex typeIndex td_attribute td_args be # (fields, be) -// = convertSelectors moduleIndex selectors rt_fields be = convertSelectors moduleIndex selectors rt_fields constructorDef.cons_type.st_args_strictness be # (constructorType,be) = constructorTypeFunction be # (constructorTypeNode, be) @@ -829,6 +831,7 @@ defineType moduleIndex constructors selectors typeIndex {td_args, td_rhs=RecordT (convertSymbolTypeArgs constructorType) be = appBackEnd (BERecordType moduleIndex flatType constructorTypeNode fields) be +// = appBackEnd (BERecordTypeX moduleIndex flatType constructorTypeNode (if rt_is_boxed_record 1 0) fields) be where constructorIndex = rt_constructor.ds_index @@ -841,10 +844,10 @@ defineType moduleIndex constructors selectors typeIndex {td_args, td_rhs=RecordT -> (expandedType,be) _ -> (constructorDef.cons_type,be)) -defineType moduleIndex _ _ typeIndex {td_args, td_rhs=AbstractType _} be - = beAbsType (convertTypeLhs moduleIndex typeIndex td_args) be -defineType moduleIndex _ _ typeIndex {td_args, td_rhs=AbstractSynType _ _} be - = beAbsType (convertTypeLhs moduleIndex typeIndex td_args) be +defineType moduleIndex _ _ typeIndex {td_attribute, td_args, td_rhs=AbstractType _} be + = beAbsType (convertTypeLhs moduleIndex typeIndex td_attribute td_args) be +defineType moduleIndex _ _ typeIndex {td_attribute, td_args, td_rhs=AbstractSynType _ _} be + = beAbsType (convertTypeLhs moduleIndex typeIndex td_attribute td_args) be defineType _ _ _ _ _ be = be |