Respect fixity in runtime printer (#2182)

* Closes #2180
anoma · Jun 7, 2023 · 4c0e0b1 · 4c0e0b1
1 parent 9db16ca
commit 4c0e0b1
Show file tree

Hide file tree

Showing 19 changed files with 194 additions and 39 deletions.
diff --git a/runtime/src/juvix/info.c b/runtime/src/juvix/info.c
@@ -5,3 +5,5 @@ function_info_t *juvix_function_info = NULL;
 constr_info_t *juvix_constr_info = NULL;
 size_t juvix_functions_num = 0;
 size_t juvix_constrs_num = 0;
+
+fixity_t app_fixity = APP_FIXITY;
diff --git a/runtime/src/juvix/info.h b/runtime/src/juvix/info.h
@@ -3,17 +3,34 @@
 
 #include <juvix/defs.h>
 
+typedef enum { assoc_left, assoc_right, assoc_none } assoc_t;
+
+typedef struct {
+    int precedence;
+    assoc_t assoc;
+} fixity_t;
+
+#define PREC_MINUS_OMEGA (-1)
+#define PREC_OMEGA 100000
+
+#define APP_FIXITY \
+    { PREC_OMEGA, assoc_left }
+
 typedef struct {
     const char *name;
 } function_info_t;
 
 typedef struct {
     const char *name;
+    bool is_infix;
+    fixity_t fixity;
 } constr_info_t;
 
 extern function_info_t *juvix_function_info;
 extern constr_info_t *juvix_constr_info;
 extern size_t juvix_functions_num;
 extern size_t juvix_constrs_num;
 
+extern fixity_t app_fixity;
+
 #endif
diff --git a/runtime/src/juvix/object/object.h b/runtime/src/juvix/object/object.h
@@ -154,10 +154,12 @@ STATIC_ASSERT(BUILTIN_UIDS_NUM > UID_READLN);
 
 #define FIRST_USER_UID BUILTIN_UIDS_NUM
 
-#define BUILTIN_UIDS_INFO                                                     \
-    {"false"}, {"true"}, {"unit"}, {"void"}, {"return"}, {"bind"}, {"write"}, \
-    {                                                                         \
-        "readln"                                                              \
+#define BUILTIN_UIDS_INFO                                   \
+    {"false", 0, APP_FIXITY}, {"true", 0, APP_FIXITY},      \
+        {"unit", 0, APP_FIXITY}, {"void", 0, APP_FIXITY},   \
+        {"return", 0, APP_FIXITY}, {"bind", 0, APP_FIXITY}, \
+        {"write", 0, APP_FIXITY}, {                         \
+        "readln", 0, APP_FIXITY                             \
     }
 
 /*************************************************/

diff --git a/runtime/src/juvix/object/print.c b/runtime/src/juvix/object/print.c
@@ -36,40 +36,100 @@ static size_t print_long(char *buf, size_t n, long_t x) {
     return k + sign;
 }
 
+static bool check_parens(assoc_t assoc, fixity_t *op_fixity,
+                         fixity_t *arg_fixity) {
+    if (op_fixity == NULL) {
+        return false;
+    } else if (arg_fixity->precedence > op_fixity->precedence) {
+        return false;
+    } else if (arg_fixity->precedence < op_fixity->precedence) {
+        return true;
+    } else if (op_fixity->assoc == assoc) {
+        return false;
+    } else {
+        return true;
+    }
+}
+
 #define PUTC(c)                          \
     do {                                 \
         *buf++ = c;                      \
         if (--n == 0) return buf - buf0; \
     } while (0)
 
-static size_t print_object(bool is_top, char *buf, size_t n, word_t x);
+static size_t print_object(assoc_t assoc, fixity_t *fixity, char *buf, size_t n,
+                           word_t x);
 
-static size_t print_args(bool is_top, char *restrict buf, size_t n,
-                         const char *restrict str, word_t *args, size_t nargs) {
+static size_t print_app(bool needs_parens, bool is_binop, char *restrict buf,
+                        size_t n, const char *restrict str, word_t *args,
+                        size_t nargs) {
     ASSERT(n >= 1);
     char *buf0 = buf;
-    if (!is_top && nargs > 0) {
+    if (needs_parens && nargs > 0) {
+        PUTC('(');
+    }
+    if (is_binop) {
         PUTC('(');
     }
     while (*str) {
         PUTC(*str++);
     }
+    if (is_binop) {
+        PUTC(')');
+    }
     for (size_t i = 0; i < nargs; ++i) {
         PUTC(' ');
-        size_t delta = print_object(false, buf, n, args[i]);
+        size_t delta = print_object(assoc_right, &app_fixity, buf, n, args[i]);
         buf += delta;
         n -= delta;
         if (n == 0) {
             return buf - buf0;
         }
     }
-    if (!is_top && nargs > 0) {
+    if (needs_parens && nargs > 0) {
+        PUTC(')');
+    }
+    return buf - buf0;
+}
+
+static size_t print_binop(bool needs_parens, fixity_t *op_fixity,
+                          char *restrict buf, size_t n,
+                          const char *restrict str, word_t *args) {
+    ASSERT(n >= 1);
+    char *buf0 = buf;
+    if (needs_parens) {
+        PUTC('(');
+    }
+    // print left arg
+    size_t delta = print_object(assoc_left, op_fixity, buf, n, args[0]);
+    buf += delta;
+    n -= delta;
+    if (n == 0) {
+        return buf - buf0;
+    }
+    // print constructor name
+    if (str[0] != ',') {
+        PUTC(' ');
+    }
+    while (*str) {
+        PUTC(*str++);
+    }
+    PUTC(' ');
+    // print right arg
+    delta = print_object(assoc_right, op_fixity, buf, n, args[1]);
+    buf += delta;
+    n -= delta;
+    if (n == 0) {
+        return buf - buf0;
+    }
+    if (needs_parens) {
         PUTC(')');
     }
     return buf - buf0;
 }
 
-static size_t print_object(bool is_top, char *buf, size_t n, word_t x) {
+static size_t print_object(assoc_t assoc, fixity_t *fixity, char *buf, size_t n,
+                           word_t x) {
     ASSERT(n >= 1);
     switch (GET_KIND(x)) {
         case KIND_UNBOXED0:
@@ -89,12 +149,14 @@ static size_t print_object(bool is_top, char *buf, size_t n, word_t x) {
                                 get_closure_fuid(x) < juvix_functions_num
                                     ? juvix_function_info[get_closure_fuid(x)]
                                           .name
-                                    : "<closure>";
+                                    : "<function>";
 #else
-                            const char *str = "<closure>";
+                            const char *str = "<function>";
 #endif
-                            buf += print_args(is_top, buf, n, str,
-                                              get_closure_args(x), nargs);
+                            bool needs_parens =
+                                check_parens(assoc, fixity, &app_fixity);
+                            buf += print_app(needs_parens, false, buf, n, str,
+                                             get_closure_args(x), nargs);
                             break;
                         }
                         case SUID_CSTRING: {
@@ -158,21 +220,31 @@ static size_t print_object(bool is_top, char *buf, size_t n, word_t x) {
                 } else {
                     size_t nargs = GET_NFIELDS(h);
                     ASSERT(GET_UID(h) < juvix_constrs_num);
-                    const char *str = juvix_constr_info[GET_UID(h)].name;
-                    buf += print_args(is_top, buf, n, str, get_constr_args(x),
-                                      nargs);
+                    constr_info_t *ci = &juvix_constr_info[GET_UID(h)];
+                    const char *str = ci->name;
+                    if (ci->is_infix && nargs == 2) {
+                        bool needs_parens =
+                            check_parens(assoc, fixity, &ci->fixity);
+                        buf += print_binop(needs_parens, &ci->fixity, buf, n,
+                                           str, get_constr_args(x));
+                    } else {
+                        bool needs_parens =
+                            check_parens(assoc, fixity, &app_fixity);
+                        buf += print_app(needs_parens, ci->is_infix, buf, n,
+                                         str, get_constr_args(x), nargs);
+                    }
                 }
             } else {
                 PUTC('(');
-                delta = print_object(true, buf, n, FST(x));
+                delta = print_object(assoc_none, &app_fixity, buf, n, FST(x));
                 n -= delta;
                 buf += delta;
                 if (n == 0) {
                     return buf - buf0;
                 }
                 PUTC(',');
                 PUTC(' ');
-                delta = print_object(true, buf, n, SND(x));
+                delta = print_object(assoc_none, &app_fixity, buf, n, SND(x));
                 n -= delta;
                 buf += delta;
                 if (n == 0) {
@@ -200,7 +272,7 @@ static size_t print_object(bool is_top, char *buf, size_t n, word_t x) {
 
 size_t print_to_buf(char *buf, size_t n, word_t x) {
     ASSERT(n >= 1);
-    size_t k = print_object(true, buf, n, x);
+    size_t k = print_object(assoc_none, NULL, buf, n, x);
     if (k < n) {
         buf[k] = 0;
     }

diff --git a/src/Juvix/Compiler/Asm/Data/InfoTable.hs b/src/Juvix/Compiler/Asm/Data/InfoTable.hs
@@ -43,7 +43,8 @@ data ConstructorInfo = ConstructorInfo
     -- _constructorType == _constructorType`
     _constructorType :: Type,
     _constructorInductive :: Symbol,
-    _constructorRepresentation :: MemRep
+    _constructorRepresentation :: MemRep,
+    _constructorFixity :: Maybe Fixity
   }
 
 data InductiveInfo = InductiveInfo

diff --git a/src/Juvix/Compiler/Asm/Translation/FromCore.hs b/src/Juvix/Compiler/Asm/Translation/FromCore.hs
@@ -345,7 +345,8 @@ translateConstructorInfo ci =
       _constructorArgsNum = length (typeArgs ty),
       _constructorType = ty,
       _constructorInductive = ci ^. Core.constructorInductive,
-      _constructorRepresentation = MemRepConstr
+      _constructorRepresentation = MemRepConstr,
+      _constructorFixity = ci ^. Core.constructorFixity
     }
   where
     ty = convertType 0 (ci ^. Core.constructorType)
diff --git a/src/Juvix/Compiler/Asm/Translation/FromSource.hs b/src/Juvix/Compiler/Asm/Translation/FromSource.hs
@@ -43,7 +43,8 @@ createBuiltinConstr sym btag name ty i =
           _constructorType = ty,
           _constructorArgsNum = n,
           _constructorInductive = sym,
-          _constructorRepresentation = MemRepConstr
+          _constructorRepresentation = MemRepConstr,
+          _constructorFixity = Nothing
         }
 
 declareBuiltins :: (Member InfoTableBuilder r) => ParsecS r ()
@@ -187,7 +188,8 @@ constrDecl symInd = do
             _constructorArgsNum = length (typeArgs ty'),
             _constructorType = ty',
             _constructorInductive = symInd,
-            _constructorRepresentation = MemRepConstr
+            _constructorRepresentation = MemRepConstr,
+            _constructorFixity = Nothing
           }
   lift $ registerConstr ci
   return ci

diff --git a/src/Juvix/Compiler/Backend/C/Translation/FromReg.hs b/src/Juvix/Compiler/Backend/C/Translation/FromReg.hs
@@ -11,6 +11,7 @@ import Juvix.Compiler.Backend.C.Translation.FromReg.Base
 import Juvix.Compiler.Reg.Data.InfoTable qualified as Reg
 import Juvix.Compiler.Reg.Extra qualified as Reg
 import Juvix.Compiler.Reg.Language qualified as Reg
+import Juvix.Data.Fixity qualified as Fixity
 import Juvix.Prelude
 
 fromReg :: Limits -> Reg.InfoTable -> MiniCResult
@@ -39,9 +40,42 @@ fromReg lims tab =
                 ListInitializer $
                   ExprInitializer (macroVar "BUILTIN_UIDS_INFO")
                     : map
-                      (\ci -> ListInitializer [ExprInitializer $ string (ci ^. Reg.constructorName)])
+                      ( \ci ->
+                          ListInitializer
+                            [ ExprInitializer $ string (ci ^. Reg.constructorName),
+                              ExprInitializer $ constrIsBinop (ci ^. Reg.constructorFixity),
+                              constrFixity (ci ^. Reg.constructorFixity)
+                            ]
+                      )
                       (Reg.userConstrs tab)
           }
+      where
+        constrIsBinop :: Maybe Fixity -> Expression
+        constrIsBinop = \case
+          Just fixity -> integer (fromEnum (isBinary fixity))
+          Nothing -> integer (0 :: Int)
+
+        constrFixity :: Maybe Fixity -> Initializer
+        constrFixity = \case
+          Just fixity ->
+            ListInitializer
+              [ ExprInitializer $ getPrec (fixity ^. fixityPrecedence),
+                ExprInitializer $ ExpressionVar $ getAssoc (fixity ^. fixityArity)
+              ]
+          Nothing -> ExprInitializer $ macroVar "APP_FIXITY"
+
+        getPrec :: Precedence -> Expression
+        getPrec = \case
+          PrecMinusOmega -> macroVar "PREC_MINUS_OMEGA"
+          PrecOmega -> macroVar "PREC_OMEGA"
+          PrecNat n -> integer n
+
+        getAssoc :: OperatorArity -> Text
+        getAssoc = \case
+          Fixity.Unary _ -> "assoc_none"
+          Fixity.Binary AssocNone -> "assoc_none"
+          Fixity.Binary AssocLeft -> "assoc_left"
+          Fixity.Binary AssocRight -> "assoc_right"
 
     functionInfo :: CCode
     functionInfo =

diff --git a/src/Juvix/Compiler/Core/Data/Stripped/InfoTable.hs b/src/Juvix/Compiler/Core/Data/Stripped/InfoTable.hs
@@ -44,7 +44,8 @@ data ConstructorInfo = ConstructorInfo
     _constructorLocation :: Maybe Location,
     _constructorInductive :: Symbol,
     _constructorTag :: Tag,
-    _constructorType :: Type
+    _constructorType :: Type,
+    _constructorFixity :: Maybe Fixity
   }
 
 data ParameterInfo = ParameterInfo

diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -556,16 +556,20 @@ instance (PrettyCode a) => PrettyCode [a] where
 -- printing values
 --------------------------------------------------------------------------------
 
-goBinary :: Member (Reader Options) r => Fixity -> Doc Ann -> [Value] -> Sem r (Doc Ann)
-goBinary fixity name = \case
+goBinary :: Member (Reader Options) r => Bool -> Fixity -> Doc Ann -> [Value] -> Sem r (Doc Ann)
+goBinary isComma fixity name = \case
   [] -> return (parens name)
   [arg] -> do
     arg' <- ppRightExpression appFixity arg
     return $ parens name <+> arg'
   [arg1, arg2] -> do
     arg1' <- ppLeftExpression fixity arg1
     arg2' <- ppRightExpression fixity arg2
-    return $ arg1' <+> name <+> arg2'
+    if
+        | isComma ->
+            return $ arg1' <> name <+> arg2'
+        | otherwise ->
+            return $ arg1' <+> name <+> arg2'
   _ ->
     impossible
 
@@ -587,7 +591,7 @@ instance PrettyCode ConstrApp where
         return $ hsep (n : args)
       Just fixity
         | isBinary fixity ->
-            goBinary fixity n _constrAppArgs
+            goBinary (_constrAppName == ",") fixity n _constrAppArgs
         | isUnary fixity ->
             goUnary fixity n _constrAppArgs
       _ -> impossible

diff --git a/src/Juvix/Compiler/Core/Translation/Stripped/FromCore.hs b/src/Juvix/Compiler/Core/Translation/Stripped/FromCore.hs
@@ -80,7 +80,8 @@ translateConstructorInfo ConstructorInfo {..} =
       _constructorLocation = _constructorLocation,
       _constructorInductive = _constructorInductive,
       _constructorTag = _constructorTag,
-      _constructorType = translateType _constructorType
+      _constructorType = translateType _constructorType,
+      _constructorFixity
     }
 
 translateFunction :: Int -> Node -> Stripped.Node

diff --git a/src/Juvix/Compiler/Reg/Data/InfoTable.hs b/src/Juvix/Compiler/Reg/Data/InfoTable.hs
@@ -25,7 +25,8 @@ data ConstructorInfo = ConstructorInfo
     _constructorTag :: Tag,
     _constructorArgsNum :: Int,
     _constructorInductive :: Symbol,
-    _constructorRepresentation :: MemRep
+    _constructorRepresentation :: MemRep,
+    _constructorFixity :: Maybe Fixity
   }
 
 data InductiveInfo = InductiveInfo

diff --git a/src/Juvix/Compiler/Reg/Translation/FromAsm.hs b/src/Juvix/Compiler/Reg/Translation/FromAsm.hs
@@ -37,7 +37,8 @@ fromAsm tab =
           _constructorTag = ci ^. Asm.constructorTag,
           _constructorArgsNum = ci ^. Asm.constructorArgsNum,
           _constructorInductive = ci ^. Asm.constructorInductive,
-          _constructorRepresentation = ci ^. Asm.constructorRepresentation
+          _constructorRepresentation = ci ^. Asm.constructorRepresentation,
+          _constructorFixity = ci ^. Asm.constructorFixity
         }
 
     convertInductive :: Asm.InductiveInfo -> InductiveInfo