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

41
frontends/OccamTypesTest.hs
View File

@ -292,6 +292,16 @@ testOccamTypes = TestList
, testOK 1300 $ testChoice $ A.Choice m boolE skip , testOK 1300 $ testChoice $ A.Choice m boolE skip
, testFail 1301 $ testChoice $ A.Choice m intE 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 -- Assignment
, testOK 1400 $ A.Assign m [intV] $ A.ExpressionList m [intE] , testOK 1400 $ A.Assign m [intV] $ A.ExpressionList m [intE]
, testOK 1401 $ A.Assign m [intV, intV] $ A.ExpressionList m [intE, 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] $ A.FunctionCallList m function22 [intE, realE]
, testFail 1415 $ A.Assign m [intV, realV] , testFail 1415 $ A.Assign m [intV, realV]
$ A.FunctionCallList m function22 [realE] $ 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 where
@ -376,7 +412,8 @@ testOccamTypes = TestList
countedIntsC = variable "chanCountedInts" countedIntsC = variable "chanCountedInts"
iirC = variable "chanIIR" iirC = variable "chanIIR"
caseC = variable "chanCaseProto" 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 inputCase c vs = A.Input m c
$ A.InputCase m (A.Several m (map (A.Only m) vs)) $ A.InputCase m (A.Several m (map (A.Only m) vs))
vari tag iis = A.Variant m (simpleName tag) iis skip 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 outputCase c tag ois = A.OutputCase m c (simpleName tag) ois
testRep r = A.Seq m (A.Rep m r sskip) testRep r = A.Seq m (A.Rep m r sskip)
testChoice c = A.If m $ A.Only m c testChoice c = A.If m $ A.Only m c
testOption e o = A.Case m e $ A.Only m o
inv = A.InVariable m inv = A.InVariable m
oute = A.OutExpression m oute = A.OutExpression m
tim = variable "tim" tim = variable "tim"
testAlt a = A.Alt m True $ A.Only m a
--}}} --}}}
tests :: Test tests :: Test