Fix trait functions not working as partials (fix #9)

rockofox · Nov 12, 2024 · 9b27451 · 9b27451
1 parent d8c87fc
commit 9b27451
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 5 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -10,6 +10,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Identity (Identity (..))
 import Control.Monad.State (StateT (runStateT), evalStateT)
 import Control.Monad.State.Lazy
+import Data.Bool (bool)
 import Data.ByteString.Lazy qualified as B
 import Data.List (intercalate, isPrefixOf)
 import Data.Maybe (fromJust, fromMaybe, isNothing)
@@ -43,6 +44,7 @@ data CmdOptions = Options
     , showTime :: Bool
     , showVersion :: Bool
     , noVerify :: Bool
+    , noOptimize :: Bool
     }
 
 optionsParser :: Options.Applicative.Parser CmdOptions
@@ -69,6 +71,7 @@ optionsParser =
         <*> switch (long "profile" <> short 'p' <> help "Show time spent parsing, compiling and running")
         <*> switch (long "version" <> short 'V' <> help "Show version")
         <*> switch (long "no-verify" <> short 'n' <> help "Don't verify the program")
+        <*> switch (long "no-optimize" <> short 'O' <> help "Don't optimize the program")
 
 prettyPrintExpr :: Expr -> Int -> String
 prettyPrintExpr (DoBlock exprs) i = indent i ++ "DoBlock[\n" ++ intercalate "\n" (map (\x -> prettyPrintExpr x (i + 1)) exprs) ++ "\n" ++ indent i ++ "]"
@@ -121,7 +124,7 @@ parseNoVerify name input compilerFlags = return $ do
 
 main :: IO ()
 main = do
-    Options input output debug verbose emitBytecode runBytecode breakpoints showTime showVersion noVerify <-
+    Options input output debug verbose emitBytecode runBytecode breakpoints showTime showVersion noVerify noOptimize <-
         execParser $
             info
                 (optionsParser <**> helper)
@@ -154,8 +157,10 @@ main = do
                     Right expr -> return expr
 
                 when debug $ putStrLn $ prettyPrintProgram expr
-                potentiallyTimedOperation "Compilation" showTime $ do
-                    optimize <$> evalStateT (BytecodeCompiler.compileProgram expr) (BytecodeCompiler.initCompilerState expr)
+                potentiallyTimedOperation "Compilation" showTime $
+                    do
+                        bool id optimize (not noOptimize)
+                        <$> evalStateT (BytecodeCompiler.compileProgram expr) (BytecodeCompiler.initCompilerState expr)
             else do
                 bytecode <- inputFileBinary input
                 return $ VM.fromBytecode bytecode

diff --git a/lib/BytecodeCompiler.hs b/lib/BytecodeCompiler.hs
@@ -2,15 +2,18 @@ module BytecodeCompiler where
 
 import AST (zeroPosition)
 import AST qualified as Parser.Type (Type (Unknown))
+import Control.Arrow ((>>>))
 import Control.Monad (when, (>=>))
 import Control.Monad.Loops (firstM)
 import Control.Monad.State (MonadIO (liftIO), StateT, gets, modify)
 import Data.Bifunctor (second)
+import Data.Function ((&))
 import Data.Functor ((<&>))
 import Data.List (elemIndex, find, inits, intercalate)
 import Data.List.Split qualified
 import Data.Map qualified
 import Data.Maybe (fromJust, isJust, isNothing)
+import Data.String
 import Data.Text (isPrefixOf, splitOn)
 import Data.Text qualified
 import Data.Text qualified as T
@@ -312,7 +315,9 @@ compileExpr (Parser.FuncCall funcName args _) = do
                                 return $
                                     args'
                                         ++ [PushPf (funame fun) (length args')]
-                Nothing ->
+                Nothing -> do
+                    -- traceM $ "Looking for funcDec " ++ funcName
+                    -- gets funcDecs >>= \x -> traceM $ "\t" ++ show (map Parser.name x)
                     concatMapM compileExpr args >>= \args' ->
                         return $
                             args'
@@ -381,7 +386,10 @@ compileExpr (Parser.Var x _) = do
     curCon <- gets currentContext
     externals' <- gets externals
 
-    let fun = any ((== x) . baseName) functions' || any ((== curCon ++ "@" ++ x) . baseName) functions'
+    let fun =
+            any ((== x) . baseName) functions'
+                || any ((== curCon ++ "@" ++ x) . baseName) functions'
+                || any ((== x) . ((Data.Text.unpack . last . splitOn "::") . fromString . baseName)) functions'
     if fun || x `elem` internalFunctions || x `elem` map (\f -> f.name) externals'
         then compileExpr (Parser.FuncCall x [] zeroPosition)
         else return [LLoad x]