diff options
| -rw-r--r-- | backend/backendinterface.icl | 20 | ||||
| -rw-r--r-- | frontend/containers.dcl | 1 | ||||
| -rw-r--r-- | frontend/containers.icl | 19 |
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 |