Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
I
integer-simple
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Iterations
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
This is an archived project. Repository and other project resources are read-only.
Show more breadcrumbs
Glasgow Haskell Compiler
Packages
integer-simple
Commits
d29bbf1c
Commit
d29bbf1c
authored
13 years ago
by
Ian Lynagh
Browse files
Options
Downloads
Patches
Plain Diff
Make pattern matches more obviously complete
Fixes the build when compiling with -O0
parent
f7202d16
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
GHC/Integer/Type.hs
+58
-38
58 additions, 38 deletions
GHC/Integer/Type.hs
with
58 additions
and
38 deletions
GHC/Integer/Type.hs
+
58
−
38
View file @
d29bbf1c
...
...
@@ -301,15 +301,20 @@ negateInteger (Negative p) = Positive p
negateInteger
Naught
=
Naught
plusInteger
::
Integer
->
Integer
->
Integer
Positive
p1
`
plusInteger
`
Positive
p2
=
Positive
(
p1
`
plusPositive
`
p2
)
Negative
p1
`
plusInteger
`
Negative
p2
=
Negative
(
p1
`
plusPositive
`
p2
)
Positive
p1
`
plusInteger
`
Negative
p2
=
case
p1
`
comparePositive
`
p2
of
GT
->
Positive
(
p1
`
minusPositive
`
p2
)
EQ
->
Naught
LT
->
Negative
(
p2
`
minusPositive
`
p1
)
Negative
p1
`
plusInteger
`
Positive
p2
=
Positive
p2
`
plusInteger
`
Negative
p1
Naught
`
plusInteger
`
(
!
i
)
=
i
(
!
i
)
`
plusInteger
`
Naught
=
i
Positive
p1
`
plusInteger
`
Positive
p2
=
Positive
(
p1
`
plusPositive
`
p2
)
Negative
p1
`
plusInteger
`
Negative
p2
=
Negative
(
p1
`
plusPositive
`
p2
)
Positive
p1
`
plusInteger
`
Negative
p2
=
case
p1
`
comparePositive
`
p2
of
GT
->
Positive
(
p1
`
minusPositive
`
p2
)
EQ
->
Naught
LT
->
Negative
(
p2
`
minusPositive
`
p1
)
Negative
p1
`
plusInteger
`
Positive
p2
=
Positive
p2
`
plusInteger
`
Negative
p1
Naught
`
plusInteger
`
Naught
=
Naught
Naught
`
plusInteger
`
i
@
(
Positive
_
)
=
i
Naught
`
plusInteger
`
i
@
(
Negative
_
)
=
i
i
@
(
Positive
_
)
`
plusInteger
`
Naught
=
i
i
@
(
Negative
_
)
`
plusInteger
`
Naught
=
i
minusInteger
::
Integer
->
Integer
->
Integer
i1
`
minusInteger
`
i2
=
i1
`
plusInteger
`
negateInteger
i2
...
...
@@ -486,15 +491,16 @@ Some x xs `comparePositive` Some y ys = case xs `comparePositive` ys of
else
EQ
res
->
res
None
`
comparePositive
`
None
=
EQ
(
!
_
)
`
comparePositive
`
None
=
GT
None
`
comparePositive
`
(
!
_
)
=
LT
(
Some
{})
`
comparePositive
`
None
=
GT
None
`
comparePositive
`
(
Some
{})
=
LT
plusPositive
::
Positive
->
Positive
->
Positive
plusPositive
x0
y0
=
addWithCarry
0
##
x0
y0
where
-- digit `elem` [0, 1]
addWithCarry
::
Digit
->
Positive
->
Positive
->
Positive
addWithCarry
c
(
!
xs
)
None
=
addOnCarry
c
xs
addWithCarry
c
None
(
!
ys
)
=
addOnCarry
c
ys
addWithCarry
c
None
None
=
addOnCarry
c
None
addWithCarry
c
xs
@
(
Some
{})
None
=
addOnCarry
c
xs
addWithCarry
c
None
ys
@
(
Some
{})
=
addOnCarry
c
ys
addWithCarry
c
xs
@
(
Some
x
xs'
)
ys
@
(
Some
y
ys'
)
=
if
x
`
ltWord
#
`
y
then
addWithCarry
c
ys
xs
-- Now x >= y
...
...
@@ -550,28 +556,38 @@ Some x xs `minusPositive` Some y ys
case
z
`
plusWord
#
`
x
of
z'
->
-- z = 2^n + (x - y), calculated without overflow
Some
z'
((
xs
`
minusPositive
`
ys
)
`
minusPositive
`
onePositive
)
(
!
xs
)
`
minusPositive
`
None
=
xs
None
`
minusPositive
`
(
!
_
)
=
errorPositive
-- XXX Can't happen
xs
@
(
Some
{})
`
minusPositive
`
None
=
xs
None
`
minusPositive
`
None
=
None
None
`
minusPositive
`
(
Some
{})
=
errorPositive
-- XXX Can't happen
-- XXX None `minusPositive` _ = error "minusPositive: Requirement x > y not met"
timesPositive
::
Positive
->
Positive
->
Positive
-- XXX None's can't happen here:
None
`
timesPositive
`
(
!
_
)
=
errorPositive
(
!
_
)
`
timesPositive
`
None
=
errorPositive
None
`
timesPositive
`
None
=
errorPositive
None
`
timesPositive
`
(
Some
{})
=
errorPositive
(
Some
{})
`
timesPositive
`
None
=
errorPositive
-- x and y are the last digits in Positive numbers, so are not 0:
Some
x
None
`
timesPositive
`
Some
y
None
=
x
`
timesDigit
`
y
xs
@
(
Some
_
None
)
`
timesPositive
`
(
!
ys
)
=
ys
`
timesPositive
`
xs
-- y is the last digit in a Positive number, so is not 0:
Some
x
xs'
`
timesPositive
`
ys
@
(
Some
y
None
)
=
-- We could actually skip this test, and everything would
-- turn out OK. We already play tricks like that in timesPositive.
let
zs
=
Some
0
##
(
xs'
`
timesPositive
`
ys
)
in
if
x
`
eqWord
#
`
0
##
then
zs
else
(
x
`
timesDigit
`
y
)
`
plusPositive
`
zs
Some
x
xs'
`
timesPositive
`
ys
@
(
Some
_
_
)
=
(
Some
x
None
`
timesPositive
`
ys
)
`
plusPositive
`
Some
0
##
(
xs'
`
timesPositive
`
ys
)
xs
@
(
Some
x
xs'
)
`
timesPositive
`
ys
@
(
Some
y
ys'
)
=
case
xs'
of
None
->
case
ys'
of
None
->
x
`
timesDigit
`
y
Some
{}
->
ys
`
timesPositive
`
xs
Some
{}
->
case
ys'
of
None
->
-- y is the last digit in a Positive number, so is not 0.
let
zs
=
Some
0
##
(
xs'
`
timesPositive
`
ys
)
in
-- We could actually skip this test, and everything would
-- turn out OK. We already play tricks like that in timesPositive.
if
x
`
eqWord
#
`
0
##
then
zs
else
(
x
`
timesDigit
`
y
)
`
plusPositive
`
zs
Some
{}
->
(
Some
x
None
`
timesPositive
`
ys
)
`
plusPositive
`
Some
0
##
(
xs'
`
timesPositive
`
ys
)
{-
-- Requires arguments /= 0
...
...
@@ -708,8 +724,9 @@ some (!w) None = if w `eqWord#` 0## then None else Some w None
some
(
!
w
)
(
!
ws
)
=
Some
w
ws
andDigits
::
Digits
->
Digits
->
Digits
andDigits
(
!
_
)
None
=
None
andDigits
None
(
!
_
)
=
None
andDigits
None
None
=
None
andDigits
(
Some
{})
None
=
None
andDigits
None
(
Some
{})
=
None
andDigits
(
Some
w1
ws1
)
(
Some
w2
ws2
)
=
Some
(
w1
`
and
#
`
w2
)
(
andDigits
ws1
ws2
)
-- DigitsOnes is just like Digits, only None is really 0xFFFFFFF...,
...
...
@@ -719,19 +736,22 @@ andDigits (Some w1 ws1) (Some w2 ws2) = Some (w1 `and#` w2) (andDigits ws1 ws2)
newtype
DigitsOnes
=
DigitsOnes
Digits
andDigitsOnes
::
DigitsOnes
->
Digits
->
Digits
andDigitsOnes
(
!
_
)
None
=
None
andDigitsOnes
(
DigitsOnes
None
)
(
!
ws2
)
=
ws2
andDigitsOnes
(
DigitsOnes
None
)
None
=
None
andDigitsOnes
(
DigitsOnes
None
)
ws2
@
(
Some
{})
=
ws2
andDigitsOnes
(
DigitsOnes
(
Some
{}))
None
=
None
andDigitsOnes
(
DigitsOnes
(
Some
w1
ws1
))
(
Some
w2
ws2
)
=
Some
(
w1
`
and
#
`
w2
)
(
andDigitsOnes
(
DigitsOnes
ws1
)
ws2
)
orDigits
::
Digits
->
Digits
->
Digits
orDigits
None
(
!
ds
)
=
ds
orDigits
(
!
ds
)
None
=
ds
orDigits
None
None
=
None
orDigits
None
ds
@
(
Some
{})
=
ds
orDigits
ds
@
(
Some
{})
None
=
ds
orDigits
(
Some
w1
ds1
)
(
Some
w2
ds2
)
=
Some
(
w1
`
or
#
`
w2
)
(
orDigits
ds1
ds2
)
xorDigits
::
Digits
->
Digits
->
Digits
xorDigits
None
(
!
ds
)
=
ds
xorDigits
(
!
ds
)
None
=
ds
xorDigits
None
None
=
None
xorDigits
None
ds
@
(
Some
{})
=
ds
xorDigits
ds
@
(
Some
{})
None
=
ds
xorDigits
(
Some
w1
ds1
)
(
Some
w2
ds2
)
=
Some
(
w1
`
xor
#
`
w2
)
(
xorDigits
ds1
ds2
)
-- XXX We'd really like word2Double# for this
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment