Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
R
rtree
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
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
GitLab community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
chrg
rtree
Commits
fe81d53d
Commit
fe81d53d
authored
4 months ago
by
chrg
Browse files
Options
Downloads
Patches
Plain Diff
Add a don't repair flag
parent
68f384cd
No related branches found
No related tags found
No related merge requests found
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
rtree-c/src/ReduceC.hs
+53
-47
53 additions, 47 deletions
rtree-c/src/ReduceC.hs
with
53 additions
and
47 deletions
rtree-c/src/ReduceC.hs
+
53
−
47
View file @
fe81d53d
...
@@ -1137,9 +1137,14 @@ etUnPointer t =
...
@@ -1137,9 +1137,14 @@ etUnPointer t =
checkNotAssignable
::
(
MonadPlus
m
)
=>
EType
->
m
()
checkNotAssignable
::
(
MonadPlus
m
)
=>
EType
->
m
()
checkNotAssignable
=
guard
.
not
.
etAssignable
checkNotAssignable
=
guard
.
not
.
etAssignable
msplit
::
(
MonadReduce
Lab
m
)
=>
Lab
->
Maybe
(
m
a
)
->
Maybe
(
m
a
)
->
Maybe
(
m
a
)
msplit
::
(
MonadReduce
Lab
m
)
=>
Context
->
Lab
->
Maybe
(
m
a
)
->
Maybe
(
m
a
)
->
Maybe
(
m
a
)
msplit
l
m1
m2
=
do
msplit
ctx
l
m1
m2
case
m1
of
|
DontRepairExpressions
`
isIn
`
ctx
=
do
b
<-
m2
Just
$
case
m1
of
Just
a
->
split
l
a
b
Nothing
->
b
|
otherwise
=
case
m1
of
Just
a
->
Just
$
case
m2
of
Just
a
->
Just
$
case
m2
of
Just
b
->
split
l
a
b
Just
b
->
split
l
a
b
Nothing
->
a
Nothing
->
a
...
@@ -1218,8 +1223,8 @@ reduceCExpr ::
...
@@ -1218,8 +1223,8 @@ reduceCExpr ::
Maybe
(
m
C
.
CExpr
)
Maybe
(
m
C
.
CExpr
)
reduceCExpr
expr
t
ctx
=
case
expr
of
reduceCExpr
expr
t
ctx
=
case
expr
of
C
.
CBinary
o
elhs
erhs
ni
->
do
C
.
CBinary
o
elhs
erhs
ni
->
do
msplit
(
"reduce to left"
,
C
.
posOf
elhs
)
(
reduceCExpr
elhs
t
ctx
)
do
msplit
ctx
(
"reduce to left"
,
C
.
posOf
elhs
)
(
reduceCExpr
elhs
t
ctx
)
do
msplit
(
"reduce to right"
,
C
.
posOf
erhs
)
(
reduceCExpr
erhs
t
ctx
)
do
msplit
ctx
(
"reduce to right"
,
C
.
posOf
erhs
)
(
reduceCExpr
erhs
t
ctx
)
do
checkNotAssignable
t
checkNotAssignable
t
when
(
o
`
elem
`
[
C
.
CNeqOp
,
C
.
CEqOp
,
C
.
CGeqOp
,
C
.
CLeqOp
,
C
.
CGrOp
,
C
.
CLeOp
])
do
when
(
o
`
elem
`
[
C
.
CNeqOp
,
C
.
CEqOp
,
C
.
CGeqOp
,
C
.
CLeqOp
,
C
.
CGrOp
,
C
.
CLeOp
])
do
checkExpectedType
ctx
(
NonVoid
TNum
)
t
checkExpectedType
ctx
(
NonVoid
TNum
)
t
...
@@ -1242,8 +1247,8 @@ reduceCExpr expr t ctx = case expr of
...
@@ -1242,8 +1247,8 @@ reduceCExpr expr t ctx = case expr of
_ow
->
r'
_ow
->
r'
pure
$
C
.
CBinary
o
l'
r''
ni
pure
$
C
.
CBinary
o
l'
r''
ni
C
.
CAssign
o
elhs
erhs
ni
->
C
.
CAssign
o
elhs
erhs
ni
->
msplit
(
"reduce to left"
,
C
.
posOf
elhs
)
(
reduceCExpr
elhs
t
ctx
)
do
msplit
ctx
(
"reduce to left"
,
C
.
posOf
elhs
)
(
reduceCExpr
elhs
t
ctx
)
do
msplit
(
"reduce to right"
,
C
.
posOf
erhs
)
(
reduceCExpr
erhs
t
ctx
)
do
msplit
ctx
(
"reduce to right"
,
C
.
posOf
erhs
)
(
reduceCExpr
erhs
t
ctx
)
do
c
<-
inferType
ctx
elhs
c
<-
inferType
ctx
elhs
checkExpectedType
ctx
c
t
checkExpectedType
ctx
c
t
let
t'
=
fromVoid
etAny
exactly
c
let
t'
=
fromVoid
etAny
exactly
c
...
@@ -1284,7 +1289,7 @@ reduceCExpr expr t ctx = case expr of
...
@@ -1284,7 +1289,7 @@ reduceCExpr expr t ctx = case expr of
checkExpectedType
ctx
(
NonVoid
TNum
)
t
checkExpectedType
ctx
(
NonVoid
TNum
)
t
Just
(
pure
expr
)
Just
(
pure
expr
)
C
.
CUnary
o
eopr
ni
->
do
C
.
CUnary
o
eopr
ni
->
do
msplit
(
"reduce to operant"
,
C
.
posOf
eopr
)
(
reduceCExpr
eopr
t
ctx
)
do
msplit
ctx
(
"reduce to operant"
,
C
.
posOf
eopr
)
(
reduceCExpr
eopr
t
ctx
)
do
case
o
of
case
o
of
C
.
CIndOp
->
do
C
.
CIndOp
->
do
ropr
<-
case
etSet
t
of
ropr
<-
case
etSet
t
of
...
@@ -1309,10 +1314,7 @@ reduceCExpr expr t ctx = case expr of
...
@@ -1309,10 +1314,7 @@ reduceCExpr expr t ctx = case expr of
reduceCExpr
eopr
t
ctx
<&>
\
ropr
->
do
reduceCExpr
eopr
t
ctx
<&>
\
ropr
->
do
eopr'
<-
ropr
eopr'
<-
ropr
pure
$
C
.
CUnary
o
eopr'
ni
pure
$
C
.
CUnary
o
eopr'
ni
C
.
CCall
ef
args
ni
->
do
C
.
CCall
ef
args
ni
->
orHoistSubExpression
do
(
\
fn
a
->
foldr
fn
a
args
)
(
\
e
->
msplit
(
"reduce to expression"
,
C
.
posOf
e
)
(
reduceCExpr
e
t
ctx
))
do
ct
<-
inferType
ctx
ef
ct
<-
inferType
ctx
ef
case
ct
of
case
ct
of
NonVoid
ft
@
(
TFun
(
FunType
rt
fargs
))
->
do
NonVoid
ft
@
(
TFun
(
FunType
rt
fargs
))
->
do
...
@@ -1337,10 +1339,13 @@ reduceCExpr expr t ctx = case expr of
...
@@ -1337,10 +1339,13 @@ reduceCExpr expr t ctx = case expr of
<>
show
ow
<>
show
ow
<>
" at "
<>
" at "
<>
show
(
C
.
posOf
ef
)
<>
show
(
C
.
posOf
ef
)
where
orHoistSubExpression
a
=
foldr
(
\
e
->
msplit
ctx
(
"reduce to expression"
,
C
.
posOf
e
)
(
reduceCExpr
e
t
ctx
))
a
args
C
.
CCond
et
(
Just
ec
)
ef
ni
->
do
C
.
CCond
et
(
Just
ec
)
ef
ni
->
do
msplit
(
"reduce to true branch"
,
C
.
posOf
et
)
(
reduceCExpr
et
t
ctx
)
do
msplit
ctx
(
"reduce to true branch"
,
C
.
posOf
et
)
(
reduceCExpr
et
t
ctx
)
do
msplit
(
"reduce to false branch"
,
C
.
posOf
ef
)
(
reduceCExpr
ef
t
ctx
)
do
msplit
ctx
(
"reduce to false branch"
,
C
.
posOf
ef
)
(
reduceCExpr
ef
t
ctx
)
do
msplit
(
"reduce to condtion"
,
C
.
posOf
ef
)
(
reduceCExpr
ec
t
ctx
)
do
msplit
ctx
(
"reduce to condtion"
,
C
.
posOf
ef
)
(
reduceCExpr
ec
t
ctx
)
do
checkNotAssignable
t
checkNotAssignable
t
ret
<-
reduceCExpr
et
t
ctx
ret
<-
reduceCExpr
et
t
ctx
ref
<-
reduceCExpr
ef
t
ctx
ref
<-
reduceCExpr
ef
t
ctx
...
@@ -1351,7 +1356,7 @@ reduceCExpr expr t ctx = case expr of
...
@@ -1351,7 +1356,7 @@ reduceCExpr expr t ctx = case expr of
ec'
<-
rec
ec'
<-
rec
pure
$
C
.
CCond
et'
(
Just
ec'
)
ef'
ni
pure
$
C
.
CCond
et'
(
Just
ec'
)
ef'
ni
C
.
CCast
(
C
.
CDecl
spec
items
ni2
)
e
ni
->
do
C
.
CCast
(
C
.
CDecl
spec
items
ni2
)
e
ni
->
do
msplit
(
"do not cast"
,
C
.
posOf
ni
)
(
reduceCExpr
e
t
ctx
)
do
msplit
ctx
(
"do not cast"
,
C
.
posOf
ni
)
(
reduceCExpr
e
t
ctx
)
do
fn
<-
updateCDeclarationSpecifiers
keepAll
ctx
spec
fn
<-
updateCDeclarationSpecifiers
keepAll
ctx
spec
hole
<-
case
items
of
hole
<-
case
items
of
[
C
.
CDeclarationItem
(
C
.
CDeclr
Nothing
dd
Nothing
[]
a
)
b
c
]
->
do
[
C
.
CDeclarationItem
(
C
.
CDeclr
Nothing
dd
Nothing
[]
a
)
b
c
]
->
do
...
@@ -1372,8 +1377,8 @@ reduceCExpr expr t ctx = case expr of
...
@@ -1372,8 +1377,8 @@ reduceCExpr expr t ctx = case expr of
(
spec'
,
items'
,
e'
)
<-
hole
(
spec'
,
items'
,
e'
)
<-
hole
pure
(
C
.
CCast
(
C
.
CDecl
spec'
items'
ni2
)
e'
ni
)
pure
(
C
.
CCast
(
C
.
CDecl
spec'
items'
ni2
)
e'
ni
)
C
.
CIndex
e1
e2
ni
->
do
C
.
CIndex
e1
e2
ni
->
do
msplit
(
"reduce to indexee"
,
C
.
posOf
e1
)
(
reduceCExpr
e1
t
ctx
)
do
msplit
ctx
(
"reduce to indexee"
,
C
.
posOf
e1
)
(
reduceCExpr
e1
t
ctx
)
do
msplit
(
"reduce to index"
,
C
.
posOf
e2
)
(
reduceCExpr
e2
t
ctx
)
do
msplit
ctx
(
"reduce to index"
,
C
.
posOf
e2
)
(
reduceCExpr
e2
t
ctx
)
do
re1
<-
reduceCExpr
e1
t
{
etSet
=
ETPointer
(
etSet
t
),
etAssignable
=
True
}
ctx
re1
<-
reduceCExpr
e1
t
{
etSet
=
ETPointer
(
etSet
t
),
etAssignable
=
True
}
ctx
Just
do
Just
do
e1'
<-
re1
e1'
<-
re1
...
@@ -1384,7 +1389,7 @@ reduceCExpr expr t ctx = case expr of
...
@@ -1384,7 +1389,7 @@ reduceCExpr expr t ctx = case expr of
C
.
CComma
items
ni
->
do
C
.
CComma
items
ni
->
do
(
x
,
rst
)
<-
List
.
uncons
(
reverse
items
)
(
x
,
rst
)
<-
List
.
uncons
(
reverse
items
)
(
\
fn
a
->
foldr
fn
a
(
reverse
items
))
(
\
fn
a
->
foldr
fn
a
(
reverse
items
))
(
\
e
->
msplit
(
"reduce to expression"
,
C
.
posOf
e
)
(
reduceCExpr
e
t
ctx
))
(
\
e
->
msplit
ctx
(
"reduce to expression"
,
C
.
posOf
e
)
(
reduceCExpr
e
t
ctx
))
do
do
rx
<-
reduceCExpr
x
t
ctx
rx
<-
reduceCExpr
x
t
ctx
Just
do
Just
do
...
@@ -1480,6 +1485,7 @@ data Keyword
...
@@ -1480,6 +1485,7 @@ data Keyword
|
AllowEmptyDeclarations
|
AllowEmptyDeclarations
|
DontReduceArrays
|
DontReduceArrays
|
DontRemoveStatic
|
DontRemoveStatic
|
DontRepairExpressions
|
DisallowVariableInlining
|
DisallowVariableInlining
|
AllowInfiniteForLoops
|
AllowInfiniteForLoops
deriving
(
Show
,
Read
,
Enum
,
Eq
,
Ord
)
deriving
(
Show
,
Read
,
Enum
,
Eq
,
Ord
)
...
...
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