diff options
| author | johnvg | 2002-02-06 13:50:49 +0000 |
|---|---|---|
| committer | johnvg | 2002-02-06 13:50:49 +0000 |
| commit | 18b70304a4a2e4c8481142a2d48469915e0d0bc0 (patch) | |
| tree | a00d8acc0c7425b2d07c72ecf78319702be2013b /frontend/StdCompare.icl | |
| parent | store strictness annotations in SymbolType instead of AType (diff) | |
store strictness annotations in SymbolType instead of AType
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1002 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
Diffstat (limited to 'frontend/StdCompare.icl')
| -rw-r--r-- | frontend/StdCompare.icl | 24 |
1 files changed, 24 insertions, 0 deletions
diff --git a/frontend/StdCompare.icl b/frontend/StdCompare.icl index e14b52f..7495abf 100644 --- a/frontend/StdCompare.icl +++ b/frontend/StdCompare.icl @@ -81,6 +81,12 @@ where = arg_type1 == arg_type2 && restype1 == restype2 equal_constructor_args (TA tc1 types1) (TA tc2 types2) = tc1 == tc2 && types1 == types2 + equal_constructor_args (TA tc1 types1) (TAS tc2 types2 _) + = tc1 == tc2 && types1 == types2 + equal_constructor_args (TAS tc1 types1 _) (TA tc2 types2) + = tc1 == tc2 && types1 == types2 + equal_constructor_args (TAS tc1 types1 _) (TAS tc2 types2 _) + = tc1 == tc2 && types1 == types2 equal_constructor_args (TB tb1) (TB tb2) = tb1 == tb2 equal_constructor_args (type1 :@: types1) (type2 :@: types2) @@ -236,6 +242,9 @@ where where compare_arguments (TB tb1) (TB tb2) = tb1 =< tb2 compare_arguments (TA tc1 _) (TA tc2 _) = tc1 =< tc2 + compare_arguments (TA tc1 _) (TAS tc2 _ _) = tc1 =< tc2 + compare_arguments (TAS tc1 _ _) (TA tc2 _) = tc1 =< tc2 + compare_arguments (TAS tc1 _ _) (TAS tc2 _ _) = tc1 =< tc2 compare_arguments _ _ = Equal smallerOrEqual :: !Type !Type -> CompareValue @@ -251,6 +260,21 @@ smallerOrEqual t1 t2 | cmp_app_symb==Equal = args1 =< args2 = cmp_app_symb + compare_arguments (TA tc1 args1) (TAS tc2 args2 _) + # cmp_app_symb = tc1 =< tc2 + | cmp_app_symb==Equal + = args1 =< args2 + = cmp_app_symb + compare_arguments (TAS tc1 args1 _) (TA tc2 args2) + # cmp_app_symb = tc1 =< tc2 + | cmp_app_symb==Equal + = args1 =< args2 + = cmp_app_symb + compare_arguments (TAS tc1 args1 _) (TAS tc2 args2 _) + # cmp_app_symb = tc1 =< tc2 + | cmp_app_symb==Equal + = args1 =< args2 + = cmp_app_symb compare_arguments (l1 --> r1) (l2 --> r2) # cmp_app_symb = l1 =< l2 | cmp_app_symb==Equal |