Work on system for adding compiler warnings.

This is the beginning of a system for compiler warnings. This includes
linting, deprecation notices, and other compiler warnings that are best
detected by the `compile` function and don't require the partial
evalutaion of the flychecker.

src/core/compile.c

@@ -53,6 +53,36 @@ void janetc_cerror(JanetCompiler *c, const char *m) {
     janetc_error(c, janet_cstring(m));
 }
 
+static const char *janet_lint_level_names[] = {
+    "relaxed",
+    "normal",
+    "strict"
+};
+
+/* Emit compiler linter messages */
+void janetc_lintf(JanetCompiler *c, JanetCompileLintLevel level, const char *format, ...) {
+    if (NULL != c->lints) {
+        /* format message */
+        va_list args;
+        JanetBuffer buffer;
+        int32_t len = 0;
+        while (format[len]) len++;
+        janet_buffer_init(&buffer, len);
+        va_start(args, format);
+        janet_formatbv(&buffer, format, args);
+        va_end(args);
+        const uint8_t *str = janet_string(buffer.data, buffer.count);
+        janet_buffer_deinit(&buffer);
+        /* construct linting payload */
+        Janet *payload = janet_tuple_begin(4);
+        payload[0] = janet_ckeywordv(janet_lint_level_names[level]);
+        payload[1] = janet_wrap_integer(c->current_mapping.line);
+        payload[2] = janet_wrap_integer(c->current_mapping.column);
+        payload[3] = janet_wrap_string(str);
+        janet_array_push(c->lints, janet_wrap_tuple(janet_tuple_end(payload)));
+    }
+}
+
 /* Free a slot */
 void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
     if (s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF | JANET_SLOT_NAMED)) return;
@@ -199,24 +229,41 @@ JanetSlot janetc_resolve(
 
     /* Symbol not found - check for global */
     {
-        Janet check;
+        JanetBinding binding = janet_resolve_ext(c->env, sym);
-        JanetBindingType btype = janet_resolve(c->env, sym, &check);
+        switch (binding.type) {
-        switch (btype) {
             default:
             case JANET_BINDING_NONE:
                 janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
                 return janetc_cslot(janet_wrap_nil());
             case JANET_BINDING_DEF:
             case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
-                return janetc_cslot(check);
+                ret = janetc_cslot(binding.value);
+                break;
             case JANET_BINDING_VAR: {
-                JanetSlot ret = janetc_cslot(check);
+                ret = janetc_cslot(binding.value);
-                /* TODO save type info */
                 ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
                 ret.flags &= ~JANET_SLOT_CONSTANT;
-                return ret;
+                break;
             }
         }
+        JanetCompileLintLevel depLevel = JANET_C_LINT_RELAXED;
+        switch (binding.deprecation) {
+            case JANET_BINDING_DEP_NONE:
+                break;
+            case JANET_BINDING_DEP_RELAXED:
+                depLevel = JANET_C_LINT_RELAXED;
+                break;
+            case JANET_BINDING_DEP_NORMAL:
+                depLevel = JANET_C_LINT_NORMAL;
+                break;
+            case JANET_BINDING_DEP_STRICT:
+                depLevel = JANET_C_LINT_STRICT;
+                break;
+        }
+        if (binding.deprecation != JANET_BINDING_DEP_NONE) {
+            janetc_lintf(c, depLevel, "%q is deprecated", janet_wrap_symbol(sym));
+        }
+        return ret;
     }
 
     /* Symbol was found */
@@ -397,6 +444,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
     JanetScope unusedScope;
     int32_t bufstart = janet_v_count(c->buffer);
     int32_t mapbufstart = janet_v_count(c->mapbuffer);
+    /* TODO - warn for dead code */
     janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
     janetc_value(opts, x);
     janetc_popscope(c);
@@ -825,7 +873,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
 }
 
 /* Initialize a compiler */
-static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where) {
+static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where, JanetArray *lints) {
     c->scope = NULL;
     c->buffer = NULL;
     c->mapbuffer = NULL;
@@ -834,6 +882,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where)
     c->source = where;
     c->current_mapping.line = -1;
     c->current_mapping.column = -1;
+    c->lints = lints;
     /* Init result */
     c->result.error = NULL;
     c->result.status = JANET_COMPILE_OK;
@@ -851,12 +900,13 @@ static void janetc_deinit(JanetCompiler *c) {
 }
 
 /* Compile a form. */
-JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
+JanetCompileResult janet_compile_lint(Janet source,
+                                      JanetTable *env, const uint8_t *where, JanetArray *lints) {
     JanetCompiler c;
     JanetScope rootscope;
     JanetFopts fopts;
 
-    janetc_init(&c, env, where);
+    janetc_init(&c, env, where, lints);
 
     /* Push a function scope */
     janetc_scope(&rootscope, &c, JANET_SCOPE_FUNCTION | JANET_SCOPE_TOP, "root");
@@ -884,19 +934,24 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
     return c.result;
 }
 
+JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
+    return janet_compile_lint(source, env, where, NULL);
+}
+
 /* C Function for compiling */
 static Janet cfun(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 3);
+    janet_arity(argc, 1, 4);
     JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
     if (NULL == env) {
         env = janet_table(0);
         janet_vm_fiber->env = env;
     }
     const uint8_t *source = NULL;
-    if (argc == 3) {
+    if (argc >= 3) {
         source = janet_getstring(argv, 2);
     }
-    JanetCompileResult res = janet_compile(argv[0], env, source);
+    JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
+    JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
     if (res.status == JANET_COMPILE_OK) {
         return janet_wrap_function(janet_thunk(res.funcdef));
     } else {
@@ -918,11 +973,13 @@ static Janet cfun(int32_t argc, Janet *argv) {
 static const JanetReg compile_cfuns[] = {
     {
         "compile", cfun,
-        JDOC("(compile ast &opt env source)\n\n"
+        JDOC("(compile ast &opt env source lints)\n\n"
              "Compiles an Abstract Syntax Tree (ast) into a function. "
              "Pair the compile function with parsing functionality to implement "
              "eval. Returns a new function and does not modify ast. Returns an error "
-             "struct with keys :line, :column, and :error if compilation fails.")
+             "struct with keys :line, :column, and :error if compilation fails. "
+             "If a `lints` array is given, linting messages will be appended to the array. "
+             "Each message will be a tuple of the form `(level line col message)`.")
     },
     {NULL, NULL, NULL}
 };

src/core/compile.h

@@ -29,6 +29,13 @@
 #include "regalloc.h"
 #endif
 
+/* Levels for compiler warnings */
+typedef enum {
+    JANET_C_LINT_RELAXED,
+    JANET_C_LINT_NORMAL,
+    JANET_C_LINT_STRICT
+} JanetCompileLintLevel;
+
 /* Tags for some functions for the prepared inliner */
 #define JANET_FUN_DEBUG 1
 #define JANET_FUN_ERROR 2
@@ -78,10 +85,10 @@ typedef struct JanetSpecial JanetSpecial;
 #define JANET_SLOT_MUTABLE 0x40000
 #define JANET_SLOT_REF 0x80000
 #define JANET_SLOT_RETURNED 0x100000
-/* Needed for handling single element arrays as global vars. */
+#define JANET_SLOT_DEP_NOTE 0x200000
-
+#define JANET_SLOT_DEP_WARN 0x400000
-/* Used for unquote-splicing */
+#define JANET_SLOT_DEP_ERROR 0x800000
-#define JANET_SLOT_SPLICED 0x200000
+#define JANET_SLOT_SPLICED 0x1000000
 
 #define JANET_SLOTTYPE_ANY 0xFFFF
 
@@ -164,6 +171,9 @@ struct JanetCompiler {
 
     /* Prevent unbounded recursion */
     int recursion_guard;
+
+    /* Collect linting results */
+    JanetArray *lints;
 };
 
 #define JANET_FOPTS_TAIL 0x10000
@@ -230,6 +240,9 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s);
 void janetc_error(JanetCompiler *c, const uint8_t *m);
 void janetc_cerror(JanetCompiler *c, const char *m);
 
+/* Linting */
+void janetc_lintf(JanetCompiler *C, JanetCompileLintLevel level, const char *format, ...);
+
 /* Dispatch to correct form compiler */
 JanetSlot janetc_value(JanetFopts opts, Janet x);
 

src/core/peg.c

@@ -1149,8 +1149,8 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
         Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
         if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
             nextPeg = (b->default_grammar == NULL)
-                ? janet_wrap_nil()
+                      ? janet_wrap_nil()
-                : janet_table_get(b->default_grammar, peg);
+                      : janet_table_get(b->default_grammar, peg);
             if (janet_checktype(nextPeg, JANET_NIL)) {
                 peg_panic(b, "unknown rule");
             }

src/core/util.c

@@ -487,27 +487,59 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf
 }
 #endif
 
-/* Resolve a symbol in the environment */
+JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
-JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
     Janet ref;
     JanetTable *entry_table;
     Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
+    JanetBinding binding = {};
+    binding.type = JANET_BINDING_NONE;
+    binding.value = janet_wrap_nil();
+    binding.deprecation = JANET_BINDING_DEP_NONE;
+
+    /* Check environment for entry */
     if (!janet_checktype(entry, JANET_TABLE))
-        return JANET_BINDING_NONE;
+        return binding;
     entry_table = janet_unwrap_table(entry);
+
+    /* deprecation check */
+    Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
+    if (janet_checktype(deprecate, JANET_KEYWORD)) {
+        JanetKeyword depkw = janet_unwrap_keyword(deprecate);
+        if (!janet_cstrcmp(depkw, "relaxed")) {
+            binding.deprecation = JANET_BINDING_DEP_RELAXED;
+        } else if (!janet_cstrcmp(depkw, "normal")) {
+            binding.deprecation = JANET_BINDING_DEP_NORMAL;
+        } else if (!janet_cstrcmp(depkw, "strict")) {
+            binding.deprecation = JANET_BINDING_DEP_STRICT;
+        }
+    } else if (!janet_checktype(deprecate, JANET_NIL)) {
+        binding.deprecation = JANET_BINDING_DEP_NORMAL;
+    }
+
     if (!janet_checktype(
                 janet_table_get(entry_table, janet_ckeywordv("macro")),
                 JANET_NIL)) {
-        *out = janet_table_get(entry_table, janet_ckeywordv("value"));
+        binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
-        return JANET_BINDING_MACRO;
+        binding.type = JANET_BINDING_MACRO;
+        return binding;
     }
+
     ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
     if (janet_checktype(ref, JANET_ARRAY)) {
-        *out = ref;
+        binding.value = ref;
-        return JANET_BINDING_VAR;
+        binding.type = JANET_BINDING_VAR;
+        return binding;
     }
-    *out = janet_table_get(entry_table, janet_ckeywordv("value"));
+
-    return JANET_BINDING_DEF;
+    binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
+    binding.type = JANET_BINDING_DEF;
+    return binding;
+}
+
+JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
+    JanetBinding binding = janet_resolve_ext(env, sym);
+    *out = binding.value;
+    return binding.type;
 }
 
 /* Resolve a symbol in the core environment. */

src/include/janet.h

@@ -299,9 +299,10 @@ typedef struct {
 /***** START SECTION TYPES *****/
 
 #ifdef JANET_WINDOWS
-// Must be defined before including stdlib.h
+/* Must be defined before including stdlib.h */
 #define _CRT_RAND_S
 #endif
+
 #include <stdlib.h>
 #include <stdint.h>
 #include <string.h>
@@ -1409,6 +1410,11 @@ struct JanetCompileResult {
     enum JanetCompileStatus status;
 };
 JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, JanetString where);
+JANET_API JanetCompileResult janet_compile_lint(
+    Janet source,
+    JanetTable *env,
+    JanetString where,
+    JanetArray *lints);
 
 /* Get the default environment for janet */
 JANET_API JanetTable *janet_core_env(JanetTable *replacements);
@@ -1664,11 +1670,24 @@ typedef enum {
     JANET_BINDING_VAR,
     JANET_BINDING_MACRO
 } JanetBindingType;
+
+typedef struct {
+    JanetBindingType type;
+    Janet value;
+    enum {
+        JANET_BINDING_DEP_NONE,
+        JANET_BINDING_DEP_RELAXED,
+        JANET_BINDING_DEP_NORMAL,
+        JANET_BINDING_DEP_STRICT,
+    } deprecation;
+} JanetBinding;
+
 JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation);
 JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
 JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
 JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
 JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
+JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym);
 JANET_API void janet_register(const char *name, JanetCFunction cfun);
 
 /* Get values from the core environment. */