This commit is contained in:
2026-05-15 23:08:53 -06:00
parent be52c7b97d
commit 0bb66acae0
6 changed files with 29 additions and 8 deletions

View File

@@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ViewPatterns #-}
module Main module Main
(main) (main)
where where
@@ -15,7 +16,7 @@ import Options.Applicative
import Control.Lens import Control.Lens
import Data.Generics.Labels import Data.Generics.Labels
import System.OsPath (OsPath) import System.OsPath (OsPath)
import System.FilePath ((-<.>)) import System.FilePath ((-<.>), dropExtension)
import Effectful.FileSystem import Effectful.FileSystem
import Effectful import Effectful
import Effectful.FileSystem.IO qualified as FS import Effectful.FileSystem.IO qualified as FS
@@ -88,13 +89,29 @@ callQBE
callQBE f = do callQBE f = do
let asm_file = f -<.> "s" let asm_file = f -<.> "s"
qbe_file = f -<.> "ssa" qbe_file = f -<.> "ssa"
C.StdoutTrimmed stdout <- C.StdoutUntrimmed stdout <-
C.run $ C.cmd "qbe" & C.addArgs [qbe_file] C.run $ C.cmd "qbe" & C.addArgs [qbe_file]
FS.withFile asm_file FS.WriteMode \h -> do FS.withFile asm_file FS.WriteMode \h -> do
hPutStr h stdout hPutStr h stdout
hPutStrLn FS.stderr $ "wrote " <> T.pack asm_file hPutStrLn FS.stderr $ "wrote " <> T.pack asm_file
pure asm_file pure asm_file
callGCC
:: (GenSym :> es, FileSystem :> es, IOE :> es)
=> FilePath -> List String -> Eff es FilePath
callGCC f args = do
let asm_file = f -<.> "s"
exe = dropExtension f
C.StdoutTrimmed (T.words -> flags) <-
C.run $ C.cmd "pkg-config"
& C.addArgs @String ["--cflags", "--libs", "bdw-gc"]
C.run_ $ C.cmd "cc"
& C.addArgs flags
& C.addArgs ["-o", exe, asm_file]
& C.addArgs args
hPutStrLn FS.stderr $ "wrote " <> T.pack exe
pure exe
driver driver
:: (GenSym :> es, FileSystem :> es, IOE :> es) :: (GenSym :> es, FileSystem :> es, IOE :> es)
=> Options -> Eff es () => Options -> Eff es ()
@@ -103,4 +120,5 @@ driver = runGenSym . traverseOf_ (#sourceFiles . folded) \f -> do
anfs <- toANF f exps anfs <- toANF f exps
qbe <- toQBE f anfs qbe <- toQBE f anfs
callQBE f callQBE f
callGCC f ["../runtime/gyehoek.c"]
pure () pure ()

BIN
play/t Executable file

Binary file not shown.

View File

@@ -1,4 +1,4 @@
;;; -*- mode:scheme -*- ;;; -*- mode:scheme -*-
(let ((x0 (prim:write 4))) x0) (let ((x0 (prim:+ 2 4)) (x1 (prim:write x0))) x1)

View File

@@ -3,7 +3,7 @@
main: main:
pushq %rbp pushq %rbp
movq %rsp, %rbp movq %rsp, %rbp
movl $18, %edi movl $30, %edi
callq scm_write callq scm_write
leave leave
ret ret

View File

@@ -1 +1 @@
(prim:write 4) (prim:write (prim:+ 2 4))

View File

@@ -1,6 +1,9 @@
export export
function w $main () { function w $main () {
@start @start
%x0 =l call $scm_write (l 18) %.2 =l add 10, 18
ret %x0 %.3 =l and %.2, 18446744073709551613
%x0 =l or %.3, 2
%x1 =l call $scm_write (l %x0)
ret %x1
} }