projects
/
kaleidoscope-hs-old.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
7393377
)
Add support for more binary ops
author
Luke Lau
<luke_lau@icloud.com>
Sun, 10 Mar 2019 12:37:36 +0000
(12:37 +0000)
committer
Luke Lau
<luke_lau@icloud.com>
Wed, 17 Apr 2019 22:38:30 +0000
(23:38 +0100)
AST.hs
patch
|
blob
|
history
Main.hs
patch
|
blob
|
history
diff --git
a/AST.hs
b/AST.hs
index 6528215422482fbfa3111faece64c3ff80205983..424cfbe7b13010e0960e4b88a1675cdcfa3b3f0f 100644
(file)
--- a/
AST.hs
+++ b/
AST.hs
@@
-1,20
+1,26
@@
module AST where
import Text.Read
module AST where
import Text.Read
-import Text.ParserCombinators.ReadP hiding ((+++))
+import Text.ParserCombinators.ReadP hiding ((+++)
, choice
)
+data BinOpType = Add | Sub | Mul
+ deriving Show
data Expr = Num Float
data Expr = Num Float
- |
Add
Expr Expr
+ |
BinOp BinOpType
Expr Expr
deriving Show
instance Read Expr where
deriving Show
instance Read Expr where
- readPrec = parseNum +++ parseAdd
+ readPrec = choice [ parseNum
+ , parseBinOp '+' Add
+ , parseBinOp '-' Sub
+ , parseBinOp '*' Mul
+ ]
where parseNum = Num <$> readPrec
where parseNum = Num <$> readPrec
- parse
Add
= step $ do
+ parse
BinOp c typ
= step $ do
a <- prec 11 readPrec
lift $ do
skipSpaces
a <- prec 11 readPrec
lift $ do
skipSpaces
- char
'+'
+ char
c
skipSpaces
b <- readPrec
skipSpaces
b <- readPrec
- return (
Add
a b)
+ return (
BinOp typ
a b)
diff --git
a/Main.hs
b/Main.hs
index 2d838d339da3d1a04c5354fc8e920085aa565d0e..8f4610af8b249920f0b03e67091804ad70c34faa 100644
(file)
--- a/
Main.hs
+++ b/
Main.hs
@@
-35,7
+35,11
@@
main = do
build :: AST.Expr -> IRBuilderT ModuleBuilder Operand
build (AST.Num a) = pure $ ConstantOperand (Float (Single a))
build :: AST.Expr -> IRBuilderT ModuleBuilder Operand
build (AST.Num a) = pure $ ConstantOperand (Float (Single a))
-build (AST.
Add
a b) = do
+build (AST.
BinOp op
a b) = do
va <- build a
vb <- build b
va <- build a
vb <- build b
- fadd va vb
+ let instr = case op of
+ AST.Add -> fadd
+ AST.Sub -> fsub
+ AST.Mul -> fmul
+ instr va vb