diff --git a/a.out b/a.out new file mode 100755 index 0000000..5b911a9 Binary files /dev/null and b/a.out differ diff --git a/app/Gyehoek/ANF.hs b/app/Gyehoek/ANF.hs index 9d20d23..ac831e6 100644 --- a/app/Gyehoek/ANF.hs +++ b/app/Gyehoek/ANF.hs @@ -7,7 +7,7 @@ {-# OPTIONS_GHC -Wno-orphans -Wno-unused-matches -Wno-missing-signatures #-} {- HLINT ignore "Avoid lambda using `infix`" -} module Gyehoek.ANF - (toANF) + (toANF, lower) where import Data.Text (Text) @@ -28,6 +28,8 @@ import Data.Foldable import Data.List.NonEmpty (NonEmpty((:|)), toList) import Gyehoek.QBE (FuncDef(FuncDef)) import Data.Foldable1 +import qualified Data.Text as T +import Data.String (fromString) -- data Val @@ -107,6 +109,7 @@ instance Semigroup QBE.Program where QBE.Program (ts <> ts') (ds <> ds') (fs <> fs') instance Monoid QBE.Program where + mempty :: QBE.Program mempty = QBE.Program mempty mempty mempty funcdef :: QBE.Ident QBE.Global -> [QBE.Param] -> NonEmpty QBE.Block -> FuncDef @@ -148,6 +151,16 @@ buildBlock :: QBE.Ident QBE.Label -> BlockBuilder -> QBE.Block buildBlock n bb = QBE.Block n [] (is ^.. each) j where (is,j) = evalBlockBuilder bb +lowerName :: Name -> QBE.Ident t +lowerName = fromString . T.unpack + +lowerPrim :: Prim -> _ -> _ +lowerPrim PrimAdd k = k $ QBE.ValGlobal "plus" +lowerPrim PrimMul k = k $ QBE.ValGlobal "star" +lowerPrim PrimSub k = k $ QBE.ValGlobal "_" +lowerPrim PrimDiv k = k $ QBE.ValGlobal "slash" +lowerPrim p k = _ + lowerVal :: forall es. (GenSym :> es) => Val @@ -155,6 +168,8 @@ lowerVal -> Eff es BlockBuilder lowerVal (ValInt n) k = k . QBE.ValConst . QBE.CInt . fromIntegral $ n +lowerVal (ValVar x) k = k . QBE.ValTemporary . lowerName $ x +lowerVal (ValPrim p) k = lowerPrim p k lowerVal _ k = _ lower' @@ -167,9 +182,8 @@ lower' (ExpVal v) k = lowerVal v k lower' (ExpLetApply r f xs e) k = blah (lowerVal @es <$> (f:|xs)) \(f':xs') -> do - r <- gensym Emit [ QBE.Call - (Just (r, QBE.AbiBaseTy QBE.Long)) + (Just (lowerName r, QBE.AbiBaseTy QBE.Long)) f' Nothing (QBE.Arg (QBE.AbiBaseTy QBE.Long) <$> xs') @@ -179,6 +193,11 @@ lower' (ExpLetApply r f xs e) k = lower' _ k = _ --- lower e = do --- _ <- runCodeGen (lower' e \r -> _) --- _ +lower :: GenSym :> es => QBE.Ident QBE.Label -> Exp -> Eff es QBE.Block +lower n e = buildBlock n <$> lower' e (pure . Exit . QBE.Ret . Just) + +wrapProgram :: Foldable1 t => t QBE.Block -> QBE.Program +wrapProgram bs = QBE.Program [] [] [main] where + main = QBE.FuncDef [QBE.Export] + (Just (QBE.AbiBaseTy QBE.Word)) + "main" Nothing [] QBE.NoVariadic (toNonEmpty bs) diff --git a/closure.scm b/closure.scm new file mode 100644 index 0000000..547a0eb --- /dev/null +++ b/closure.scm @@ -0,0 +1,15 @@ +(define (adder x) + (lambda (y) + (+ x y))) + +((adder 3) 4) + + + +(define (adder x) + (list (lambda (self y) + (+ (nth self 1) y)) + x)) + +(let ((closure (adder 3))) + ((nth closure 0) closure 4)) diff --git a/t.s b/t.s new file mode 100644 index 0000000..1eda806 --- /dev/null +++ b/t.s @@ -0,0 +1,70 @@ +.text +zerop: + pushq %rbp + movq %rsp, %rbp + cmpl $0, %edi + jnz .Lbb2 + movl $1, %eax + jmp .Lbb3 +.Lbb2: + movl $0, %eax +.Lbb3: + leave + ret +.type zerop, @function +.size zerop, .-zerop +/* end function zerop */ + +.text +factorial: + pushq %rbp + movq %rsp, %rbp + subq $8, %rsp + pushq %rbx + movq %rdi, %rbx + callq zerop + movq %rbx, %rdi + cmpl $0, %eax + jnz .Lbb6 + movq %rdi, %rbx + subq $1, %rdi + callq factorial + movq %rbx, %rdi + imulq %rdi, %rax + jmp .Lbb7 +.Lbb6: + movl $1, %eax +.Lbb7: + popq %rbx + leave + ret +.type factorial, @function +.size factorial, .-factorial +/* end function factorial */ + +.data +.balign 8 +fstr: + .ascii "fac 3 = %d\n" + .byte 0 +/* end data */ + +.text +.globl main +main: + pushq %rbp + movq %rsp, %rbp + movl $3, %edi + callq factorial + movq %rax, %rsi + leaq fstr(%rip), %rdi + movl $0, %eax + callq printf + movl $0, %eax + leave + ret +.type main, @function +.size main, .-main +/* end function main */ + +.section .note.GNU-stack,"",@progbits diff --git a/t.scm b/t.scm new file mode 100644 index 0000000..fb8a3c8 --- /dev/null +++ b/t.scm @@ -0,0 +1,16 @@ +(define (factorial n) + (if (zero? n) + 1 + (* n (factorial (- n 1))))) + + +;;; ANF + +(define (factorial n) + (let ((r₁ (zero? n))) + (if r₁ + 1 + (let ((r₂ (- n 1)) + (r₃ (factorial r₂)) + (r₄ (* n r₃))) + r₄)))) diff --git a/t.ssa b/t.ssa new file mode 100644 index 0000000..aa7270b --- /dev/null +++ b/t.ssa @@ -0,0 +1,30 @@ +function l $zerop (l %n) { +@start + jnz %n, @b1, @b2 +@b1 + ret 0 +@b2 + ret 1 +} + +function l $factorial (l %n) { +@start + %r1 =l call $zerop (l %n) + jnz %r1, @b1, @b2 +@b1 + ret 1 +@b2 + %r2 =l sub %n, 1 + %r3 =l call $factorial (l %r2) + %r4 =l mul %n, %r3 + ret %r4 +} + +data $fstr = { b "fac 3 = %d\n", b 0 } + +export function w $main () { +@start + %r =l call $factorial (l 3) + call $printf (l $fstr, ..., l %r) + ret 0 +} \ No newline at end of file