forked from effectfully/tiny-lang
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Fixes effectfully#51, effectfully#52 We make the following changes to the AST by adding - a newly introduced a top-level `Program` node, which is parent to - a newly introduced `Statements` node, which is parent to - a `Statement` node, which is chaned to be a parent of - an `Expr` node. In addition we introduce a `EFor` node to the typed AST. We update update the evaluator by providing an explicit transformer stack, `EvalT`, and we fix the semantics for for loops. We also add the following minor improvements - we fix `Sign` vs `Sig` naming issue, - clean up some naming conventions, - provide `stack bench` benchmark for testing generators for the new AST.
- Loading branch information
Jakub Zalewski
committed
May 14, 2020
1 parent
0028594
commit 8a10069
Showing
144 changed files
with
1,154 additions
and
545 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,81 @@ | ||
import TinyLang.Field.Generator () | ||
import TinyLang.Field.Typed.Core | ||
|
||
import Control.Monad | ||
import Data.List | ||
import Test.QuickCheck | ||
|
||
-- A couple of functions for checking the output of generators | ||
progNodes :: Program f -> Int | ||
progNodes = stmtsNodes . unProgram | ||
|
||
stmtsNodes :: Statements f -> Int | ||
stmtsNodes = sum . map stmtNodes . unStatements | ||
|
||
stmtNodes :: Statement f -> Int | ||
stmtNodes (ELet _ e) = 1 + exprNodes e | ||
stmtNodes (EAssert e) = 1 + exprNodes e | ||
stmtNodes (EFor _ _ _ stmts) = 1 + stmtsNodes stmts | ||
|
||
exprNodes :: Expr f a -> Int | ||
exprNodes (EConst _) = 1 | ||
exprNodes (EVar _) = 1 | ||
exprNodes (EAppUnOp _ e) = 1 + exprNodes e | ||
exprNodes (EAppBinOp _ e1 e2) = 1 + exprNodes e1 + exprNodes e2 | ||
exprNodes (EIf e e1 e2) = 1 + exprNodes e + exprNodes e1 + exprNodes e2 | ||
|
||
progDepth :: Program f -> Int | ||
progDepth = stmtsDepth . unProgram | ||
|
||
stmtsDepth :: Statements f -> Int | ||
stmtsDepth = maximum . (0:) . map stmtDepth . unStatements | ||
|
||
stmtDepth :: Statement f -> Int | ||
stmtDepth (ELet _ e) = 1 + exprDepth e | ||
stmtDepth (EAssert e) = 1 + exprDepth e | ||
stmtDepth (EFor _ _ _ stmts) = 1 + stmtsDepth stmts | ||
|
||
exprDepth :: Expr f a -> Int | ||
exprDepth (EConst _) = 1 | ||
exprDepth (EVar _) = 1 | ||
exprDepth (EAppUnOp _ e) = 1 + exprDepth e | ||
exprDepth (EAppBinOp _ e1 e2) = 1 + max (exprDepth e1) (exprDepth e2) | ||
exprDepth (EIf e e1 e2) = 1 + max (exprDepth e) (max (exprDepth e1) (exprDepth e2)) | ||
|
||
data TestResult = TestResult { nodes :: Int | ||
, depth :: Int | ||
} | ||
deriving (Show) | ||
|
||
runGen :: Int -> IO TestResult | ||
runGen size = do | ||
prog <- generate (resize size arbitrary) :: IO (Program (AField Rational)) | ||
pure $ TestResult (progNodes prog) (progDepth prog) | ||
|
||
average :: (Real a, Fractional b) => [a] -> b | ||
average xs = realToFrac (sum xs) / genericLength xs | ||
|
||
main :: IO () | ||
main = do | ||
let size = 1000 | ||
let runs = 1000 :: Int | ||
putStrLn $ "Requested runs: " ++ show runs | ||
putStrLn $ "Requested size: " ++ show size | ||
results <- forM [1 .. runs] $ \_ -> runGen size | ||
let nodess = map nodes results | ||
let depths = map depth results | ||
let minn = minimum nodess | ||
let maxn = maximum nodess | ||
let avgn = average nodess :: Double | ||
let maxd = maximum depths | ||
let mind = minimum depths | ||
let avgd = average depths :: Double | ||
putStrLn "" | ||
putStrLn $ "Minimum depth = " ++ show mind | ||
putStrLn $ "Maximum depth = " ++ show maxd | ||
putStrLn $ "Mean depth = " ++ show avgd | ||
putStrLn "" | ||
putStrLn $ "Minimum number of nodes = " ++ show minn | ||
putStrLn $ "Maximum number of nodes = " ++ show maxn | ||
putStrLn $ "Mean number of nodes = " ++ show avgn | ||
putStrLn "" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,19 @@ | ||
-- | Basic structure of our programs | ||
|
||
module TinyLang.Field.Core | ||
( Program (..) | ||
, Statements (..) | ||
) where | ||
|
||
import GHC.Generics | ||
import Quiet | ||
|
||
-- | Basic wrapper of statements | ||
newtype Statements stmt = Statements { unStatements :: [stmt] } | ||
deriving (Generic, Eq, Functor, Foldable, Traversable) | ||
deriving (Show) via (Quiet (Statements stmt)) | ||
|
||
-- | Basic wrapper of program | ||
newtype Program stmt = Program { unProgram :: (Statements stmt) } | ||
deriving (Generic, Eq, Functor, Foldable, Traversable) | ||
deriving (Show) via (Quiet (Program stmt)) |
Oops, something went wrong.