suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial work on supporting INITIAL and RESULT abbreviations.

Browse Source 
This fixes the AST, parser and typechecker, and adds a pass to
transform Result back into Abbrev, but doesn't transform Initial yet.
(It actually works for trivial stuff anyway, but it won't do the right
thing for complex types or PROC parameters.)

It appears (to me) to make sense to support INITIAL/RESULT reshaping
and retyping too, so this does.

Refs #42.
This commit is contained in:
Adam Sampson 2008-06-02 20:41:37 +00:00
parent f811d2cdc9
commit 6ee21f76c9
12 changed files with 310 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
LANGUAGE
View File

@ -20,6 +20,6 @@ CHAN for CHAN OF, and PLACE for PLACE AT.
PLACE IN WORKSPACE and PLACE IN VECSPACE, both currently ignored.
INITIAL variables.
INITIAL and RESULT abbreviations.
Array constructors.

1
Makefile.am
View File

@ -152,6 +152,7 @@ tock_SOURCES_hs += pass/PassList.hs
tock_SOURCES_hs += pass/Properties.hs
tock_SOURCES_hs += pass/Traversal.hs
tock_SOURCES_hs += transformations/ImplicitMobility.hs
tock_SOURCES_hs += transformations/SimplifyAbbrevs.hs
tock_SOURCES_hs += transformations/SimplifyComms.hs
tock_SOURCES_hs += transformations/SimplifyExprs.hs
tock_SOURCES_hs += transformations/SimplifyProcs.hs

6
TestMain.hs
View File

@ -64,7 +64,7 @@ import qualified CommonTest (tests)
import qualified FlowGraphTest (qcTests)
import qualified GenerateCTest (tests)
import qualified OccamPassesTest (tests)
import qualified OccamTypesTest (tests)
import qualified OccamTypesTest (ioTests)
import qualified ParseRainTest (tests)
import qualified PassTest (tests)
import qualified PreprocessOccamTest (tests)
@ -181,7 +181,7 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options
,return FlowGraphTest.qcTests
,noqc GenerateCTest.tests
,noqc OccamPassesTest.tests
,noqc OccamTypesTest.tests
,noqcButIO OccamTypesTest.ioTests
,noqc ParseRainTest.tests
,noqc PassTest.tests
,noqc PreprocessOccamTest.tests
@ -195,4 +195,4 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options
noqc t = return (t,[])
noqcButIO :: IO Test -> IO (Test, [LabelledQuickCheckTest])
noqcButIO t = t >>* \x -> (x,[])
noqcButIO t = t >>* \x -> (x,[])

4
data/AST.hs
View File

@ -456,6 +456,10 @@ data AbbrevMode =
| Abbrev
-- | An abbreviation by value.
| ValAbbrev
-- | An abbreviation by value that can be modified.
| InitialAbbrev
-- | An abbreviation by reference that is initially undefined.
| ResultAbbrev
deriving (Show, Eq, Typeable, Data)
-- | Anything that introduces a new name.

32
frontends/OccamTypes.hs
View File

