implement: repl

.gitignore

@@ -1,4 +1,4 @@
 .stack-work/
-compiler-demo.cabal
+keli-compiler.cabal
 *~
 youtube

ChangeLog.md

@@ -1,3 +1,3 @@
-# Changelog for compiler-demo
+# Changelog for keli-compiler
 
 ## Unreleased changes

app/Main.hs

@@ -1,7 +1,8 @@
 {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} -- for exhasutive pattern checking
 module Main where
 
-import Keli
+import Repl
+import Cli
 
 main :: IO ()
-main = print "hello world"
+main = keliRepl

package.yaml

@@ -1,6 +1,6 @@
-name:                compiler-demo
+name:                keli-compiler
 version:             0.1.0.0
-github:              "githubuser/compiler-demo"
+github:              "githubuser/keli-compiler"
 license:             BSD3
 author:              "Author name here"
 maintainer:          "example@example.com"
@@ -17,7 +17,7 @@ extra-source-files:
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
-description:         Please see the README on GitHub at <https://github.com/githubuser/compiler-demo#readme>
+description:         Please see the README on GitHub at <https://github.com/githubuser/keli-compiler#readme>
 
 dependencies:
 - base >= 4.7 && < 5
@@ -37,7 +37,7 @@ library:
   source-dirs: src
 
 executables:
-  compiler-demo-exe:
+  keli-compiler-exe:
     main:                Main.hs
     source-dirs:         app
     ghc-options:
@@ -46,16 +46,16 @@ executables:
     - -with-rtsopts=-N
     - -Wall
     dependencies:
-    - compiler-demo
+    - keli-compiler
 
 tests:
-  compiler-demo-test:
+  keli-compiler-test:
     main:                Spec.hs
     source-dirs:         test
     ghc-options:
     - -threaded
     - -rtsopts
     - -with-rtsopts=-N
     dependencies:
-    - compiler-demo
+    - keli-compiler
     - hspec

src/Analyzer.hs

@@ -16,8 +16,8 @@ import TypeCheck
 
 analyze :: [Raw.Decl] -> Either KeliError [KeliSymbol]
 analyze decls = do
-    finalSymtab        <- analyzeDecls decls
-    let analyzedSymbols = map snd (assocs finalSymtab)
+    (finalSymtab, _) <- analyzeDecls emptyKeliSymTab decls  
+    let analyzedSymbols = extractSymbols finalSymtab
 
     -- sorting is necessary, so that the transpilation order will be correct
     -- Smaller number means will be transpiled first
@@ -33,20 +33,30 @@ analyze decls = do
             ) analyzedSymbols
     return sortedSymbols 
 
+extractSymbols :: KeliSymTab -> [KeliSymbol]
+extractSymbols symtab = map snd (assocs symtab)
 
-analyzeDecls :: [Raw.Decl] ->  Either KeliError KeliSymTab
-analyzeDecls decls = 
+analyzeDecls 
+    :: KeliSymTab -- previous symtab
+    -> [Raw.Decl] -- parsed input
+    ->  Either 
+            KeliError 
+            (KeliSymTab, [KeliSymbol]) -- (newSymtab, newSymbols)
+
+analyzeDecls symtab decls = 
     foldM
