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

Check Case, Alt, and all the trivial processes.

Browse Source
This commit is contained in:
Adam Sampson 2008-03-25 17:27:33 +00:00
parent 6861b22da6
commit b672900f46
2 changed files with 94 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
frontends/OccamTypes.hs
View File

@ -105,6 +105,10 @@ checkNumeric = checkTypeClass isNumericType "numeric"
checkInteger :: Meta -> A.Type -> PassM ()
checkInteger = checkTypeClass isIntegerType "integer"
-- | Check that a type is case-selectable.
checkCaseable :: Meta -> A.Type -> PassM ()
checkCaseable = checkTypeClass isCaseableType "case-selectable"
-- | Check that a type is scalar.
checkScalar :: Meta -> A.Type -> PassM ()
checkScalar = checkTypeClass isScalarType "scalar"
@ -137,16 +141,16 @@ checkList m rawT
_ -> diePC m $ formatCode "Expected list type; found %" t
-- | Check the type of an expression.
checkExpressionType :: Meta -> A.Type -> A.Expression -> PassM ()
checkExpressionType m et e = typeOfExpression e >>= checkType m et
checkExpressionType :: A.Type -> A.Expression -> PassM ()
checkExpressionType et e = typeOfExpression e >>= checkType (findMeta e) et
-- | Check that an expression is of integer type.
checkExpressionInt :: Meta -> A.Expression -> PassM ()
checkExpressionInt m e = checkExpressionType m A.Int e
checkExpressionInt :: A.Expression -> PassM ()
checkExpressionInt e = checkExpressionType A.Int e
-- | Check that an expression is of boolean type.
checkExpressionBool :: Meta -> A.Expression -> PassM ()
checkExpressionBool m e = checkExpressionType m A.Bool e
checkExpressionBool :: A.Expression -> PassM ()
checkExpressionBool e = checkExpressionType A.Bool e
-- | Check the type of a variable.
checkVariableType :: Meta -> A.Type -> A.Variable -> PassM ()
@ -191,11 +195,11 @@ checkSubscript m s rawT
-- Check the subscript itself.
case s of
A.Subscript m _ e -> checkExpressionInt m e
A.Subscript m _ e -> checkExpressionInt e
A.SubscriptFromFor m e f ->
checkExpressionInt m e >> checkExpressionInt m f
A.SubscriptFrom m e -> checkExpressionInt m e
A.SubscriptFor m e -> checkExpressionInt m e
checkExpressionInt e >> checkExpressionInt f
A.SubscriptFrom m e -> checkExpressionInt e
A.SubscriptFor m e -> checkExpressionInt e
_ -> ok
-- | Classes of operators.
@ -510,7 +514,7 @@ checkExpressions = checkDepthM doExpression
= do rfs <- underlyingType m t >>= recordFields m
when (length es /= length rfs) $
dieP m $ "Record literal has wrong number of fields: found " ++ (show $ length es) ++ ", expected " ++ (show $ length rfs)
sequence_ [checkExpressionType (findMeta fe) ft fe
sequence_ [checkExpressionType ft fe
| ((_, ft), fe) <- zip rfs es]
doLiteralRepr _ _ = ok
@ -519,7 +523,7 @@ checkExpressions = checkDepthM doExpression
= do checkArraySize m t (length aes)
t' <- subscriptType (A.Subscript m A.NoCheck undefined) t
sequence_ $ map (doArrayElem m t') aes
doArrayElem _ t (A.ArrayElemExpr e) = checkExpressionType (findMeta e) t e
doArrayElem _ t (A.ArrayElemExpr e) = checkExpressionType t e
--}}}
--{{{ checkProcesses
@ -535,22 +539,41 @@ checkProcesses = checkDepthM doProcess
doProcess (A.Input _ v im) = doInput v im
doProcess (A.Output m v ois) = doOutput m v ois
doProcess (A.OutputCase m v tag ois) = doOutputCase m v tag ois
-- ClearMobile
-- Skip
-- Stop
doProcess (A.ClearMobile _ v)
= do t <- typeOfVariable v
case t of
A.Mobile _ -> ok
_ -> diePC (findMeta v) $ formatCode "Expected mobile type; found %" t
checkWritable v
doProcess (A.Skip _) = ok
doProcess (A.Stop _) = ok
doProcess (A.Seq _ s) = doStructured (\p -> ok) s
doProcess (A.If _ s) = doStructured doChoice s
-- Case
-- While
-- Par
-- Processor
-- Alt
doProcess (A.Case _ e s)
= do t <- typeOfExpression e
checkCaseable (findMeta e) t
doStructured (doOption t) s
doProcess (A.While _ e _) = checkExpressionBool e
doProcess (A.Par _ _ s) = doStructured (\p -> ok) s
doProcess (A.Processor _ e _) = checkExpressionInt e
doProcess (A.Alt _ _ s) = doStructured doAlternative s
-- ProcCall
-- IntrinsicProcCall
doProcess _ = ok
doAlternative :: A.Alternative -> PassM ()
doAlternative (A.Alternative m v im _)
= case im of
A.InputTimerRead _ _ ->
dieP m $ "Timer read not permitted as alternative"
_ -> doInput v im
doAlternative (A.AlternativeCond m e v im p)
= do checkExpressionBool e
doAlternative (A.Alternative m v im p)
doAlternative (A.AlternativeSkip _ e _)
= checkExpressionBool e
doChoice :: A.Choice -> PassM ()
doChoice (A.Choice _ e _) = checkExpressionBool (findMeta e) e
doChoice (A.Choice _ e _) = checkExpressionBool e
doInput :: A.Variable -> A.InputMode -> PassM ()
doInput c (A.InputSimple m iis)
@ -590,6 +613,13 @@ checkProcesses = checkDepthM doProcess
checkType (findMeta v) wantT t
checkWritable v
doOption :: A.Type -> A.Option -> PassM ()
doOption et (A.Option _ es _)
= sequence_ [do rt <- typeOfExpression e
checkType (findMeta e) et rt
| e <- es]
doOption _ (A.Else _ _) = ok
doOutput :: Meta -> A.Variable -> [A.OutputItem] -> PassM ()
doOutput m c ois
= do t <- checkChannel A.DirOutput c
@ -614,8 +644,8 @@ checkProcesses = checkDepthM doProcess
doReplicator :: A.Replicator -> PassM ()
doReplicator (A.For _ _ start count)
= do checkExpressionInt (findMeta start) start
checkExpressionInt (findMeta count) count
= do checkExpressionInt start
checkExpressionInt count
doReplicator (A.ForEach _ _ e)
= do t <- typeOfExpression e
checkSequence (findMeta e) t

41
frontends/OccamTypesTest.hs
View File

@ -292,6 +292,16 @@ testOccamTypes = TestList
, testOK 1300 $ testChoice $ A.Choice m boolE skip
, testFail 1301 $ testChoice $ A.Choice m intE skip
-- Options
, testOK 1320 $ testOption intE $ A.Option m [] skip
, testOK 1321 $ testOption intE $ A.Option m [intE] skip
, testOK 1322 $ testOption intE $ A.Option m [intE, intE] skip
, testFail 1323 $ testOption realE $ A.Option m [realE] skip
, testFail 1324 $ testOption twoIntsE $ A.Option m [twoIntsE] skip
, testOK 1325 $ testOption boolE $ A.Option m [boolE] skip
, testFail 1326 $ testOption boolE $ A.Option m [intE] skip
, testFail 1327 $ testOption boolE $ A.Option m [boolE, intE] skip
-- Assignment
, testOK 1400 $ A.Assign m [intV] $ A.ExpressionList m [intE]
, testOK 1401 $ A.Assign m [intV, intV] $ A.ExpressionList m [intE, intE]
@ -310,6 +320,32 @@ testOccamTypes = TestList
$ A.FunctionCallList m function22 [intE, realE]
, testFail 1415 $ A.Assign m [intV, realV]
$ A.FunctionCallList m function22 [realE]
-- Alt
, testOK 1500 $ testAlt $ A.Alternative m intC (insim [inv intV]) skip
, testOK 1501 $ testAlt $ A.Alternative m tim
(A.InputTimerAfter m intE) skip
, testOK 1502 $ testAlt $ A.AlternativeCond m boolE intC
(insim [inv intV]) skip
, testOK 1503 $ testAlt $ A.AlternativeSkip m boolE skip
, testFail 1504 $ testAlt $ A.Alternative m intC (insim [inv realV]) skip
, testFail 1505 $ testAlt $ A.Alternative m tim
(A.InputTimerRead m $ inv intV)
skip
, testFail 1506 $ testAlt $ A.AlternativeCond m intE intC
(insim [inv intV]) skip
, testFail 1507 $ testAlt $ A.AlternativeSkip m intE skip
-- Miscellaneous processes
, testOK 1900 $ A.ClearMobile m mobileIntV
, testFail 1901 $ A.ClearMobile m intV
, testOK 1902 $ A.Skip m
, testOK 1903 $ A.Stop m
, testOK 1904 $ A.While m boolE skip
, testFail 1905 $ A.While m intE skip
, testOK 1906 $ A.Par m A.PlainPar sskip
, testOK 1907 $ A.Processor m intE skip
, testFail 1908 $ A.Processor m realE skip
--}}}
]
where
@ -376,7 +412,8 @@ testOccamTypes = TestList
countedIntsC = variable "chanCountedInts"
iirC = variable "chanIIR"
caseC = variable "chanCaseProto"
inputSimple c iis = A.Input m c $ A.InputSimple m iis
insim iis = A.InputSimple m iis
inputSimple c iis = A.Input m c $ insim iis
inputCase c vs = A.Input m c
$ A.InputCase m (A.Several m (map (A.Only m) vs))
vari tag iis = A.Variant m (simpleName tag) iis skip
@ -384,9 +421,11 @@ testOccamTypes = TestList
outputCase c tag ois = A.OutputCase m c (simpleName tag) ois
testRep r = A.Seq m (A.Rep m r sskip)
testChoice c = A.If m $ A.Only m c
testOption e o = A.Case m e $ A.Only m o
inv = A.InVariable m
oute = A.OutExpression m
tim = variable "tim"
testAlt a = A.Alt m True $ A.Only m a
--}}}
tests :: Test