aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--backend/backendinterface.icl20
-rw-r--r--frontend/containers.dcl1
-rw-r--r--frontend/containers.icl19
3 files changed, 21 insertions, 19 deletions
diff --git a/backend/backendinterface.icl b/backend/backendinterface.icl
index 9b08d0f..aa7bc00 100644
--- a/backend/backendinterface.icl
+++ b/backend/backendinterface.icl
@@ -328,25 +328,7 @@ dictionariesToClasses info type=:{st_args, st_args_strictness, st_arity, st_cont
# (reversedTypes, reversedContexts)
= dictionaryArgsToClasses info st_args ([], [])
# n_contexts = length reversedContexts
- # new_st_args_strictness = remove_first_n_strictness_values n_contexts st_args_strictness
- with
- remove_first_n_strictness_values 0 s
- = s
- remove_first_n_strictness_values _ NotStrict
- = NotStrict
- remove_first_n_strictness_values n (Strict s)
- | n<32
- = Strict (((s>>1) bitand 0x7fffffff)>>(n-1))
- = NotStrict
- remove_first_n_strictness_values n (StrictList s l)
- | n<32
- # s2=case l of
- Strict s -> s
- StrictList s _ -> s
- NotStrict -> 0
- # s=(((s>>1) bitand 0x7fffffff)>>(n-1)) bitor (s2<<(32-n))
- = StrictList s (remove_first_n_strictness_values n l)
- = remove_first_n_strictness_values (n-32) l
+ # new_st_args_strictness = remove_first_n n_contexts st_args_strictness
= {type & st_args = reverse reversedTypes, st_context = reverse reversedContexts,
st_arity = st_arity - n_contexts, st_args_strictness=new_st_args_strictness}
diff --git a/frontend/containers.dcl b/frontend/containers.dcl
index de787d6..f0da996 100644
--- a/frontend/containers.dcl
+++ b/frontend/containers.dcl
@@ -37,6 +37,7 @@ add_next_strict :: !Int !Int !StrictnessList -> (!Int,!Int,!StrictnessList)
add_next_not_strict :: !Int !Int !StrictnessList -> (!Int,!Int,!StrictnessList)
append_strictness :: !Int !StrictnessList -> StrictnessList
first_n_are_strict :: !Int !StrictnessList -> Bool
+remove_first_n :: !Int !StrictnessList -> StrictnessList
:: IntKey :== Int
diff --git a/frontend/containers.icl b/frontend/containers.icl
index 4d0282b..6b1cd08 100644
--- a/frontend/containers.icl
+++ b/frontend/containers.icl
@@ -351,6 +351,25 @@ first_n_are_strict n (StrictList s l)
# m=(1<<n)-1
= s bitand m==m
+remove_first_n :: !Int !StrictnessList -> StrictnessList
+remove_first_n 0 s
+ = s
+remove_first_n _ NotStrict
+ = NotStrict
+remove_first_n n (Strict s)
+ | n<32
+ = Strict (((s>>1) bitand 0x7fffffff)>>(n-1))
+ = NotStrict
+remove_first_n n (StrictList s l)
+ | n<32
+ # s2=case l of
+ Strict s -> s
+ StrictList s _ -> s
+ NotStrict -> 0
+ # s=(((s>>1) bitand 0x7fffffff)>>(n-1)) bitor (s2<<(32-n))
+ = StrictList s (remove_first_n n l)
+ = remove_first_n (n-32) l
+
screw :== 80
:: IntKey :== Int