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)

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))

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

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₄))))

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
+}