From b672900f46bd32f323bbdd148ab09c35c3797f02 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Tue, 25 Mar 2008 17:27:33 +0000 Subject: [PATCH] Check Case, Alt, and all the trivial processes. --- frontends/OccamTypes.hs | 78 +++++++++++++++++++++++++------------ frontends/OccamTypesTest.hs | 41 ++++++++++++++++++- 2 files changed, 94 insertions(+), 25 deletions(-) diff --git a/frontends/OccamTypes.hs b/frontends/OccamTypes.hs index d222c09..64a2a59 100644 --- a/frontends/OccamTypes.hs +++ b/frontends/OccamTypes.hs @@ -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 diff --git a/frontends/OccamTypesTest.hs b/frontends/OccamTypesTest.hs index e9d3a7a..f58fa9e 100644 --- a/frontends/OccamTypesTest.hs +++ b/frontends/OccamTypesTest.hs @@ -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