@ -311,6 +311,7 @@ checkAbbrev m orig new
= case (orig, new) of
(_, A.Original) -> bad
(A.ValAbbrev, A.ValAbbrev) -> ok
(A.ValAbbrev, A.InitialAbbrev) -> ok
(A.ValAbbrev, _) -> bad
_ -> ok
where
@ -320,7 +321,9 @@ checkAbbrev m orig new
showAM :: A.AbbrevMode -> String
showAM A.Original = "an original declaration"
showAM A.Abbrev = "a reference abbreviation"
showAM A.ValAbbrev = "a value abbreviation"
showAM A.ValAbbrev = "a VAL abbreviation"
showAM A.InitialAbbrev = "an INITIAL abbreviation"
showAM A.ResultAbbrev = "a RESULT abbreviation"
-- | Check a list of actuals is the right length for a list of formals.
checkActualCount :: Meta -> A.Name -> [A.Formal] -> [a] -> PassM ()
@ -1102,13 +1105,13 @@ checkSpecTypes = checkDepthM doSpecType
doSpecType (A.Is m am t v)
= do tv <- astTypeOf v
checkType (findMeta v) t tv
when (am /= A.Abbrev) $ unexpectedAM m
checkRefAM m am
amv <- abbrevModeOfVariable v
checkAbbrev m amv am
doSpecType (A.IsExpr m am t e)
= do te <- astTypeOf e
checkType (findMeta e) t te
when (am /= A.ValAbbrev) $ unexpectedAM m
checkValAM m am
checkAbbrev m A.ValAbbrev am
doSpecType (A.IsChannelArray m rawT cs)
= do t <- resolveUserType m rawT
@ -1159,12 +1162,31 @@ checkSpecTypes = checkDepthM doSpecType
doFunctionBody rs (Left s) = checkStructured (checkExpressionList rs) s
-- FIXME: Need to know the name of the function to do this
doFunctionBody rs (Right p) = dieP m "Cannot check function process body"
doSpecType (A.Retypes m _ t v)
doSpecType (A.Retypes m am t v)
= do fromT <- astTypeOf v
checkRetypes m fromT t
doSpecType (A.RetypesExpr m _ t e)
checkRefAM m am
amv <- abbrevModeOfVariable v
checkAbbrev m amv am
doSpecType (A.RetypesExpr m am t e)
= do fromT <- astTypeOf e
checkRetypes m fromT t
checkValAM m am
checkAbbrev m A.ValAbbrev am
checkValAM :: Meta -> A.AbbrevMode -> PassM ()
checkValAM m am
= case am of
A.ValAbbrev -> ok
A.InitialAbbrev -> ok
_ -> unexpectedAM m
checkRefAM :: Meta -> A.AbbrevMode -> PassM ()
checkRefAM m am
= case am of
A.Abbrev -> ok
A.ResultAbbrev -> ok
_ -> unexpectedAM m
unexpectedAM :: Check Meta
unexpectedAM m = dieP m "Unexpected abbreviation mode"

18
frontends/OccamTypesTest.hs
View File

@ -19,7 +19,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
-- #ignore-exports
-- | Tests for 'OccamTypes'.
module OccamTypesTest (tests) where
module OccamTypesTest (ioTests) where
import Control.Monad.State
import Data.Generics
@ -29,6 +29,7 @@ import qualified AST as A
import CompState
import Metadata
import qualified OccamTypes
import TestHarness
import TestUtils
m :: Meta
@ -606,7 +607,7 @@ testOccamTypes = TestList
returnOne = Left $ A.Only m $ A.ExpressionList m [intE]
returnTwo = Left $ A.Only m $ A.ExpressionList m [intE, intE]
retypesV = A.Retypes m A.ValAbbrev
retypesV = A.Retypes m A.Abbrev
retypesE = A.RetypesExpr m A.ValAbbrev
known1 = A.Array [dimension 4] A.Byte
known2 = A.Array [dimension 2, dimension 2] A.Byte
@ -616,7 +617,12 @@ testOccamTypes = TestList
--}}}
tests :: Test
tests = TestLabel "OccamTypesTest" $ TestList
[ testOccamTypes
]
ioTests :: IO Test
ioTests = liftM (TestLabel "OccamTypesTest" . TestList) $ sequence $
map return
[ testOccamTypes
]
++ map (automaticTest FrontendOccam)
[ "testcases/automatic/initial-result-1.occ.test"
, "testcases/automatic/initial-result-2.occ.test"
]

126
frontends/ParseOccam.hs
View File

