Skip to content

Commit

Permalink
[AST] fix statement vs expression
Browse files Browse the repository at this point in the history
Fixes #51, #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.

We make the following changes to Statement by
- introduce a `EFor` node to the typed AST.

We update update the evaluator by
- providing an explicit transformer stack (`EvalT`),
- fixing the semantics for for loops, and
- switching to CPS both in evaluator and normaliser.

We also add minor improvements to the codebase by
- fixing `Sign` vs `Sig` naming issue,
- cleaning up some naming conventions, and
- providing `stack bench` benchmark for testing generators for the new
  AST.
  • Loading branch information
Jakub Zalewski committed May 15, 2020
1 parent 0028594 commit 7685541
Show file tree
Hide file tree
Showing 144 changed files with 1,126 additions and 544 deletions.
81 changes: 81 additions & 0 deletions bench/Main.hs
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 ""
19 changes: 19 additions & 0 deletions field/TinyLang/Field/Core.hs
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))
Loading

0 comments on commit 7685541

Please sign in to comment.