🤡

a5/src/APL/Parser.hs

@@ -1,4 +1,4 @@
-module APL.Parser (parseAPL) where
+module APL.Parser (parseAPL, keywords) where
 
 import APL.AST (Exp (..), VName)
 import Control.Monad (void)

a5/src/APL/Tests.hs

@@ -1,9 +1,11 @@
 module APL.Tests
-  ( properties
+  ( properties,
+    genVar
   )
 where
 
-import APL.AST (Exp (..), subExp)
+import APL.AST (Exp (..), subExp, VName, printExp)
+import APL.Parser (parseAPL, keywords)
 import APL.Error (isVariableError, isDomainError, isTypeError)
 import APL.Check (checkExp)
 import Test.QuickCheck
@@ -15,10 +17,25 @@ import Test.QuickCheck
   , checkCoverage
   , oneof
   , sized
+  , frequency
+  , elements
+  , listOf
+  , suchThat
+  , resize
   )
 
+genString :: Gen String
+genString = resize 4 $ listOf $ elements ['a'..'z']
+
+varTest :: String -> Bool
+varTest s = (not (s `elem` keywords)) && ((length s) > 1)
+
+genVar :: Gen String
+genVar = suchThat (genString) (varTest)
+
+
 instance Arbitrary Exp where
-  arbitrary = sized genExp
+  arbitrary = sized (genExp [])
 
   shrink (Add e1 e2) =
     e1 : e2 : [Add e1' e2 | e1' <- shrink e1] ++ [Add e1 e2' | e2' <- shrink e2]
@@ -44,24 +61,34 @@ instance Arbitrary Exp where
     e1 : e2 : [TryCatch e1' e2 | e1' <- shrink e1] ++ [TryCatch e1 e2' | e2' <- shrink e2]
   shrink _ = []
 
-genExp :: Int -> Gen Exp
+genExp :: [VName] -> Int -> Gen Exp
-genExp 0 = oneof [CstInt <$> arbitrary, CstBool <$> arbitrary]
+genExp _ 0 = oneof [CstInt <$> arbitrary, CstBool <$> arbitrary]
-genExp size =
+genExp vars size =
-  oneof
+  frequency
-    [ CstInt <$> arbitrary
+    [ (1, CstInt <$> arbitrary)
-    , CstBool <$> arbitrary
+    , (1, CstBool <$> arbitrary)
-    , Add <$> genExp halfSize <*> genExp halfSize
+    , (1, Add <$> genExp vars halfSize <*> genExp vars halfSize)
-    , Sub <$> genExp halfSize <*> genExp halfSize
+    , (1, Sub <$> genExp vars halfSize <*> genExp vars halfSize)
-    , Mul <$> genExp halfSize <*> genExp halfSize
+    , (1, Mul <$> genExp vars halfSize <*> genExp vars halfSize)
-    , Div <$> genExp halfSize <*> genExp halfSize
+    , (1, Div <$> genExp vars halfSize <*> genExp vars halfSize)
-    , Pow <$> genExp halfSize <*> genExp halfSize
+    , (1, Pow <$> genExp vars halfSize <*> genExp vars halfSize)
-    , Eql <$> genExp halfSize <*> genExp halfSize
+    , (1, Eql <$> genExp vars halfSize <*> genExp vars halfSize)
-    , If <$> genExp thirdSize <*> genExp thirdSize <*> genExp thirdSize
+    , (1, If <$> genExp vars thirdSize <*> genExp vars thirdSize <*> genExp vars thirdSize)
-    , Var <$> arbitrary
+    , (1, Var <$> arbitrary)
-    , Let <$> arbitrary <*> genExp halfSize <*> genExp halfSize
+    , (if (length vars) > 0 then 50 else 0, Var <$> elements vars)
-    , Lambda <$> arbitrary <*> genExp (size - 1)
+    , (25, do
-    , Apply <$> genExp halfSize <*> genExp halfSize 
+        var <- genVar
-    , TryCatch <$> genExp halfSize <*> genExp halfSize
+        e1 <- genExp vars halfSize
+        e2 <- genExp (var:vars) halfSize
+        pure $ Let var e1 e2
+      )
+    , (25, do
+        var <- genVar
+        body <- genExp vars (size - 1)
+        pure $ Lambda var body
+      )
+    , (1, Apply <$> genExp vars halfSize <*> genExp vars halfSize)
+    , (1, TryCatch <$> genExp vars halfSize <*> genExp vars halfSize)
     ]
   where
     halfSize = size `div` 2
@@ -79,7 +106,9 @@ expCoverage e = checkCoverage
   $ ()
 
 parsePrinted :: Exp -> Bool
-parsePrinted _ = undefined
+parsePrinted e = case (parseAPL "input" (printExp e)) of
+  Left _ -> False
+  Right e' -> e == e'
 
 onlyCheckedErrors :: Exp -> Bool
 onlyCheckedErrors _ = undefined
@@ -87,6 +116,6 @@ onlyCheckedErrors _ = undefined
 properties :: [(String, Property)]
 properties =
   [ ("expCoverage", property expCoverage)
-  , ("onlyCheckedErrors", property onlyCheckedErrors)
   , ("parsePrinted", property parsePrinted)
+  , ("onlyCheckedErrors", property onlyCheckedErrors)
   ]