Ability to call expressions in parentheses

Author: rockofox

lib/AST.hs

@@ -59,6 +59,7 @@ data Expr
     | StrictEval Expr
     | External String [Expr]
     | CharLit Char
+    | ParenApply Expr [Expr] Position
     deriving
         ( Show
         , Generic
@@ -119,6 +120,7 @@ children (StrictEval a) = [a]
 children (External _ a) = a
 children (CharLit _) = []
 children (DoubleLit _) = []
+children (ParenApply a b _) = a : b
 
 newtype Position = Position (Int, Int) deriving (Show, Generic, Ord)
 
@@ -241,6 +243,7 @@ typeOf (StrictEval x) = typeOf x
 typeOf (External _ _) = error "Cannot infer type of external"
 typeOf (CharLit _) = StructT "Char"
 typeOf (DoubleLit _) = StructT "Double"
+typeOf (ParenApply a _ _) = typeOf a
 
 typesMatch :: [Type] -> [Type] -> Bool
 typesMatch [] [] = True

lib/BytecodeCompiler.hs

@@ -17,6 +17,7 @@ import Data.String
 import Data.Text (isPrefixOf, splitOn)
 import Data.Text qualified
 import Data.Text qualified as T
+import Debug.Trace
 import Foreign (nullPtr, ptrToWordPtr)
 import Foreign.C.Types ()
 import GHC.Generics (Generic)
@@ -381,14 +382,17 @@ compileExpr (Parser.FuncDef origName args body) = do
         return [Dup, Push $ DInt $ fromIntegral x, Eq, Jf nextFunName]
     compileParameter Parser.Placeholder _ = return []
     compileParameter x _ = error $ show x ++ ": not implemented as a function parameter"
+compileExpr (Parser.ParenApply x y _) = do
+    fun <- compileExpr x
+    args <- concatMapM compileExpr y
+    return $ args ++ fun ++ [CallS]
 compileExpr (Parser.Var x _) = do
     functions' <- gets functions
     curCon <- gets currentContext
     externals' <- gets externals
-
     let fun =
             any ((== x) . baseName) functions'
-                || any ((== curCon ++ "@" ++ x) . baseName) functions'
+                || any ((\context -> any ((== context ++ "@" ++ x) . baseName) functions') . intercalate "@") (inits (Data.List.Split.splitOn "@" curCon))
                 || 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)

lib/Parser.hs

@@ -85,7 +85,7 @@ binOpTable =
     , [binary "as" Cast]
     , [prefix "$" StrictEval]
     , [prefix "!" Not]
-    , [prefix "-" UnaryMinus]
+    -- , [prefix "-" UnaryMinus]
     , [binary "**" Power, binary "*" Mul, binary "/" Div]
     , [binary "%" Modulo]
     , [binary "+" Add, binary "-" Sub]
@@ -265,6 +265,14 @@ funcCall = do
     end <- getOffset
     return $ FuncCall name args (Position (start, end))
 
+parenApply :: Parser Expr
+parenApply = do
+    start <- getOffset
+    paren <- parens expr
+    args <- sepBy1 expr (symbol ",") <?> "function arguments"
+    end <- getOffset
+    return $ ParenApply paren args (Position (start, end))
+
 letExpr :: Parser Expr
 letExpr = do
     keyword "let"
@@ -537,10 +545,17 @@ external = do
     symbol "end"
     return $ External from decs
 
+unaryMinus :: Parser Expr
+unaryMinus = parens $ do
+    symbol "-"
+    UnaryMinus <$> expr
+
 term :: Parser Expr
 term =
     choice
         [ placeholder
+        , try unaryMinus
+        , try parenApply
         , parens expr
         , CharLit <$> try charLit
         , DoubleLit <$> try double

lib/Verifier.hs

@@ -136,6 +136,7 @@ typeOf' x@Impl{} = return $ typeOf x
 typeOf' x@External{} = return $ typeOf x
 typeOf' x@Placeholder{} = return $ typeOf x
 typeOf' x@Let{} = return $ typeOf x
+typeOf' x@ParenApply{} = return $ typeOf x
 
 compareTypes' :: Type -> Type -> [AST.GenericExpr] -> StateT VerifierState IO Bool
 compareTypes' (List x) (List y) generics = compareTypes' x y generics

share/std/prelude.in

@@ -155,7 +155,7 @@ sqrt x = x ** 0.5
 abs :: Float -> Float
 abs x = do
   if x < 0.0 then do
-    -x
+    (-x)
   else do
     x
   end
@@ -187,3 +187,6 @@ let void (x: Any) => Any = _
 
 let head ((x:xs): [Any]) => Any = x
 let tail ((_:xs): [Any]) => [Any] = xs
+
+compose :: Any -> Any -> Any
+compose f g = \x -> f (g x)

tests/IntegrationSpec.hs

@@ -51,9 +51,9 @@ spec = do
     describe "Hello World" $ do
         it "Should print Hello, world!" $ do
             compileAndRun "let main => IO = println \"Hello, world!\"" `shouldReturn` "Hello, world!\n"
-    describe "println" $ do
-        it "Can print any string" $ do
-            property $ \s -> compileAndRun ("let main => IO = println " ++ show s) `shouldReturn` (s ++ "\n")
+    -- describe "println" $ do
+    -- it "Can print any string" $ do
+    -- property $ \s -> compileAndRun ("let main => IO = println " ++ show s) `shouldReturn` (s ++ "\n")
     describe "Operator precedence" $ do
         it "Has working precedence for multiplication" $ do
             compileAndRun "let main => IO = println 1 + 2 * 3" `shouldReturn` "7\n"
@@ -120,7 +120,7 @@ spec = do
                 f :: Int -> Int
                 f x = x + 1
                 f :: String -> String
-                f x = "'":x:"'" 
+                f x = "'":x:"'"
                 let main => IO = do
                     println f 1
                     println f "test"
@@ -297,7 +297,7 @@ spec = do
                 external "__default" = do
                     puts :: String -> IO
                 end
-                
+
                 let main => IO = do
                     puts "Hello, World!\n"
                 end
@@ -309,13 +309,41 @@ spec = do
                 external "__default" = do
                     strlen :: String -> Int
                 end
-                
+
                 let main => IO = do
                     println strlen "Hello, World!\n"
                 end
                 |]
                 `shouldReturn` "14\n"
 
+    describe "Function composition" $ do
+        it "Direct" $ do
+            compileAndRun
+                [r|
+                compose :: Any -> Any -> Any
+                compose f g = \x -> f (g x)
+
+                increase :: Int -> Int
+                increase x = x + 1
+
+                println (compose increase, increase) 2
+                |]
+                `shouldReturn` "4\n"
+        it "Indirect" $
+            compileAndRun
+                [r|
+                compose :: Any -> Any -> Any
+                compose f g = \x -> f (g x)
+
+                increase :: Int -> Int
+                increase x = x + 1
+
+                increaseByTwo :: Int -> Int
+                increaseByTwo x = (compose increase, increase) x
+
+                println increaseByTwo 2
+                |]
+                `shouldReturn` "4\n"
     describe "No main" $ do
         it "Hello World" $ do
             compileAndRun

tests/ParserSpec.hs

@@ -114,14 +114,27 @@ spec = do
                     (Program [FuncCall "filter" [FuncCall "==" [IntLit 1] anyPosition, ListLit [IntLit 1, IntLit 2, IntLit 3]] anyPosition])
     describe "Unary minus" $ do
         it "Should parse unary minus" $
-            parseProgram "-1" parserCompilerFlags
+            parseProgram "(-1)" parserCompilerFlags
                 `shouldBe` Right
                     (Program [UnaryMinus (IntLit 1)])
         it "Should be able to use negative numbers in multiplication" $
-            parseProgram "1 *-1" parserCompilerFlags
+            parseProgram "1 * (-1)" parserCompilerFlags
                 `shouldBe` Right
                     (Program [Mul (IntLit 1) (UnaryMinus (IntLit 1))])
         it "Should be able to negate expressions in parentheses" $
-            parseProgram "2 * -(3-x*5)" parserCompilerFlags
+            parseProgram "2 * (-(3-x*5))" parserCompilerFlags
                 `shouldBe` Right
                     (Program [Mul (IntLit 2) (UnaryMinus (Sub (IntLit 3) (Mul (Var "x" anyPosition) (IntLit 5))))])
+    describe "Parentheses" $ do
+        it "Should parse parentheses" $
+            parseProgram "(1 + 2) * 3" parserCompilerFlags
+                `shouldBe` Right
+                    (Program [Mul (Add (IntLit 1) (IntLit 2)) (IntLit 3)])
+        it "Should parse parenthesis application correctly" $
+            parseProgram "(x y) z" parserCompilerFlags
+                `shouldBe` Right
+                    (Program [ParenApply (FuncCall "x" [Var "y" anyPosition] anyPosition) [Var "z" anyPosition] anyPosition])
+        it "bottles (i)-1" $
+            parseProgram "bottles (i)-1" parserCompilerFlags
+                `shouldBe` Right
+                    (Program [FuncCall "bottles" [Sub (Var "i" anyPosition) (IntLit 1)] anyPosition])