Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
C
curry-frontend
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
62
Issues
62
List
Boards
Labels
Service Desk
Milestones
Merge Requests
3
Merge Requests
3
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
curry
curry-frontend
Commits
27ac926d
Commit
27ac926d
authored
Aug 07, 2014
by
Jan Rasmus Tikovsky
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Declaration of operator precedences is now optional
parent
c56da5ff
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
45 additions
and
21 deletions
+45
-21
CHANGELOG.md
CHANGELOG.md
+3
-0
src/Checks/InterfaceCheck.hs
src/Checks/InterfaceCheck.hs
+1
-1
src/Checks/PrecCheck.hs
src/Checks/PrecCheck.hs
+4
-4
src/Checks/SyntaxCheck.hs
src/Checks/SyntaxCheck.hs
+4
-3
src/Env/OpPrec.hs
src/Env/OpPrec.hs
+21
-4
src/Exports.hs
src/Exports.hs
+1
-1
src/Generators/GenAbstractCurry.hs
src/Generators/GenAbstractCurry.hs
+3
-2
src/Generators/GenFlatCurry.hs
src/Generators/GenFlatCurry.hs
+5
-4
src/Imports.hs
src/Imports.hs
+3
-2
No files found.
CHANGELOG.md
View file @
27ac926d
...
...
@@ -4,6 +4,9 @@ Change log for curry-frontend
Under development
=================
*
Declaration of operator precedence is now optional in infix operator
declarations
*
Moved module
`InterfaceEquivalence`
to curry-base
(
`Curry.Syntax.InterfaceEquivalence`
)
...
...
src/Checks/InterfaceCheck.hs
View file @
27ac926d
...
...
@@ -99,7 +99,7 @@ interfaceCheck pEnv tcEnv tyEnv (Interface m _ ds) = reverse (errors s)
checkImport
::
IDecl
->
IC
()
checkImport
(
IInfixDecl
p
fix
pr
op
)
=
checkPrecInfo
check
p
op
where
check
(
PrecInfo
op'
(
OpPrec
fix'
pr'
))
=
op
==
op'
&&
fix
==
fix'
&&
pr
==
pr'
op
==
op'
&&
fix
==
fix'
&&
(
mkPrec
pr
)
==
pr'
checkImport
(
HidingDataDecl
p
tc
tvs
)
=
checkTypeInfo
"hidden data type"
check
p
tc
where
check
(
DataType
tc'
n'
_
)
...
...
src/Checks/PrecCheck.hs
View file @
27ac926d
...
...
@@ -34,7 +34,7 @@ import Base.Messages (Message, posMessage)
import
Base.Utils
(
findDouble
)
import
Env.OpPrec
(
OpPrecEnv
,
OpPrec
(
..
),
PrecInfo
(
..
),
defaultP
,
bindP
,
qualLookupP
)
,
mkPrec
,
qualLookupP
)
precCheck
::
ModuleIdent
->
OpPrecEnv
->
[
Decl
]
->
([
Decl
],
OpPrecEnv
,
[
Message
])
precCheck
m
pEnv
decls
=
runPCM
(
checkDecls
decls
)
initState
...
...
@@ -91,11 +91,11 @@ bindPrecs ds = case findDouble opFixDecls of
bvs
=
concatMap
boundValues
nonFixDs
bindPrec
::
ModuleIdent
->
Decl
->
OpPrecEnv
->
OpPrecEnv
bindPrec
m
(
InfixDecl
_
fix
pr
c
ops
)
pEnv
bindPrec
m
(
InfixDecl
_
fix
mpre
c
ops
)
pEnv
|
p
==
defaultP
=
pEnv
|
otherwise
=
foldr
(
flip
(
bindP
m
)
p
)
pEnv
ops
where
p
=
OpPrec
fix
prc
bindPrec
_
_
pEnv
=
pEnv
where
p
=
OpPrec
fix
(
mkPrec
mprec
)
bindPrec
_
_
pEnv
=
pEnv
boundValues
::
Decl
->
[
Ident
]
boundValues
(
DataDecl
_
_
_
cs
)
=
map
constr
cs
...
...
src/Checks/SyntaxCheck.hs
View file @
27ac926d
...
...
@@ -382,10 +382,11 @@ checkDeclLhs (FreeDecl p vs) =
FreeDecl
p
`
liftM
`
mapM
(
checkVar
"free variables declaration"
)
vs
checkDeclLhs
d
=
return
d
checkPrecedence
::
Position
->
Integer
->
SCM
Integer
checkPrecedence
p
i
=
do
checkPrecedence
::
Position
->
Maybe
Precedence
->
SCM
(
Maybe
Precedence
)
checkPrecedence
_
Nothing
=
return
Nothing
checkPrecedence
p
(
Just
i
)
=
do
unless
(
0
<=
i
&&
i
<=
9
)
$
report
$
errPrecedenceOutOfRange
p
i
return
i
return
$
Just
i
checkVar
::
String
->
Ident
->
SCM
Ident
checkVar
_what
v
=
do
...
...
src/Env/OpPrec.hs
View file @
27ac926d
...
...
@@ -24,7 +24,7 @@
introduction of unlimited integer constants in the parser / lexer.
-}
module
Env.OpPrec
(
OpPrec
(
..
),
defaultP
(
OpPrec
(
..
),
defaultP
,
defaultAssoc
,
defaultPrecedence
,
mkPrec
,
OpPrecEnv
,
PrecInfo
(
..
),
bindP
,
lookupP
,
qualLookupP
,
initOpPrecEnv
)
where
...
...
@@ -33,18 +33,35 @@ import Curry.Syntax (Infix (..))
import
Base.TopEnv
import
Data.Maybe
(
fromMaybe
)
-- |Operator precedence.
data
OpPrec
=
OpPrec
Infix
Integer
deriving
Eq
data
OpPrec
=
OpPrec
Infix
Precedence
deriving
Eq
type
Precedence
=
Integer
-- TODO: Change to real show instance and provide Pretty instance
-- if used anywhere.
instance
Show
OpPrec
where
showsPrec
_
(
OpPrec
fix
p
)
=
showString
(
assoc
fix
)
.
shows
p
where
assoc
InfixL
=
"left "
assoc
InfixR
=
"right "
assoc
Infix
=
"non-assoc "
-- |Default operator
precedence
.
-- |Default operator
declaration (associativity and precedence)
.
defaultP
::
OpPrec
defaultP
=
OpPrec
InfixL
9
defaultP
=
OpPrec
defaultAssoc
defaultPrecedence
-- |Default operator associativity.
defaultAssoc
::
Infix
defaultAssoc
=
InfixL
-- |Default operator precedence.
defaultPrecedence
::
Precedence
defaultPrecedence
=
9
mkPrec
::
Maybe
Precedence
->
Precedence
mkPrec
mprec
=
fromMaybe
defaultPrecedence
mprec
-- |Precedence information for an identifier.
data
PrecInfo
=
PrecInfo
QualIdent
OpPrec
deriving
(
Eq
,
Show
)
...
...
src/Exports.hs
View file @
27ac926d
...
...
@@ -75,7 +75,7 @@ iInfixDecl :: ModuleIdent -> OpPrecEnv -> QualIdent -> [IDecl] -> [IDecl]
iInfixDecl
m
pEnv
op
ds
=
case
qualLookupP
op
pEnv
of
[]
->
ds
[
PrecInfo
_
(
OpPrec
fix
pr
)]
->
IInfixDecl
NoPos
fix
pr
(
qualUnqualify
m
op
)
:
ds
IInfixDecl
NoPos
fix
(
Just
pr
)
(
qualUnqualify
m
op
)
:
ds
_
->
internalError
"Exports.infixDecl"
typeDecl
::
ModuleIdent
->
TCEnv
->
Export
->
[
IDecl
]
->
[
IDecl
]
...
...
src/Generators/GenAbstractCurry.hs
View file @
27ac926d
...
...
@@ -32,6 +32,7 @@ import Base.Types
import
Env.TypeConstructor
(
TCEnv
,
lookupTC
)
import
Env.Value
(
ValueEnv
,
ValueInfo
(
..
),
lookupValue
,
qualLookupValue
)
import
Env.OpPrec
(
mkPrec
)
import
CompilerEnv
...
...
@@ -207,11 +208,11 @@ genTypeExpr env (RecordType fss mr) = case mr of
ls'
=
map
idName
ls
genOpDecl
::
AbstractEnv
->
Decl
->
[
COpDecl
]
genOpDecl
env
(
InfixDecl
_
fix
prec
ops
)
=
map
genCOp
(
reverse
ops
)
genOpDecl
env
(
InfixDecl
_
fix
m
prec
ops
)
=
map
genCOp
(
reverse
ops
)
where
genCOp
op
=
COp
(
genQName
False
env
$
qualifyWith
(
moduleId
env
)
op
)
(
genFixity
fix
)
(
fromInteger
prec
)
(
fromInteger
(
mkPrec
mprec
)
)
genFixity
InfixL
=
CInfixlOp
genFixity
InfixR
=
CInfixrOp
...
...
src/Generators/GenFlatCurry.hs
View file @
27ac926d
...
...
@@ -36,6 +36,7 @@ import Base.Types
-- environments
import
Env.Interface
import
Env.TypeConstructor
(
TCEnv
,
TypeInfo
(
..
),
qualLookupTC
)
import
Env.OpPrec
(
mkPrec
)
import
Env.Value
(
ValueEnv
,
ValueInfo
(
..
),
lookupValue
,
qualLookupValue
)
-- other
...
...
@@ -386,9 +387,9 @@ visitConstrIDecl mid tis (CS.ConOpDecl pos ids type1 ident type2)
--
visitOpIDecl
::
CS
.
IDecl
->
FlatState
OpDecl
visitOpIDecl
(
CS
.
IInfixDecl
_
fixi
prec
op
)
=
do
visitOpIDecl
(
CS
.
IInfixDecl
_
fixi
m
prec
op
)
=
do
op'
<-
visitQualIdent
op
return
$
Op
op'
(
genFixity
fixi
)
prec
return
$
Op
op'
(
genFixity
fixi
)
(
mkPrec
mprec
)
visitOpIDecl
_
=
internalError
"GenFlatCurry.visitOpIDecl: no pattern match"
-------------------------------------------------------------------------------
...
...
@@ -617,9 +618,9 @@ genOpDecls = fixities >>= mapM genOpDecl
--
genOpDecl
::
CS
.
IDecl
->
FlatState
OpDecl
genOpDecl
(
CS
.
IInfixDecl
_
fixity
prec
qident
)
=
do
genOpDecl
(
CS
.
IInfixDecl
_
fixity
m
prec
qident
)
=
do
qname
<-
visitQualIdent
qident
return
$
Op
qname
(
genFixity
fixity
)
prec
return
$
Op
qname
(
genFixity
fixity
)
(
mkPrec
mprec
)
genOpDecl
_
=
internalError
"GenFlatCurry: no infix interface"
genFixity
::
CS
.
Infix
->
Fixity
...
...
src/Imports.hs
View file @
27ac926d
...
...
@@ -168,8 +168,9 @@ intfEnv bind (Interface m _ ds) = foldr (bind m) Map.empty ds
-- operator precedences
bindPrec
::
ModuleIdent
->
IDecl
->
ExpPEnv
->
ExpPEnv
bindPrec
m
(
IInfixDecl
_
fix
p
op
)
=
Map
.
insert
(
unqualify
op
)
(
PrecInfo
(
qualQualify
m
op
)
(
OpPrec
fix
p
))
bindPrec
m
(
IInfixDecl
_
fix
mprec
op
)
=
Map
.
insert
(
unqualify
op
)
(
PrecInfo
(
qualQualify
m
op
)
(
OpPrec
fix
(
mkPrec
mprec
)))
bindPrec
_
_
=
id
bindTCHidden
::
ModuleIdent
->
IDecl
->
ExpTCEnv
->
ExpTCEnv
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment