mjau :)
This commit is contained in:
parent
58e3c8e237
commit
8b19a37d79
39
app/Main.hs
39
app/Main.hs
|
@ -1,4 +1,41 @@
|
|||
module Main where
|
||||
|
||||
import Text.Megaparsec.Error (errorBundlePretty)
|
||||
|
||||
import System.Environment
|
||||
import System.IO
|
||||
import System.Exit
|
||||
import qualified Data.Text.IO as T
|
||||
import Control.Monad ((<=<))
|
||||
|
||||
import Parse (parseExpr)
|
||||
import Type (infer)
|
||||
import CompChez (comp)
|
||||
import Eval (eval)
|
||||
|
||||
main :: IO ()
|
||||
main = putTextLn "mjau"
|
||||
main = getArgs >>= \case
|
||||
[] -> processFile "stdin" stdin
|
||||
xs -> mapM_ (\file -> processFile file =<< openFile file ReadMode) xs
|
||||
|
||||
putStyle :: String -> IO () -- bold blue :)
|
||||
putStyle s = putStrLn ("\x1b[38;5;87m\x1b[1m=>> " ++ s ++ "\x1b[0m")
|
||||
|
||||
processFile :: String -> Handle -> IO ()
|
||||
processFile f h = do
|
||||
contents <- T.hGetContents h
|
||||
case parseExpr f contents of
|
||||
Left e -> putStrLn (errorBundlePretty e)
|
||||
Right ast -> do
|
||||
putStyle "Parse Successful"
|
||||
print ast
|
||||
putStyle "Type Checking / Inferring"
|
||||
case infer [] ast of
|
||||
Nothing -> putStrLn "=> Type error" >> exitWith (ExitFailure 1)
|
||||
Just t -> print t
|
||||
putStyle "Compiling to Chez"
|
||||
putStrLn (comp ast)
|
||||
putStyle "Evaluating"
|
||||
print (eval [] ast)
|
||||
|
||||
|
||||
|
|
6
example/fib
Normal file
6
example/fib
Normal file
|
@ -0,0 +1,6 @@
|
|||
let fib : Int -> Int = fix \f.\x.
|
||||
if 2 > x
|
||||
then 1
|
||||
else f (x-1) + f (x-2)
|
||||
|
||||
in fib 10
|
|
@ -13,6 +13,8 @@ executable gecco
|
|||
|
||||
build-depends: base
|
||||
, gecco
|
||||
, megaparsec
|
||||
, text
|
||||
hs-source-dirs: app
|
||||
default-language: GHC2021
|
||||
default-extensions: LambdaCase
|
||||
|
@ -20,9 +22,7 @@ executable gecco
|
|||
|
||||
|
||||
library
|
||||
exposed-modules: Core
|
||||
, Val
|
||||
, Syn
|
||||
exposed-modules: Syn
|
||||
, Eval
|
||||
, Type
|
||||
, Parse
|
||||
|
|
|
@ -1,4 +0,0 @@
|
|||
module Core where
|
||||
|
||||
test :: String
|
||||
test = "mjau"
|
15
src/Eval.hs
15
src/Eval.hs
|
@ -1,7 +1,20 @@
|
|||
module Eval where
|
||||
|
||||
import Syn
|
||||
import Val
|
||||
|
||||
data Val
|
||||
= I Int
|
||||
| B Bool
|
||||
| U
|
||||
| Clos (Val -> Val)
|
||||
|
||||
instance Show Val where
|
||||
show (I i) = "I " ++ show i
|
||||
show (B b) = "B " ++ show b
|
||||
show U = "U"
|
||||
show (Clos _) = "<CLOS>"
|
||||
|
||||
type Ctx = [Val]
|
||||
|
||||
eval :: Ctx -> Syn -> Val
|
||||
eval ctx (Var i) = ctx !! i
|
||||
|
|
|
@ -25,8 +25,8 @@ instance ShowErrorComponent Text where
|
|||
skipSpace :: Parser ()
|
||||
skipSpace = L.space space1 (L.skipLineComment "--") (L.skipBlockComment "{-" "-}")
|
||||
|
||||
parseExpr :: Text -> Either (ParseErrorBundle Text Text) Syn
|
||||
parseExpr = parse (parser []) "<FILE>"
|
||||
parseExpr :: String -> Text -> Either (ParseErrorBundle Text Text) Syn
|
||||
parseExpr = parse (parser [])
|
||||
|
||||
parser :: Ctx -> Parser Syn
|
||||
parser ctx = do
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
module TestProg where
|
||||
|
||||
import Syn
|
||||
import Val
|
||||
import Eval
|
||||
|
||||
fib :: Syn
|
||||
|
|
15
src/Val.hs
15
src/Val.hs
|
@ -1,15 +0,0 @@
|
|||
module Val where
|
||||
|
||||
data Val
|
||||
= I Int
|
||||
| B Bool
|
||||
| U
|
||||
| Clos (Val -> Val)
|
||||
|
||||
instance Show Val where
|
||||
show (I i) = "I " ++ show i
|
||||
show (B b) = "B " ++ show b
|
||||
show U = "U"
|
||||
show (Clos _) = "<CLOS>"
|
||||
|
||||
type Ctx = [Val]
|
Loading…
Reference in New Issue
Block a user