-    ((\symtab1 nextDecl1 -> do
+    ((\(symtab1, prevSymbols) nextDecl1 -> do
         analyzedSymbols <- analyzeDecl nextDecl1 symtab1
 
         -- insert analyzedSymbols into symtab
-        (foldM 
+        newSymtab <- (foldM 
             (\symtab2 analyzedSymbol -> insertSymbolIntoSymtab analyzedSymbol symtab2)
             symtab1
             analyzedSymbols)
-    )::KeliSymTab -> Raw.Decl -> Either KeliError KeliSymTab)
-    emptyKeliSymTab
+
+        return (newSymtab, prevSymbols ++ analyzedSymbols)
+    )::(KeliSymTab, [KeliSymbol]) -> Raw.Decl -> Either KeliError (KeliSymTab, [KeliSymbol]))
+    (symtab, [])
     decls
 
 insertSymbolIntoSymtab :: KeliSymbol -> KeliSymTab -> Either KeliError KeliSymTab

src/Cli.hs

@@ -0,0 +1,11 @@
+module Cli where
+
+import Text.Pretty.Simple (pPrint)
+import StaticError
+import Interpreter
+
+
+cli :: String -> IO (Either KeliError String)
+cli filename = do
+    contents <- readFile filename
+    keliInterpret contents

src/Compiler.hs

@@ -0,0 +1,15 @@
+module Compiler where
+
+import Data.List
+
+import StaticError
+import Analyzer
+import Parser
+import Transpiler
+
+
+keliCompile :: String -> Either KeliError String
+keliCompile input
+    =   keliParse input
+    >>= analyze 
+    >>= \symbols -> return (keliTranspile symbols)

src/Interpreter.hs

@@ -0,0 +1,25 @@
+module Interpreter where
+
+import StaticError
+import Compiler
+import System.Process
+
+
+getBaseCode :: IO String 
+getBaseCode = readFile "./kelilib/base.keli"
+
+
+keliInterpret :: String -> IO (Either KeliError String)
+keliInterpret contents = do
+    baseCode <- getBaseCode
+    -- baseCode is loaded automaticall by default
+    case (keliCompile $ baseCode ++ contents) of 
+        Right code -> do 
+            -- pPrint code
+            output <- keliExecute code
+            return (Right output)
+
+        Left err -> return (Left err)
+
+keliExecute :: String -> IO String
+keliExecute code = readProcess "node" ["-e", code] []

src/Parser.hs

@@ -179,8 +179,8 @@ preprocess str = str
     -- let packed = T.pack str in
     -- T.unpack (T.replace "\n\n" "\n;;;\n" packed)
 
-parseKeli :: String -> Either KeliError [Raw.Decl] 
-parseKeli input = 
+keliParse :: String -> Either KeliError [Raw.Decl] 
+keliParse input = 
     case parse keliParser "" (preprocess input) of
         Right decls -> Right decls
         Left err -> Left (KErrorParseError err)

src/Repl.hs

@@ -0,0 +1,48 @@
+module Repl where
+
+import System.IO
+import Control.Monad
+import Parser
+import Analyzer
+import Symbol
+import Interpreter
+import StaticError
+import Transpiler
+
+keliRead :: IO String
+keliRead 
+    = putStr "keli > "
+    >> hFlush stdout
+    >> getLine
+
+keliEval :: (KeliSymTab, String) -> String -> Either KeliError (IO String, (KeliSymTab, String))
+keliEval (prevSymtab, prevBytecode) input 
+    =   keliParse input         >>= 
+        analyzeDecls prevSymtab >>= \(newSymtab, symbols) ->
+        let newBytecodeToBeExecuted = keliTranspile symbols in 
+
+        let onlyDeclarationSymbols = filter (\s -> case s of KeliSymInlineExprs {} -> False; _ -> True) symbols in
+        let newByteCodeToBePassFoward = keliTranspile onlyDeclarationSymbols in
+        Right (keliExecute (prevBytecode ++ newBytecodeToBeExecuted), (newSymtab, newByteCodeToBePassFoward))
+
+
+
+
+keliPrint :: String -> IO ()
+keliPrint = putStrLn
+
+keliRepl' :: KeliSymTab -> String -> IO ()
+keliRepl' prevSymtab prevBytecode = do
+    input <- keliRead
+    unless (input == ":quit") 
+        (case keliEval (prevSymtab, prevBytecode) input of
+            Right (evaluatedOutput, (newSymtab,newBytecode)) -> 
+                evaluatedOutput >>= keliPrint >> keliRepl' newSymtab (prevBytecode ++ newBytecode)
+            Left err ->
+                keliPrint (show err) >> keliRepl' prevSymtab prevBytecode) 
+
+
+
+
+keliRepl :: IO ()
+keliRepl = keliRepl' emptyKeliSymTab ""

src/Transpiler.hs

@@ -8,6 +8,10 @@ import Debug.Pretty.Simple (pTraceShowId, pTraceShow)
 import qualified Ast.Verified as Verified
 import Symbol
 
+keliTranspile :: [KeliSymbol] -> String
+keliTranspile symbols = (intercalate ";\n" (map transpile symbols)) ++ ";\n"
+
+
 class Transpilable a where
     transpile :: a -> String
 

test/Spec.hs

@@ -1,23 +1,21 @@
 import Test.Hspec
-import Control.Exception (evaluate)
 import Parser
-import qualified Ast.Raw as Raw
 import Debug.Trace
-import Analyzer
-import Data.Either
-import StaticError
-import Keli
 import System.Directory
 import Control.Monad
 import Data.Strings
 import Data.List
 import Data.String.Utils
 
+import Interpreter
+
+testParseKeli :: String -> Expectation
 testParseKeli x = 
     (case (parseKeli x) of
         Right _   -> True
         Left  err -> trace (show err) $ False) `shouldBe` True
 
+runTest :: IO ()
 runTest = do
     testSubjects <- listDirectory "./test/specs"
     testCases <- 
@@ -37,9 +35,9 @@ runTest = do
     -- find for test cases prefixed with ONLY:
     let specificTestCases = 
             filter 
-                (\(subject, files) -> length files > 0)
+                (\(_, files) -> length files > 0)
                 (map 
-                    (\(subject, files) -> (subject, filter (\(filename,contents) -> filename `strStartsWith` "ONLY:") files))
+                    (\(subject, files) -> (subject, filter (\(filename,_) -> filename `strStartsWith` "ONLY:") files))
                     testCases)
 
     if length specificTestCases > 0 then
@@ -62,15 +60,15 @@ runTest' testCases =
                                 let [code, expectedOutput] = split "====" contents in
                                 it filename $ do
                                     if '@' `elem` filename then do
-                                        result <- keli' code 
+                                        result <- keliInterpret code 
                                         case result of 
-                                            Right output ->
+                                            Right _ ->
                                                 error "No error is thrown"
                                             Left err ->
                                                 -- error (show err) -- Uncomment this line to show parse error
                                                 split " " (show err) !! 0 `shouldBe` strip expectedOutput
                                     else do
-                                        result <- keli' code
+                                        result <- keliInterpret code
                                         case result of
                                             Right output ->
                                                 strip output `shouldBe` strip expectedOutput
@@ -79,6 +77,7 @@ runTest' testCases =
                             else
                                 error $ "\n\n\tERROR at " ++ filename ++ " : Each test file needs to contain ====\n\n"))
 
+main :: IO ()
 main = runTest
 
 otherTest :: IO ()