ConvertUnaryCalls

app/Commands/Dev/Tree/Compile/Asm.hs

@@ -14,9 +14,11 @@ runCommand opts = do
   outFile <- getOutputFile FileExtJuvixAsm (Just inputFile) moutputFile
   mainFile <- getMainFile (Just inputFile)
   tab :: InfoTable <- readFile mainFile >>= getRight . Tree.runParser mainFile
+  ep <- getEntryPoint (Just inputFile)
   res <-
     getRight
       . run
+      . runReader ep
       . runError @JuvixError
       $ treeToAsm tab
   writeFileEnsureLn outFile (Asm.ppPrint res res)

app/Commands/Dev/Tree/Read.hs

@@ -3,6 +3,7 @@ module Commands.Dev.Tree.Read where
 import Commands.Base
 import Commands.Dev.Tree.Read.Options
 import Juvix.Compiler.Tree.Data.InfoTable qualified as Tree
+import Juvix.Compiler.Tree.Options qualified as TreeOptions
 import Juvix.Compiler.Tree.Pretty qualified as Tree
 import Juvix.Compiler.Tree.Transformation qualified as Tree
 import Juvix.Compiler.Tree.Translation.FromSource qualified as Tree
@@ -15,7 +16,7 @@ runCommand opts = do
   case Tree.runParser afile s of
     Left err -> exitJuvixError (JuvixError err)
     Right tab -> do
-      r <- runError @JuvixError (Tree.applyTransformations (project opts ^. treeReadTransformations) tab)
+      r <- runReader TreeOptions.defaultOptions $ runError @JuvixError (Tree.applyTransformations (project opts ^. treeReadTransformations) tab)
       case r of
         Left err -> exitJuvixError (JuvixError err)
         Right tab' -> do

src/Juvix/Compiler/Pipeline.hs

@@ -300,10 +300,10 @@ coreToVampIR = Core.toStored >=> storedCoreToVampIR
 -- Other workflows
 --------------------------------------------------------------------------------
 
-treeToAsm :: (Member (Error JuvixError) r) => Tree.InfoTable -> Sem r Asm.InfoTable
+treeToAsm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r Asm.InfoTable
 treeToAsm = Tree.toAsm >=> return . Asm.fromTree
 
-treeToCairoAsm :: (Member (Error JuvixError) r) => Tree.InfoTable -> Sem r Asm.InfoTable
+treeToCairoAsm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r Asm.InfoTable
 treeToCairoAsm = Tree.toCairoAsm >=> return . Asm.fromTree
 
 treeToReg :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r Reg.InfoTable

src/Juvix/Compiler/Tree/Extra/Base.hs

@@ -298,7 +298,9 @@ destruct = \case
 
       mkBranchChild :: CaseBranch -> NodeChild
       mkBranchChild CaseBranch {..} =
-        (if _caseBranchSave then oneTempVar (TempVar Nothing Nothing) else noTempVar) _caseBranchBody
+        (if _caseBranchSave then oneTempVar (TempVar Nothing Nothing indTy) else noTempVar) _caseBranchBody
+        where
+          indTy = TyInductive (TypeInductive _nodeCaseInductive)
 
       mkBranches :: [CaseBranch] -> [Node] -> [CaseBranch]
       mkBranches = zipWithExact (flip (set caseBranchBody))

src/Juvix/Compiler/Tree/Extra/Type.hs

@@ -16,6 +16,21 @@ import Juvix.Compiler.Tree.Extra.Type.Base
 import Juvix.Compiler.Tree.Language.Base
 import Juvix.Compiler.Tree.Pretty
 
+isConcreteAtomType :: Type -> Bool
+isConcreteAtomType = \case
+  TyConstr {} -> True
+  TyInductive {} -> True
+  TyInteger {} -> True
+  TyBool {} -> True
+  TyString -> True
+  TyField -> True
+  TyByteArray -> True
+  TyRandomGenerator -> True
+  TyUnit -> True
+  TyVoid -> True
+  TyDynamic -> False
+  TyFun {} -> False
+
 unfoldType :: Type -> ([Type], Type)
 unfoldType ty = (typeArgs ty, typeTarget ty)
 

src/Juvix/Compiler/Tree/Language.hs

@@ -1,12 +1,14 @@
 module Juvix.Compiler.Tree.Language
   ( module Juvix.Compiler.Tree.Language,
     module Juvix.Compiler.Tree.Language.Base,
+    module Juvix.Compiler.Tree.Language.Type,
     module Juvix.Compiler.Tree.Language.Builtins,
   )
 where
 
 import Juvix.Compiler.Tree.Language.Base
 import Juvix.Compiler.Tree.Language.Builtins
+import Juvix.Compiler.Tree.Language.Type
 
 -- | Function call type
 data CallType
@@ -177,7 +179,8 @@ data CaseBranch = CaseBranch
 
 data TempVar = TempVar
   { _tempVarName :: Maybe Text,
-    _tempVarLocation :: Maybe Location
+    _tempVarLocation :: Maybe Location,
+    _tempVarType :: Type
   }
 
 data NodeSave = NodeSave

src/Juvix/Compiler/Tree/Pipeline.hs

@@ -4,14 +4,15 @@ module Juvix.Compiler.Tree.Pipeline
   )
 where
 
+import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Compiler.Tree.Data.InfoTable
 import Juvix.Compiler.Tree.Transformation
 
-toNockma :: (Member (Error JuvixError) r) => InfoTable -> Sem r InfoTable
-toNockma = applyTransformations toNockmaTransformations
+toNockma :: (Members '[Error JuvixError, Reader EntryPoint] r) => InfoTable -> Sem r InfoTable
+toNockma = mapReader fromEntryPoint . applyTransformations toNockmaTransformations
 
-toAsm :: (Member (Error JuvixError) r) => InfoTable -> Sem r InfoTable
-toAsm = applyTransformations toAsmTransformations
+toAsm :: (Members '[Error JuvixError, Reader EntryPoint] r) => InfoTable -> Sem r InfoTable
+toAsm = mapReader fromEntryPoint . applyTransformations toAsmTransformations
 
-toCairoAsm :: (Member (Error JuvixError) r) => InfoTable -> Sem r InfoTable
-toCairoAsm = applyTransformations toCairoAsmTransformations
+toCairoAsm :: (Members '[Error JuvixError, Reader EntryPoint] r) => InfoTable -> Sem r InfoTable
+toCairoAsm = mapReader fromEntryPoint . applyTransformations toCairoAsmTransformations

src/Juvix/Compiler/Tree/Transformation.hs

@@ -16,7 +16,7 @@ import Juvix.Compiler.Tree.Transformation.FilterUnreachable
 import Juvix.Compiler.Tree.Transformation.IdentityTrans
 import Juvix.Compiler.Tree.Transformation.Validate
 
-applyTransformations :: forall r. (Member (Error JuvixError) r) => [TransformationId] -> InfoTable -> Sem r InfoTable
+applyTransformations :: forall r. (Members '[Error JuvixError, Reader Options] r) => [TransformationId] -> InfoTable -> Sem r InfoTable
 applyTransformations ts tbl = foldM (flip appTrans) tbl ts
   where
     appTrans :: TransformationId -> InfoTable -> Sem r InfoTable

src/Juvix/Compiler/Tree/Transformation/Base.hs

@@ -2,9 +2,11 @@ module Juvix.Compiler.Tree.Transformation.Base
   ( module Juvix.Compiler.Tree.Transformation.Generic.Base,
     module Juvix.Compiler.Tree.Language,
     module Juvix.Compiler.Tree.Data.InfoTable,
+    module Juvix.Compiler.Tree.Options,
   )
 where
 
 import Juvix.Compiler.Tree.Data.InfoTable
 import Juvix.Compiler.Tree.Language
+import Juvix.Compiler.Tree.Options
 import Juvix.Compiler.Tree.Transformation.Generic.Base

src/Juvix/Compiler/Tree/Transformation/Optimize/ConvertUnaryCalls.hs

@@ -0,0 +1,51 @@
+module Juvix.Compiler.Tree.Transformation.Optimize.ConvertUnaryCalls where
+
+import Juvix.Compiler.Core.Data.BinderList qualified as BL
+import Juvix.Compiler.Tree.Data.InfoTable
+import Juvix.Compiler.Tree.Extra.Recursors
+import Juvix.Compiler.Tree.Extra.Type
+import Juvix.Compiler.Tree.Transformation.Base
+
+convertUnaryCalls :: InfoTable -> InfoTable
+convertUnaryCalls tab = mapT convert tab
+  where
+    convert :: Symbol -> Node -> Node
+    convert sym = umapL (go argtys)
+      where
+        funInfo = lookupFunInfo tab sym
+        argtys
+          | funInfo ^. functionArgsNum == 0 = []
+          | otherwise = typeArgs (funInfo ^. functionType)
+
+    go :: [Type] -> BinderList TempVar -> Node -> Node
+    go argtys tmps node = case node of
+      CallClosures ncl@NodeCallClosures {..}
+        | length _nodeCallClosuresArgs == 1 ->
+            case _nodeCallClosuresFun of
+              MemRef NodeMemRef {..}
+                | DRef (ArgRef OffsetRef {..}) <- _nodeMemRef,
+                  isUnaryWithAtomicTarget (argtys !! _offsetRefOffset) ->
+                    mkClosureCall ncl
+                | DRef (TempRef (RefTemp OffsetRef {..})) <- _nodeMemRef,
+                  isUnaryWithAtomicTarget (BL.lookupLevel _offsetRefOffset tmps ^. tempVarType) ->
+                    mkClosureCall ncl
+                | ConstrRef (Field {..}) <- _nodeMemRef,
+                  constrInfo <- lookupConstrInfo tab _fieldTag,
+                  isUnaryWithAtomicTarget (typeArgs (constrInfo ^. constructorType) !! _fieldOffset) ->
+                    mkClosureCall ncl
+              _ -> node
+      _ -> node
+
+    mkClosureCall :: NodeCallClosures -> Node
+    mkClosureCall NodeCallClosures {..} =
+      Call
+        NodeCall
+          { _nodeCallInfo = _nodeCallClosuresInfo,
+            _nodeCallType = CallClosure _nodeCallClosuresFun,
+            _nodeCallArgs = toList _nodeCallClosuresArgs
+          }
+
+    isUnaryWithAtomicTarget :: Type -> Bool
+    isUnaryWithAtomicTarget ty =
+      length (typeArgs ty) == 1
+        && isConcreteAtomType (typeTarget ty)

src/Juvix/Compiler/Tree/Transformation/Optimize/Phase/Main.hs

@@ -0,0 +1,9 @@
+module Juvix.Compiler.Tree.Transformation.Optimize.Phase.Main where
+
+import Juvix.Compiler.Tree.Transformation.Base
+import Juvix.Compiler.Tree.Transformation.Optimize.ConvertUnaryCalls
+
+optimize :: (Member (Reader Options) r) => InfoTable -> Sem r InfoTable
+optimize =
+  withOptimizationLevel 1 $
+    return . convertUnaryCalls

src/Juvix/Compiler/Tree/Translation/FromAsm.hs

@@ -192,7 +192,12 @@ goFunction infoTab fi = do
             Save
               NodeSave
                 { _nodeSaveInfo = mempty,
-                  _nodeSaveTempVar = TempVar _cmdSaveName (_cmdSaveInfo ^. Asm.commandInfoLocation),
+                  _nodeSaveTempVar =
+                    TempVar
+                      { _tempVarName = _cmdSaveName,
+                        _tempVarLocation = _cmdSaveInfo ^. Asm.commandInfoLocation,
+                        _tempVarType = TyDynamic
+                      },
                   _nodeSaveArg = arg,
                   _nodeSaveBody = body
                 }
@@ -255,7 +260,7 @@ goFunction infoTab fi = do
               NodeSave
                 { _nodeSaveInfo = mempty,
                   _nodeSaveArg = arg,
-                  _nodeSaveTempVar = TempVar Nothing Nothing,
+                  _nodeSaveTempVar = TempVar Nothing Nothing TyDynamic,
                   _nodeSaveBody =
                     Binop
                       NodeBinop

src/Juvix/Compiler/Tree/Translation/FromCore.hs

@@ -270,7 +270,12 @@ genCode infoTable fi =
           { _nodeSaveInfo = mempty,
             _nodeSaveArg = arg,
             _nodeSaveBody = body,
-            _nodeSaveTempVar = TempVar (Just name) loc
+            _nodeSaveTempVar =
+              TempVar
+                { _tempVarName = Just name,
+                  _tempVarLocation = loc,
+                  _tempVarType = convertType 0 (_letItem ^. Core.letItemBinder . Core.binderType)
+                }
           }
       where
         name = _letItem ^. Core.letItemBinder . Core.binderName

src/Juvix/Compiler/Tree/Translation/FromSource.hs

@@ -430,7 +430,12 @@ parseSave = do
       { _nodeSaveInfo = NodeInfo (Just loc'),
         _nodeSaveArg = arg,
         _nodeSaveBody = body,
-        _nodeSaveTempVar = TempVar mname (Just loc)
+        _nodeSaveTempVar =
+          TempVar
+            { _tempVarName = mname,
+              _tempVarLocation = Just loc,
+              _tempVarType = TyDynamic
+            }
       }
 
 withSave ::

test/Tree/Asm/Base.hs

@@ -8,18 +8,20 @@ import Juvix.Compiler.Tree.Translation.FromSource
 import Juvix.Data.PPOutput
 
 treeAsmAssertion ::
+  Path Abs Dir ->
   Path Abs File ->
   Path Abs File ->
   (String -> IO ()) ->
   Assertion
-treeAsmAssertion mainFile expectedFile step = do
+treeAsmAssertion root' mainFile expectedFile step = do
   step "Parse"
   s <- readFile mainFile
   case runParser mainFile s of
     Left err -> assertFailure (prettyString err)
     Right tabIni -> do
       step "Translate"
-      case run $ runError @JuvixError $ Tree.toAsm tabIni of
+      entryPoint <- testDefaultEntryPointIO root' mainFile
+      case run $ runReader entryPoint $ runError @JuvixError $ Tree.toAsm tabIni of
         Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
         Right tab -> do
           let tab' = Asm.fromTree tab

test/Tree/Asm/Positive.hs

@@ -12,7 +12,7 @@ testDescr Eval.PosTest {..} =
    in TestDescr
         { _testName = _name,
           _testRoot = tRoot,
-          _testAssertion = Steps $ treeAsmAssertion file' expected'
+          _testAssertion = Steps $ treeAsmAssertion tRoot file' expected'
         }
 
 ignoredTests :: [String]

test/Tree/Eval/Base.hs

@@ -7,6 +7,7 @@ import Juvix.Compiler.Tree.Error
 import Juvix.Compiler.Tree.Evaluator
 import Juvix.Compiler.Tree.Language.Base
 import Juvix.Compiler.Tree.Language.Value
+import Juvix.Compiler.Tree.Options qualified as Tree
 import Juvix.Compiler.Tree.Pretty
 import Juvix.Compiler.Tree.Transformation
 import Juvix.Compiler.Tree.Translation.FromSource
@@ -36,12 +37,13 @@ treeEvalAssertionParam evalParam mainFile expectedFile trans testTrans step = do
     Left err -> assertFailure (prettyString err)
     Right tab0 -> do
       step "Validate"
-      case run $ runError @JuvixError $ applyTransformations [Validate] tab0 of
+      let opts = Tree.defaultOptions
+      case run $ runReader opts $ runError @JuvixError $ applyTransformations [Validate] tab0 of
         Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
         Right tab1 -> do
           unless (null trans) $
             step "Transform"
-          case run $ runError @JuvixError $ applyTransformations trans tab1 of
+          case run $ runReader opts $ runError @JuvixError $ applyTransformations trans tab1 of
             Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
             Right tab -> do
               testTrans tab

test/Tree/Transformation/CheckNoAnoma.hs

@@ -30,12 +30,12 @@ treeEvalTransformationErrorAssertion mainFile trans checkError step = do
     Left err -> assertFailure (prettyString err)
     Right tab0 -> do
       step "Validate"
-      case run $ runError @JuvixError $ applyTransformations [Validate] tab0 of
+      case run $ runReader Tree.defaultOptions $ runError @JuvixError $ applyTransformations [Validate] tab0 of
         Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
         Right tab1 -> do
           unless (null trans) $
             step "Transform"
-          case run $ runError @JuvixError $ applyTransformations trans tab1 of
+          case run $ runReader Tree.defaultOptions $ runError @JuvixError $ applyTransformations trans tab1 of
             Left e -> checkError e
             Right {} -> assertFailure "Expected error"