@ -254,6 +254,12 @@ tryVVXX a b c d = try (do { av <- a; bv <- b; c; d; return (av, bv) })
tryVVXV :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (a, b, d)
tryVVXV a b c d = try (do { av <- a; bv <- b; c; dv <- d; return (av, bv, dv) })
tryVVVX :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser (a, b, c)
tryVVVX a b c d = try (do { av <- a; bv <- b; cv <- c; d; return (av, bv, cv) })
tryVVVXV :: OccParser a -> OccParser b -> OccParser c -> OccParser d -> OccParser e -> OccParser (a, b, c, e)
tryVVVXV a b c d e = try (do { av <- a; bv <- b; cv <- c; d; ev <- e; return (av, bv, cv, ev) })
--}}}
--{{{ subscripts
@ -949,62 +955,60 @@ declOf spec nt
abbreviation :: OccParser NameSpec
abbreviation
= valIsAbbrev
<|> initialIsAbbrev
<|> isAbbrev variable VariableName
<|> isAbbrev channel ChannelName
= valAbbrev
<|> refAbbrev variable VariableName
<|> refAbbrev channel ChannelName
<|> chanArrayAbbrev
<|> isAbbrev timer TimerName
<|> isAbbrev port PortName
<|> refAbbrev timer TimerName
<|> refAbbrev port PortName
<?> "abbreviation"
valIsAbbrev :: OccParser NameSpec
valIsAbbrev
maybeInfer :: OccParser A.Type -> OccParser A.Type
maybeInfer spec
= try spec
<|> return A.Infer
<?> "optional specifier"
valAbbrevMode :: OccParser A.AbbrevMode
valAbbrevMode
= (sVAL >> return A.ValAbbrev)
<|> (sINITIAL >> return A.InitialAbbrev)
valAbbrev :: OccParser NameSpec
valAbbrev
= do m <- md
(n, t, e) <- do { n <- tryXVX sVAL newVariableName sIS; e <- expression; sColon; eol; return (n, A.Infer, e) }
<|> do { (s, n) <- tryXVVX sVAL dataSpecifier newVariableName sIS; e <- expression; sColon; eol; return (n, s, e) }
return (A.Specification m n $ A.IsExpr m A.ValAbbrev t e, VariableName)
<?> "VAL IS abbreviation"
(am, t, n) <-
tryVVVX valAbbrevMode (maybeInfer dataSpecifier) newVariableName sIS
e <- expression
sColon
eol
return (A.Specification m n $ A.IsExpr m am t e, VariableName)
<?> "abbreviation by value"
initialIsAbbrev :: OccParser NameSpec
initialIsAbbrev
= do m <- md
(t, n) <- tryXVVX sINITIAL dataSpecifier newVariableName sIS
e <- expression
sColon
eol
return (A.Specification m n $ A.IsExpr m A.Original t e, VariableName)
<?> "INITIAL IS abbreviation"
refAbbrevMode :: OccParser A.AbbrevMode
refAbbrevMode
= (sRESULT >> return A.ResultAbbrev)
<|> return A.Abbrev
isAbbrev :: OccParser A.Variable -> NameType -> OccParser NameSpec
isAbbrev oldVar nt
= do m <- md
(n, v) <- tryVXV (newName nt) sIS oldVar
sColon
eol
return (A.Specification m n $ A.Is m A.Abbrev A.Infer v, nt)
<|> do m <- md
(s, n, v) <- tryVVXV specifier (newName nt) sIS oldVar
sColon
eol
return (A.Specification m n $ A.Is m A.Abbrev s v, nt)
<?> "IS abbreviation"
refAbbrev :: OccParser A.Variable -> NameType -> OccParser NameSpec
refAbbrev oldVar nt
= do m <- md
(am, t, n, v) <-
tryVVVXV refAbbrevMode (maybeInfer specifier) (newName nt) sIS oldVar
sColon
eol
return (A.Specification m n $ A.Is m am t v, nt)
<?> "abbreviation by reference"
chanArrayAbbrev :: OccParser NameSpec
chanArrayAbbrev
= do m <- md
(n, cs) <- tryVXXV newChannelName sIS sLeft (sepBy1 channel sComma)
sRight
sColon
eol
return (A.Specification m n $ A.IsChannelArray m A.Infer cs, ChannelName)
<|> do m <- md
(s, n) <- tryVVXX channelSpecifier newChannelName sIS sLeft
cs <- sepBy1 channel sComma
sRight
sColon
eol
return (A.Specification m n $ A.IsChannelArray m s cs, ChannelName)
= do m <- md
(t, n, cs) <-
tryVVXV (maybeInfer channelSpecifier) newChannelName (sIS >> sLeft) (sepBy1 channel sComma)
sRight
sColon
eol
return (A.Specification m n $ A.IsChannelArray m t cs, ChannelName)
<?> "channel array abbreviation"
specMode :: OccParser () -> OccParser A.SpecMode
@ -1049,18 +1053,14 @@ definition
<|> retypesAbbrev
<?> "definition"
retypesReshapes :: OccParser ()
retypesReshapes
= sRETYPES <|> sRESHAPES
retypesAbbrev :: OccParser NameSpec
retypesAbbrev
= do m <- md
(s, n) <- tryVVX dataSpecifier newVariableName retypesReshapes
(am, s, n) <- tryVVVX refAbbrevMode dataSpecifier newVariableName retypesReshapes
v <- variable
sColon
eol
return (A.Specification m n $ A.Retypes m A.Abbrev s v, VariableName)
return (A.Specification m n $ A.Retypes m am s v, VariableName)
<|> do m <- md
(s, n) <- tryVVX channelSpecifier newChannelName retypesReshapes
c <- channel
@ -1068,12 +1068,16 @@ retypesAbbrev
eol
return (A.Specification m n $ A.Retypes m A.Abbrev s c, ChannelName)
<|> do m <- md
(s, n) <- tryXVVX sVAL dataSpecifier newVariableName retypesReshapes
(am, s, n) <- tryVVVX valAbbrevMode dataSpecifier newVariableName retypesReshapes
e <- expression
sColon
eol
return (A.Specification m n $ A.RetypesExpr m A.ValAbbrev s e, VariableName)
return (A.Specification m n $ A.RetypesExpr m am s e, VariableName)
<?> "RETYPES/RESHAPES abbreviation"
where
retypesReshapes :: OccParser ()
retypesReshapes
= sRETYPES <|> sRESHAPES
dataSpecifier :: OccParser A.Type
dataSpecifier
@ -1151,11 +1155,13 @@ formalArgSet
formalVariableType :: OccParser (A.AbbrevMode, A.Type)
formalVariableType
= do sVAL
s <- dataSpecifier
return (A.ValAbbrev, s)
<|> do s <- dataSpecifier
return (A.Abbrev, s)
= do am <-
(sVAL >> return A.ValAbbrev)
<|> (sINITIAL >> return A.InitialAbbrev)
<|> (sRESULT >> return A.ResultAbbrev)
<|> return A.Abbrev
s <- dataSpecifier
return (am, s)
<?> "formal variable type"
valueProcess :: OccParser (A.Structured A.ExpressionList)

4
pass/PassList.hs
View File

@ -1,6 +1,6 @@
{-
Tock: a compiler for parallel languages
Copyright (C) 2007 University of Kent
Copyright (C) 2007, 2008 University of Kent
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
@ -37,6 +37,7 @@ import OccamPasses
import Pass
import qualified Properties as Prop
import RainPasses
import SimplifyAbbrevs
import SimplifyComms
import SimplifyExprs
import SimplifyProcs
@ -55,6 +56,7 @@ commonPasses opts = concat $
, enablePassesWhen (not . csUsageChecking)
[pass "Usage checking turned OFF" Prop.agg_namesDone [Prop.parUsageChecked]
return]
, simplifyAbbrevs
, simplifyComms
, simplifyExprs
, simplifyProcs

13
pass/Properties.hs
View File

@ -42,6 +42,7 @@ module Properties
, functionsRemoved
, functionTypesChecked
, inferredTypesRecorded
, initialRemoved
, inputCaseRemoved
, intLiteralsInBounds
, listsGivenType
@ -55,6 +56,7 @@ module Properties
, processTypesChecked
, rainParDeclarationsPulledUp
, rangeTransformed
, resultRemoved
, retypesChecked
, seqInputsFlattened
, slicesSimplified
@ -402,3 +404,14 @@ slicesSimplified = Property "slicesSimplified" $
listsGivenType :: Property
listsGivenType = Property "listsGivenType" checkTODO
initialRemoved :: Property
initialRemoved
= Property "initialRemoved" $
checkNull "initialRemoved" . listify (== A.InitialAbbrev)
resultRemoved :: Property
resultRemoved
= Property "resultRemoved" $
checkNull "resultRemoved" . listify (== A.ResultAbbrev)

81
testcases/automatic/initial-result-1.occ.test Normal file
View File

@ -0,0 +1,81 @@
-- This file tests INITIAL and RESULT abbreviations.
PROC main ()
INT var:
REAL32 var.r:
BYTE var.b:
VAL INT const IS 42:
VAL REAL32 const.r IS 9.8:
VAL BYTE const.b IS 'x':
%%
SKIP
:
%PASS Normal kinds of abbreviations
INT abbrev IS var:
inferred.abbrev IS var:
VAL INT val IS var:
VAL inferred.val IS var:
VAL INT val.const IS const:
VAL inferred.val.const IS const:
%PASS Initial-abbreviate var
INITIAL INT init IS var:
%PASS Initial-abbreviate const
INITIAL INT init IS const:
%FAIL Initial-abbreviate wrong type
INITIAL INT init IS const.r:
%PASS Initial-abbreviate inferred type
INITIAL init IS const:
%PASS Result-abbreviate var
RESULT INT result IS var:
%FAIL Result-abbreviate const
RESULT INT result IS const:
%FAIL Result-abbreviate wrong type
RESULT INT result IS var.r:
%PASS Result-abbreviate inferred type from var
RESULT result IS var:
%FAIL Result-abbreviate inferred type from const
RESULT result IS const:
%PASS Normal kinds of retypings
INT32 retyped RETYPES var.r:
VAL INT32 val.retypes RETYPES var.r:
VAL INT32 val.retypes.const RETYPES const.r:
%FAIL Normal kind of retyping from wrong size var
INT32 retyped RETYPES var.b:
%FAIL Normal kind of retyping from wrong size const
VAL INT32 retyped RETYPES const.b:
%PASS Initial retyping from var
INITIAL INT32 retyped RETYPES var.r:
%PASS Initial retyping from const
INITIAL INT32 retyped RETYPES const.r:
%FAIL Initial retyping from wrong size var
INITIAL INT32 retyped RETYPES var.b:
%FAIL Initial retyping from wrong size const
INITIAL INT32 retyped RETYPES const.b:
%PASS Result retyping from var
RESULT INT32 retyped RETYPES var.r:
%FAIL Result retyping from const
RESULT INT32 retyped RETYPES const.r:
%FAIL Result retyping from wrong size
RESULT INT32 retyped RETYPES var.b:
%

46
testcases/automatic/initial-result-2.occ.test Normal file
View File

@ -0,0 +1,46 @@
-- This file tests INITIAL and RESULT formals and actuals.
PROC main ()
INT var:
REAL32 var.r:
VAL INT const IS 42:
VAL REAL32 const.r IS 9.8:
PROC on.init (INITIAL INT init)
init := init + 1
:
PROC on.result (RESULT INT result)
result := 42
:
%%
:
%PASS Just the PROCs
SKIP
%PASS Initial actual from var
on.init (var)
%PASS Initial actual from const
on.init (const)
%FAIL Initial actual from wrong type
on.init (const.r)
%PASS Result actual from var
on.result (var)
%FAIL Result actual from const
on.result (const)
%FAIL Result actual from wrong type
on.result (var.r)
%FAIL Initial formal in FUNCTION
INT FUNCTION function (INITIAL INT arg) IS 42:
%FAIL Result formal in FUNCTION
INT FUNCTION function (RESULT INT arg) IS 42:
%

53
transformations/SimplifyAbbrevs.hs Normal file
View File

@ -0,0 +1,53 @@
{-
Tock: a compiler for parallel languages
Copyright (C) 2008 University of Kent
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation, either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License along
with this program. If not, see <http://www.gnu.org/licenses/>.
-}
-- | Simplify abbreviations.
module SimplifyAbbrevs (simplifyAbbrevs) where
import qualified AST as A
import Pass
import qualified Properties as Prop
import Traversal
simplifyAbbrevs :: [Pass]
simplifyAbbrevs =
[ removeInitial
, removeResult
]
-- | Rewrite 'InitialAbbrev' into a variable and an assignment.
removeInitial :: Pass
removeInitial
= pass "Remove INITIAL abbreviations"
[]
[Prop.initialRemoved]
-- FIXME: Implement this
return
-- | Rewrite 'ResultAbbrev' into just 'Abbrev'.
removeResult :: Pass
removeResult
= pass "Remove RESULT abbreviations"
[]
[Prop.resultRemoved]
(applyDepthM (return . doAbbrevMode))
where
doAbbrevMode :: A.AbbrevMode -> A.AbbrevMode
doAbbrevMode A.ResultAbbrev = A.Abbrev
doAbbrevMode s = s