Permalink
Browse files

Moved to parsec

  • Loading branch information...
1 parent 2b3da8f commit 32554fd329168f4782b7ea69508c5491928f0abf @janm399 janm399 committed Jan 23, 2014
File renamed without changes.
@@ -1,7 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Codegen where
+module Custom.Codegen where
import Data.Word
import Data.String
@@ -1,6 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
-module Emit where
+module Custom.Emit where
import LLVM.General.Module
import LLVM.General.Context
@@ -0,0 +1,85 @@
+module Custom.Parser(parseToplevel) where
+
+import Text.Parsec
+import Text.Parsec.String (Parser)
+import Control.Applicative ((<$>))
+
+import qualified Text.Parsec.Expr as Ex
+import qualified Text.Parsec.Token as Tok
+
+import Lexer
+import Custom.Syntax
+
+number :: Parser Expr
+number = do
+ n <- integer
+ return $ Float (fromInteger n)
+
+floating :: Parser Expr
+floating = Float <$> float
+
+binary s assoc = Ex.Infix (reservedOp s >> return (BinaryOp s)) assoc
+
+binops = [[binary "*" Ex.AssocLeft,
+ binary "/" Ex.AssocLeft,
+ binary "" Ex.AssocLeft]
+ ,[binary "+" Ex.AssocLeft,
+ binary "-" Ex.AssocLeft]]
+
+expr :: Parser Expr
+expr = Ex.buildExpressionParser binops factor
+
+variable :: Parser Expr
+variable = Var <$> identifier
+
+function :: Parser Expr
+function = do
+ reserved "def"
+ name <- identifier
+ args <- parens $ many identifier
+ body <- expr
+ return $ Function name args body
+
+extern :: Parser Expr
+extern = do
+ reserved "extern"
+ name <- identifier
+ args <- parens $ many identifier
+ return $ Extern name args
+
+call :: Parser Expr
+call = do
+ name <- identifier
+ args <- parens $ commaSep expr
+ return $ Call name args
+
+factor :: Parser Expr
+factor = try floating
+ <|> try number
+ <|> try call
+ <|> try variable
+ <|> (parens expr)
+
+defn :: Parser Expr
+defn = try extern
+ <|> try function
+ <|> expr
+
+contents :: Parser a -> Parser a
+contents p = do
+ Tok.whiteSpace lexer
+ r <- p
+ eof
+ return r
+
+toplevel :: Parser [Expr]
+toplevel = many $ do
+ def <- defn
+ reservedOp ";"
+ return def
+
+--parseExpr :: String -> Either ParseError Expr
+--parseExpr s = parse (contents expr) "<stdin>" s
+
+parseToplevel :: String -> Either ParseError [Expr]
+parseToplevel s = parse (contents toplevel) "<stdin>" s
@@ -0,0 +1,13 @@
+module Custom.Syntax where
+
+type Name = String
+
+data Expr
+ = Float Double
+ | Var String
+ | Call Name [Expr]
+ | Function Name [Name] Expr
+ | Extern Name [Name]
+ | BinaryOp Name Expr Expr
+ | UnaryOp Name Expr
+ deriving (Eq, Ord, Show)
View
@@ -3,10 +3,13 @@ module Generator(generator, Generator(..), GeneratorDelay) where
import System.Random
import Control.Monad
-import Data.Attoparsec
import Control.Applicative ((<$>))
-import qualified Data.Attoparsec.Char8 as C
-import qualified Data.ByteString.Char8 as B
+
+import Text.Parsec.Error
+import Syntax
+import qualified Parser as P
+import qualified Standard.Parser as SP
+import qualified Custom.Parser as CP
-- |Function that delays the generator for the given number of microseconds.
-- A suitable value is @threadDelay@
@@ -48,22 +51,35 @@ newtype Generator a b = Generator {
-- nums threadDelay return
-- @
generator :: String -- ^The expression to parse
- -> Either String (Generator [Int] b) -- ^The result with errors or the ready Generator
+ -> Either ParseError (Generator [Int] b) -- ^The result with errors or the ready Generator
generator input = do
- (Expression exp rep del) <- parseOnly expression (B.pack input)
+ (Expression exp rep del) <- P.parseExpression input
+ -- not yet used pe
+ pe <- case exp of
+ Standard body -> SP.parseToplevel body >> return ()
+ Custom body -> CP.parseToplevel body >> return ()
+
return $ Generator { runGenerator = \wait -> \f ->
case rep of
- Forever -> forever (mkGenerator exp del wait f)
- Times r -> do { t <- fromRange r; times t (mkGenerator exp del wait f) }
+ Forever -> forever (dummyGenerator del wait f)
+ Times r -> do { t <- fromRange r; times t (dummyGenerator del wait f) }
}
where
+ dummyGenerator :: Delay -> GeneratorDelay -> ([Int] -> IO b) -> IO b
+ dummyGenerator (Fixed delayRange) wait !f = do
+ delay <- fromRange delayRange
+ wait delay
+ f [1, 2, 3]
+
+ {--
mkGenerator :: Distribution -> Delay -> GeneratorDelay -> ([Int] -> IO b) -> IO b
mkGenerator (EvenDistr countRange valueRange) (Fixed delayRange) wait !f = do
count <- fromRange countRange
delay <- fromRange delayRange
values <- replicateM count (fromRange valueRange)
wait delay
f values
+ --}
times :: (Monad m) => Int -> m a -> m a
times 1 m = m
@@ -72,116 +88,3 @@ generator input = do
fromRange :: Range -> IO Int
fromRange (Exact x) = return x
fromRange (Between l u) = ((l +) . (`mod` (u - l)) <$> (randomIO :: IO Int))
-
--- |Range is either a single value or between some upper and lower limit
-data Range =
- -- |Exact value
- Exact Int
- -- |Value between lower and upper limit; lower < upper.
- | Between Int Int deriving (Show)
-
--- |Describes the different values we can generate
-data Distribution =
- -- |Even distribution of a number of values
- EvenDistr Range Range deriving (Show)
-
--- |The repetition rule
-data Repetition =
- -- |We repeat the generating step forever
- Forever
- -- |We repeat specified number of times
- | Times Range deriving (Show)
-
--- |The delay between steps
-data Delay =
- -- |We wait a range of milliseconds
- Fixed Range deriving (Show)
-
--- |Generator expression combines the thing to generate, number of repetitions and
--- the delay between repetitions
-data Expression = Expression Distribution Repetition Delay deriving (Show)
-
-expression :: Parser Expression
-expression = do
- dis <- distribution
- rep <- option defaultRepetition repetition
- del <- option defaultDelay delay
- C.endOfInput
- return $ Expression dis rep del
- where
- defaultRepetition = Forever
- defaultDelay = Fixed (Exact 1000000)
-
--- |Distribution parses the thing to generate. ATM, we only have @evendistr count values@,
--- where count is the number of repetitions and values are the numbers to generate
-distribution :: Parser Distribution
-distribution = do
- choice [even] <?> "Distribution"
- where
- even = do
- C.string "evendistr"
- C.skipSpace
- count <- range
- C.skipSpace
- rng <- range
- return $ EvenDistr count rng
-
--- |Parses the repetition statement; which is either
--- * @forever@
--- * @range@ "times"
--- * "once"
-repetition :: Parser Repetition
-repetition = do
- choice [forever, times, once] <?> "Repetition"
- where
- forever = do
- C.string "forever"
- C.skipSpace
- return Forever
- once = do
- C.string "once"
- C.skipSpace
- return $ Times (Exact 1)
- times = do
- rep <- range
- C.skipSpace
- C.string "times"
- C.skipSpace
- return $ Times rep
-
--- |Parses the delay statement; at the moment, we only have fixed delay with
--- with "every" @range@
-delay :: Parser Delay
-delay = do
- C.string "every"
- C.skipSpace
- val <- range
- C.string "ms"
- C.skipSpace
- return $ Fixed (mult val 1000)
- <?> "Delay"
- where
- mult :: Range -> Int -> Range
- mult (Exact x) y = Exact (x * y)
- mult (Between l u) y = Between (l * y) (u * y)
-
--- |Range is "[" @decimal ".." @decimal@ "]" or @decimal@, for example
--- 5 ~> Exact 5
--- [0..3] ~> Between 0 3
--- [1..0] ~> fail
-range :: Parser Range
-range =
- choice [between, exact] <?> "Range"
- where
- between = do
- C.char '['
- lower <- C.decimal
- C.string ".."
- upper <- C.decimal
- C.char ']'
- C.skipSpace
- if (lower > upper) then fail "Range: lower > upper!" else return $ Between lower (upper + 1)
- exact = do
- val <- C.decimal
- C.skipSpace
- return $ Exact val
View
@@ -2,6 +2,7 @@ module Lexer where
import Text.Parsec.String (Parser)
import Text.Parsec.Language (emptyDef)
+import Control.Applicative ((<$>))
import qualified Text.Parsec.Token as Tok
@@ -19,6 +20,9 @@ lexer = Tok.makeTokenParser style
integer :: Parser Integer
integer = Tok.integer lexer
+int :: Parser Int
+int = fromInteger <$> Tok.integer lexer
+
float :: Parser Double
float = Tok.float lexer
Oops, something went wrong.

0 comments on commit 32554fd

Please sign in to comment.