This commit is contained in:
2026-05-15 15:42:17 -06:00
parent d38e98d90f
commit 5dcf44222f
6 changed files with 62 additions and 23 deletions

44
app/Gyehoek/Options.hs Normal file
View File

@@ -0,0 +1,44 @@
{-# LANGUAGE NoFieldSelectors #-}
module Gyehoek.Options
( Options(..)
, parser
)
where
import System.IO (Handle)
import Data.HashSet (HashSet)
import Options.Applicative
import qualified Data.HashSet as HS
data Options = MkOptions
{ -- dumpANF :: Maybe FilePath
-- , dumpQBE :: Maybe FilePath
output :: Maybe FilePath
, sourceFiles :: HashSet FilePath
}
deriving (Show)
-- parseDumpQBE =
-- optional $ strOption
-- ( long "dump-qbe"
-- <> metavar "FILE"
-- )
-- parseDumpANF =
-- optional $ strOption
-- ( long "dump-anf"
-- <> metavar "FILE"
-- )
parseOutput =
optional $ strOption
( long "output"
<> short 'o'
<> metavar "FILE"
)
parser :: Parser Options
parser = MkOptions
<$> parseOutput
<*> (HS.fromList <$> some (argument str (metavar "FILES")))

View File

@@ -1,17 +1,25 @@
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedLists #-}
module Main module Main
(main) (main)
where where
import qualified Gyehoek.ANF.Syntax as ANF import qualified Gyehoek.ANF.Syntax as ANF
import Gyehoek.QBE (render) import Gyehoek.QBE (render)
import Gyehoek.Options
import qualified Data.Text.IO as TIO import qualified Data.Text.IO as TIO
import Prelude hiding ((.),id) import Prelude hiding ((.),id)
import Control.Category import Control.Category
import Options.Applicative
main :: IO () main :: IO ()
main = TIO.putStrLn . render $ ANF.expr main = driver =<< execParser opts
where
opts = info (helper <*> parser)
( fullDesc
)
driver :: Options -> IO ()
driver opts = do
print opts

View File

@@ -22,7 +22,7 @@ common ghcstuffs
-Wall -fdefer-type-errors -fno-show-valid-hole-fits -Wall -fdefer-type-errors -fno-show-valid-hole-fits
-fdefer-out-of-scope-variables -fplugin=Effectful.Plugin -fdefer-out-of-scope-variables -fplugin=Effectful.Plugin
other-extensions: default-extensions:
BlockArguments BlockArguments
DeriveGeneric DeriveGeneric
OverloadedStrings OverloadedStrings
@@ -37,14 +37,15 @@ executable gyehoek
other-modules: other-modules:
Gyehoek.ANF.Syntax Gyehoek.ANF.Syntax
Gyehoek.GenSym Gyehoek.GenSym
Gyehoek.Options
Gyehoek.QBE Gyehoek.QBE
Gyehoek.QBE.Parse Gyehoek.QBE.Parse
Gyehoek.Scheme.Syntax Gyehoek.Scheme.Syntax
Gyehoek.Sexp Gyehoek.Sexp
-- other-extensions:
build-depends: build-depends:
, base ^>=4.21.2.0 , base ^>=4.21.2.0
, containers
, effectful , effectful
, effectful-core , effectful-core
, effectful-plugin , effectful-plugin
@@ -60,6 +61,7 @@ executable gyehoek
, sexp-grammar , sexp-grammar
, template-haskell , template-haskell
, text , text
, unordered-containers
, vector , vector
hs-source-dirs: app hs-source-dirs: app

Binary file not shown.

View File

@@ -1,15 +0,0 @@
type :scm = {l 2}
export
function w $main () {
@start
%x0 =l call $GC_malloc (l 16)
%.4 =l add %x0, 8
storel 10, %x0
storel 14, %.4
%x1 =l call $scm_write (l %x0)
%.5 =l mul 22, 18
%.6 =l and %.5, 18446744073709551613
%x2 =l or %.6, 2
%x3 =l call $scm_write (l %x2)
ret %x3
}

View File

@@ -5,7 +5,7 @@ SCM scm_write (SCM x) {
if (SCM_IMP (x)) { if (SCM_IMP (x)) {
printf ("#<immediate %ld>\n", SCM_UNPACK (x) >> 2); printf ("#<immediate %ld>\n", SCM_UNPACK (x) >> 2);
} else { } else {
printf ("#<heap object %ld>\n", SCM_UNPACK(x)); printf ("#<heap object %lx>\n", SCM_UNPACK(x));
} }
return SCM_PACK(NULL); return SCM_PACK(NULL);
} }