This commit is contained in:
44
app/Gyehoek/Options.hs
Normal file
44
app/Gyehoek/Options.hs
Normal 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")))
|
||||||
18
app/Main.hs
18
app/Main.hs
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
BIN
play/a.out
BIN
play/a.out
Binary file not shown.
15
play/t.ssa
15
play/t.ssa
@@ -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
|
|
||||||
}
|
|
||||||
@@ -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);
|
||||||
}
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user