Skip to content

Commit

Permalink
Move arithmetic operations to complex expressions in ANF (#31)
Browse files Browse the repository at this point in the history
  • Loading branch information
AzimMuradov committed Jan 5, 2024
1 parent 03a8ee4 commit 549238e
Show file tree
Hide file tree
Showing 18 changed files with 344 additions and 290 deletions.
54 changes: 27 additions & 27 deletions lib/CodeGen/Llvm/Ir2LlvmIr.hs
Original file line number Diff line number Diff line change
Expand Up @@ -108,7 +108,32 @@ genAtom = \case
AtomUnit -> return $ LLVM.int64 0
AtomBool bool -> return $ LLVM.int64 $ fromBool bool
AtomInt int -> return $ LLVM.int64 $ toInteger int
AtomBinOp op lhs rhs -> do

genComp :: ComplexExpression -> CodeGenM LLVM.Operand
genComp = \case
CompApp f arg -> do
f' <- findAny f
arg' <- genAtom arg
applyF <- findFun (Txt "miniml_apply")
LLVM.call applyF [(f', []), (arg', [])]
CompIte c t e -> mdo
rv <- allocate'

c' <- genAtom c >>= intToBool
LLVM.condBr c' tBlock eBlock

tBlock <- LLVM.block `LLVM.named` "if.then"
store' rv =<< genExpr t
LLVM.br end

eBlock <- LLVM.block `LLVM.named` "if.else"
store' rv =<< genExpr e
LLVM.br end

end <- LLVM.block `LLVM.named` "if.end"

load' rv
CompBinOp op lhs rhs -> do
lhs' <- genAtom lhs
rhs' <- genAtom rhs
let opF = case op of
Expand All @@ -132,37 +157,12 @@ genAtom = \case
GeOp -> LLVM.icmp LLVM.SGE
in (\a b -> cOpF a b >>= boolToInt)
opF lhs' rhs'
AtomUnOp op x -> do
CompUnOp op x -> do
x' <- genAtom x
let opF = case op of
UnMinusOp -> LLVM.mul (LLVM.int64 (-1))
opF x'

genComp :: ComplexExpression -> CodeGenM LLVM.Operand
genComp = \case
CompApp f arg -> do
f' <- findAny f
arg' <- genAtom arg
applyF <- findFun (Txt "miniml_apply")
LLVM.call applyF [(f', []), (arg', [])]
CompIte c t e -> mdo
rv <- allocate'

c' <- genAtom c >>= intToBool
LLVM.condBr c' tBlock eBlock

tBlock <- LLVM.block `LLVM.named` "if.then"
store' rv =<< genExpr t
LLVM.br end

eBlock <- LLVM.block `LLVM.named` "if.else"
store' rv =<< genExpr e
LLVM.br end

end <- LLVM.block `LLVM.named` "if.end"

load' rv

-- Vars & Funs

findAny :: Identifier' -> CodeGenM LLVM.Operand
Expand Down
4 changes: 2 additions & 2 deletions lib/Transformations/Anf/Anf.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,11 +22,11 @@ data AtomicExpression
| AtomUnit
| AtomBool Bool
| AtomInt Int64
| AtomBinOp BinaryOperator AtomicExpression AtomicExpression
| AtomUnOp UnaryOperator AtomicExpression
deriving (Show, Eq)

data ComplexExpression
= CompApp Identifier' AtomicExpression
| CompIte AtomicExpression Expression Expression
| CompBinOp BinaryOperator AtomicExpression AtomicExpression
| CompUnOp UnaryOperator AtomicExpression
deriving (Show, Eq)
4 changes: 2 additions & 2 deletions lib/Transformations/Anf/AnfGen.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,10 +43,10 @@ genExpr (Lfr.ExprVal val) = returnAtom $ case val of
genExpr (Lfr.ExprBinOp op lhs rhs) = evalContT $ do
lhs' <- normalizeToAtom lhs
rhs' <- normalizeToAtom rhs
returnAtom $ Anf.AtomBinOp op lhs' rhs'
returnComplex $ Anf.CompBinOp op lhs' rhs'
genExpr (Lfr.ExprUnOp op x) = evalContT $ do
x' <- normalizeToAtom x
returnAtom $ Anf.AtomUnOp op x'
returnComplex $ Anf.CompUnOp op x'
genExpr (Lfr.ExprApp f arg) = evalContT $ do
f' <- normalizeToId f
arg' <- normalizeToAtom arg
Expand Down
4 changes: 2 additions & 2 deletions lib/Transformations/Anf/PrettyPrinter.hs
Original file line number Diff line number Diff line change
Expand Up @@ -51,15 +51,15 @@ prettyComplex = \case
let eText = createIndent indent <> "else " <> e'
modify $ \x -> x - 4
return $ cText <> tText <> eText
CompBinOp op lhs rhs -> return $ parens (unwords [prettyAtomic lhs, prettyBinOp op, prettyAtomic rhs])
CompUnOp op x -> return $ parens $ prettyUnOp op <> prettyAtomic x

prettyAtomic :: AtomicExpression -> String
prettyAtomic = \case
AtomId name -> prettyId name
AtomUnit -> "()"
AtomBool value -> if value then "true" else "false"
AtomInt value -> show value
AtomBinOp op lhs rhs -> parens (unwords [prettyAtomic lhs, prettyBinOp op, prettyAtomic rhs])
AtomUnOp op x -> parens $ prettyUnOp op <> prettyAtomic x

prettyId :: Identifier' -> String
prettyId (Txt n) = unpack n
Expand Down
62 changes: 37 additions & 25 deletions test/Sample/Anf/HardTest.anf
Original file line number Diff line number Diff line change
@@ -1,35 +1,47 @@
let g'1 a'2 b'3 =
if ((a'2 = 0) || (b'3 = 1))
then true
else
let anf'18 = (g'1 (a'2 - 1))
in (anf'18 (b'3 + 5));;
let anf'20 =
let anf'18 = (a'2 = 0)
in
let anf'19 = (b'3 = 1)
in (anf'18 || anf'19)
in
if anf'20
then true
else
let anf'22 =
let anf'21 = (a'2 - 1)
in (g'1 anf'21)
in
let anf'23 = (b'3 + 5)
in (anf'22 anf'23);;
let h'4 m'5 p'6 z'7 =
let m'8 = (p'6 + z'7)
in
if (m'8 = 1)
then
let anf'20 =
let anf'19 = (h'4 0)
in (anf'19 0)
in (anf'20 z'7)
else
let anf'21 = (g'1 m'8)
in (anf'21 p'6);;
let anf'24 = (m'8 = 1)
in
if anf'24
then
let anf'26 =
let anf'25 = (h'4 0)
in (anf'25 0)
in (anf'26 z'7)
else
let anf'27 = (g'1 m'8)
in (anf'27 p'6);;
let g'9 =
let anf'23 =
let anf'22 = (g'1 0)
in (anf'22 2)
let anf'29 =
let anf'28 = (g'1 0)
in (anf'28 2)
in
let anf'26 =
let anf'25 =
let anf'24 = (h'4 2)
in (anf'24 2)
in (anf'25 2)
in (anf'23 + anf'26);;
let anf'32 =
let anf'31 =
let anf'30 = (h'4 2)
in (anf'30 2)
in (anf'31 2)
in (anf'29 + anf'32);;
let g'11 a'10 = (a'10 + 1);;
let g'13 b'12 =
let anf'27 = (g'11 b'12)
in (anf'27 + 2);;
let anf'33 = (g'11 b'12)
in (anf'33 + 2);;
let simp'14 = (g'13 5);;
let k'17 x'15 x'16 = x'16;;
16 changes: 11 additions & 5 deletions test/Sample/Anf/SimpleTest.anf
Original file line number Diff line number Diff line change
@@ -1,8 +1,14 @@
let g'1 x'2 =
if (x'2 < 0)
then 0
else (g'1 (x'2 + 1));;
let anf'6 = (x'2 < 0)
in
if anf'6
then 0
else
let anf'7 = (x'2 + 1)
in (g'1 anf'7);;
let g'4 x'3 =
let anf'6 = (g'1 (-5))
in (anf'6 + x'3);;
let anf'9 =
let anf'8 = (-5)
in (g'1 anf'8)
in (anf'9 + x'3);;
let simp'5 = (g'4 3);;
18 changes: 11 additions & 7 deletions test/Sample/Factorial/FacRec.anf
Original file line number Diff line number Diff line change
@@ -1,9 +1,13 @@
let factorial'1 n'2 =
if (n'2 <= 0)
then 1
else
let anf'4 = (factorial'1 (n'2 - 1))
in (n'2 * anf'4);;
let anf'4 = (n'2 <= 0)
in
if anf'4
then 1
else
let anf'6 =
let anf'5 = (n'2 - 1)
in (factorial'1 anf'5)
in (n'2 * anf'6);;
let simp'3 =
let anf'5 = (factorial'1 5)
in (print_int anf'5);;
let anf'7 = (factorial'1 5)
in (print_int anf'7);;
32 changes: 16 additions & 16 deletions test/Sample/Factorial/FacRec.ll
Original file line number Diff line number Diff line change
Expand Up @@ -24,38 +24,38 @@ declare external ccc i64 @miniml_apply(i64, i64)

define external ccc i64 @factorial.1(i64 %n.2_0) {
; <label>:0:
%anf.4_0 = icmp sle i64 %n.2_0, 0
%anf.4_1 = zext i1 %anf.4_0 to i64
%1 = alloca i64
%2 = icmp sle i64 %n.2_0, 0
%3 = zext i1 %2 to i64
%4 = trunc i64 %3 to i1
br i1 %4, label %if.then_0, label %if.else_0
%2 = trunc i64 %anf.4_1 to i1
br i1 %2, label %if.then_0, label %if.else_0
if.then_0:
store i64 1, i64* %1
br label %if.end_0
if.else_0:
%anf.4_0 = ptrtoint i64 (i64)* @factorial.1 to i64
%anf.4_1 = call ccc i64 @miniml_fun_to_paf(i64 %anf.4_0, i64 1)
%anf.4_2 = sub i64 %n.2_0, 1
%anf.4_3 = call ccc i64 @miniml_apply(i64 %anf.4_1, i64 %anf.4_2)
%5 = mul i64 %n.2_0, %anf.4_3
store i64 %5, i64* %1
%anf.5_0 = sub i64 %n.2_0, 1
%anf.6_0 = ptrtoint i64 (i64)* @factorial.1 to i64
%anf.6_1 = call ccc i64 @miniml_fun_to_paf(i64 %anf.6_0, i64 1)
%anf.6_2 = call ccc i64 @miniml_apply(i64 %anf.6_1, i64 %anf.5_0)
%3 = mul i64 %n.2_0, %anf.6_2
store i64 %3, i64* %1
br label %if.end_0
if.end_0:
%6 = load i64, i64* %1
ret i64 %6
%4 = load i64, i64* %1
ret i64 %4
}


@simp.3 = global i64 0


define external ccc i64 @main() {
%anf.5_0 = ptrtoint i64 (i64)* @factorial.1 to i64
%anf.5_1 = call ccc i64 @miniml_fun_to_paf(i64 %anf.5_0, i64 1)
%anf.5_2 = call ccc i64 @miniml_apply(i64 %anf.5_1, i64 5)
%anf.7_0 = ptrtoint i64 (i64)* @factorial.1 to i64
%anf.7_1 = call ccc i64 @miniml_fun_to_paf(i64 %anf.7_0, i64 1)
%anf.7_2 = call ccc i64 @miniml_apply(i64 %anf.7_1, i64 5)
%1 = ptrtoint i64 (i64)* @print_int to i64
%2 = call ccc i64 @miniml_fun_to_paf(i64 %1, i64 1)
%3 = call ccc i64 @miniml_apply(i64 %2, i64 %anf.5_2)
%3 = call ccc i64 @miniml_apply(i64 %2, i64 %anf.7_2)
store i64 %3, i64* @simp.3
ret i64 0
}
34 changes: 20 additions & 14 deletions test/Sample/Factorial/FacRecCps.anf
Original file line number Diff line number Diff line change
@@ -1,18 +1,24 @@
let id'2 x'1 = x'1;;
let ll'10 n'4 k'5 result'6 = (k'5 (n'4 * result'6));;
let ll'10 n'4 k'5 result'6 =
let anf'11 = (n'4 * result'6)
in (k'5 anf'11);;
let cps_factorial'3 n'4 k'5 =
if (n'4 = 0)
then (k'5 1)
else
let anf'11 = (cps_factorial'3 (n'4 - 1))
in
let anf'13 =
let anf'12 = (ll'10 n'4)
in (anf'12 k'5)
in (anf'11 anf'13);;
let anf'12 = (n'4 = 0)
in
if anf'12
then (k'5 1)
else
let anf'14 =
let anf'13 = (n'4 - 1)
in (cps_factorial'3 anf'13)
in
let anf'16 =
let anf'15 = (ll'10 n'4)
in (anf'15 k'5)
in (anf'14 anf'16);;
let factorial'8 n'7 =
let anf'14 = (cps_factorial'3 n'7)
in (anf'14 id'2);;
let anf'17 = (cps_factorial'3 n'7)
in (anf'17 id'2);;
let simp'9 =
let anf'15 = (factorial'8 5)
in (print_int anf'15);;
let anf'18 = (factorial'8 5)
in (print_int anf'18);;
Loading

0 comments on commit 549238e

Please sign in to comment.