allow quoting :key symbols + further optimize defpart (#2592)

This should hopefully improve build times in general, especially for
files with `defpart`.

common/goos/Interpreter.cpp

@@ -328,6 +328,48 @@ Arguments Interpreter::get_args(const Object& form, const Object& rest, const Ar
   return args;
 }
 
+/*!
+ * Same as get_args, but named :key arguments are not parsed.
+ */
+Arguments Interpreter::get_args_no_named(const Object& form,
+                                         const Object& rest,
+                                         const ArgumentSpec& spec) {
+  Arguments args;
+
+  // Check expected key args, which should be none
+  if (!spec.named.empty()) {
+    throw_eval_error(form, "key arguments were expected in get_args_no_named");
+  }
+
+  // loop over forms in list
+  Object current = rest;
+  while (!current.is_empty_list()) {
+    auto arg = current.as_pair()->car;
+
+    // not a keyword. Add to unnamed or rest, depending on what we expect
+    if (spec.varargs || args.unnamed.size() < spec.unnamed.size()) {
+      args.unnamed.push_back(arg);
+    } else {
+      args.rest.push_back(arg);
+    }
+    current = current.as_pair()->cdr;
+  }
+
+  // Check argument size, if spec defines it
+  if (!spec.varargs) {
+    if (args.unnamed.size() < spec.unnamed.size()) {
+      throw_eval_error(form, "didn't get enough arguments");
+    }
+    ASSERT(args.unnamed.size() == spec.unnamed.size());
+
+    if (!args.rest.empty() && spec.rest.empty()) {
+      throw_eval_error(form, "got too many arguments");
+    }
+  }
+
+  return args;
+}
+
 /*!
  * Evaluate arguments in-place in the given environment.
  * Evaluation order is:
@@ -768,8 +810,10 @@ Object Interpreter::eval_quote(const Object& form,
                                const Object& rest,
                                const std::shared_ptr<EnvironmentObject>& env) {
   (void)env;
-  auto args = get_args(form, rest, make_varargs());
+  auto args = get_args_no_named(form, rest, make_varargs());
-  vararg_check(form, args, {{}}, {});
+  if (args.unnamed.size() != 1) {
+    throw_eval_error(form, "invalid number of arguments to quote");
+  }
   return args.unnamed.front();
 }
 

common/goos/Interpreter.h

@@ -31,6 +31,7 @@ class Interpreter {
                    const std::shared_ptr<EnvironmentObject>& env,
                    Object* result);
   Arguments get_args(const Object& form, const Object& rest, const ArgumentSpec& spec);
+  Arguments get_args_no_named(const Object& form, const Object& rest, const ArgumentSpec& spec);
   void set_args_in_env(const Object& form,
                        const Arguments& args,
                        const ArgumentSpec& arg_spec,

common/goos/ParseHelpers.cpp

@@ -39,6 +39,18 @@ bool get_va(const goos::Object& rest, std::string* err_string, goos::Arguments*
   return true;
 }
 
+bool get_va_no_named(const goos::Object& rest, std::string* err_string, goos::Arguments* result) {
+  goos::Arguments args;
+  // loop over forms in list
+  goos::Object current = rest;
+  while (!current.is_empty_list()) {
+    args.unnamed.push_back(current.as_pair()->car);
+    current = current.as_pair()->cdr;
+  }
+  *result = args;
+  return true;
+}
+
 bool va_check(
     const goos::Arguments& args,
     const std::vector<std::optional<goos::ObjectType>>& unnamed,

common/goos/ParseHelpers.h

@@ -9,6 +9,7 @@
 
 namespace goos {
 bool get_va(const goos::Object& rest, std::string* err_string, goos::Arguments* result);
+bool get_va_no_named(const goos::Object& rest, std::string* err_string, goos::Arguments* result);
 bool va_check(
     const goos::Arguments& args,
     const std::vector<std::optional<goos::ObjectType>>& unnamed,
@@ -28,4 +29,4 @@ void for_each_in_list(const goos::Object& list, T f) {
 }
 
 int list_length(const goos::Object& list);
-}  // namespace goos
+}  // namespace goos

goal_src/jak1/engine/gfx/sprite/sparticle/sparticle-launcher-h.gc

@@ -326,8 +326,8 @@
 (define *sparticle-fields* '())
 (doenum (name val 'sp-field-id)
   (append!! *sparticle-fields* (list (if (string-starts-with? (symbol->string name) "spt-")
-                                         (string-substr (symbol->string name) 4 0)
+                                         (string->symbol (string-substr (symbol->string name) 4 0))
-                                         (symbol->string name))
+                                         name)
                                      val name (member name '(spt-vel-x
                                                              spt-vel-y
                                                              spt-vel-z
@@ -369,13 +369,13 @@
                     ,@(apply (lambda (x)
                     (let* ((head (symbol->string (car x)))
                           (params (cdr x))
-                          (field-name (string-substr head 1 0))
+                          (field-name (string->symbol (string-substr head 1 0)))
                           (field (assoc field-name *sparticle-fields*)))
                       (when (not field)
                         (fmt #t "unknown sparticle field {}\n" x))
                       (when (neq? (string-ref head 0) #\:)
                         (fmt #t "invalid sparticle field {}\n" x))
-                      (when (member (string->symbol field-name) *sparticle-fields-banned*)
+                      (when (member field-name *sparticle-fields-banned*)
                         (fmt #t "you cannot use sparticle field {}\n" field-name))
                     (let* ((field-id (cadr field))
                           (field-enum-name (caddr field))
@@ -388,20 +388,20 @@
                         (fmt #t "field {} must come after field {}, not before\n" field-name (car (nth last-field-id *sparticle-fields*))))
                       (set! last-field-id field-id)
                       (cond
-                        ((eq? field-name "flags")
+                        ((eq? field-name 'flags)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value (sp-cpuinfo-flag ,@param0) :random-mult 1)
                           )
-                        ((eq? field-name "texture")
+                        ((eq? field-name 'texture)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :tex ,param0 :flags (sp-flag int))
                           )
-                        ((eq? field-name "next-launcher")
+                        ((eq? field-name 'next-launcher)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value ,param0 :flags (sp-flag launcher))
                           )
-                        ((eq? field-name "sound")
+                        ((eq? field-name 'sound)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :sound ,param0 :flags (sp-flag object))
                           )
-                        ((and (= 2 param-count) (symbol? param0) (eq? (symbol->string param0) ":copy"))
+                        ((and (= 2 param-count) (symbol? param0) (eq? param0 ':copy))
-                          (let* ((other-field (assoc (symbol->string (cadr (member (string->symbol ":copy") params))) *sparticle-fields*))
+                          (let* ((other-field (assoc (cadr (member ':copy params)) *sparticle-fields*))
                                 (other-field-id (cadr other-field)))
                             (when (>= other-field-id field-id)
                               (fmt #t "warning copying to sparticle field {} - you can only copy from fields before this one!\n" field-name))
@@ -409,9 +409,9 @@
                                                               :initial-value ,(- other-field-id field-id) :random-mult 1)
                             )
                           )
-                        ((and (= 2 param-count) (symbol? param0) (eq? (symbol->string param0) ":data"))
+                        ((and (= 2 param-count) (symbol? param0) (eq? param0 ':data))
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag object)
-                                                            :pntr (the-as pointer ,(cadr (member (string->symbol ":data") params))))
+                                                            :pntr (the-as pointer ,(cadr (member ':data params))))
                           )
                         ((and (= 1 param-count) (param-symbol? param0))
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag symbol)

goal_src/jak2/engine/gfx/sprite/particles/sparticle-launcher-h.gc

@@ -192,8 +192,8 @@
 (define *sparticle-fields* '())
 (doenum (name val 'sp-field-id)
   (append!! *sparticle-fields* (list (if (string-starts-with? (symbol->string name) "spt-")
-                                         (string-substr (symbol->string name) 4 0)
+                                         (string->symbol (string-substr (symbol->string name) 4 0))
-                                         (symbol->string name))
+                                         name)
                                      val name (member name '(spt-vel-x
                                                              spt-vel-y
                                                              spt-vel-z
@@ -235,18 +235,18 @@
                     ,@(apply (lambda (x)
                     (let* ((head (symbol->string (car x)))
                           (params (cdr x))
-                          (field-name (string-substr head 1 0))
+                          (field-name (string->symbol (string-substr head 1 0)))
                           (field (assoc field-name *sparticle-fields*)))
                       (when (not field)
                         (fmt #t "unknown sparticle field {}\n" x))
                       (when (neq? (string-ref head 0) #\:)
                         (fmt #t "invalid sparticle field {}\n" x))
-                      (when (member (string->symbol field-name) *sparticle-fields-banned*)
+                      (when (member field-name *sparticle-fields-banned*)
                         (fmt #t "you cannot use sparticle field {}\n" field-name))
                     (let* ((field-id (cadr field))
                           (field-enum-name (caddr field))
                           (vel? (and #f (cadddr field)))
-                          (store? (member (string->symbol ":store") params))
+                          (store? (member ':store params))
                           (param-count (if store? (1- (length params)) (length params)))
                           (param0 (and (>= param-count 1) (first params)))
                           (param1 (and (>= param-count 2) (second params)))
@@ -255,20 +255,20 @@
                         (fmt #t "field {} must come after field {}, not before\n" field-name (car (nth last-field-id *sparticle-fields*))))
                       (set! last-field-id field-id)
                       (cond
-                        ((eq? field-name "flags")
+                        ((eq? field-name 'flags)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value (sp-cpuinfo-flag ,@param0) :random-mult 1)
                           )
-                        ((eq? field-name "texture")
+                        ((eq? field-name 'texture)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :tex ,param0 :flags (sp-flag int))
                           )
-                        ((eq? field-name "next-launcher")
+                        ((eq? field-name 'next-launcher)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value ,param0 :flags (sp-flag launcher))
                           )
-                        ((eq? field-name "sound")
+                        ((eq? field-name 'sound)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :sound ,param0 :flags (sp-flag object))
                           )
-                        ((and (= 2 param-count) (symbol? param0) (eq? (symbol->string param0) ":copy"))
+                        ((and (= 2 param-count) (symbol? param0) (eq? param0 ':copy))
-                          (let* ((other-field (assoc (symbol->string (cadr (member (string->symbol ":copy") params))) *sparticle-fields*))
+                          (let* ((other-field (assoc (cadr (member ':copy params)) *sparticle-fields*))
                                 (other-field-id (cadr other-field)))
                             (when (>= other-field-id field-id)
                               (fmt #t "warning copying to sparticle field {} - you can only copy from fields before this one!\n" field-name))
@@ -276,9 +276,9 @@
                                                               :initial-value ,(- other-field-id field-id) :random-mult 1)
                             )
                           )
-                        ((and (= 2 param-count) (symbol? param0) (eq? (symbol->string param0) ":data"))
+                        ((and (= 2 param-count) (symbol? param0) (eq? param0 ':data))
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag object)
-                                                            :object ,(cadr (member (string->symbol ":data") params)))
+                                                            :object ,(cadr (member ':data params)))
                           )
                         ((and (= 1 param-count) (param-symbol? param0))
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag symbol)

goalc/compiler/Compiler.h

@@ -212,6 +212,7 @@ class Compiler {
                         const std::function<void(const goos::Object&)>& f);
 
   goos::Arguments get_va(const goos::Object& form, const goos::Object& rest);
+  goos::Arguments get_va_no_named(const goos::Object& form, const goos::Object& rest);
   void va_check(const goos::Object& form,
                 const goos::Arguments& args,
                 const std::vector<std::optional<goos::ObjectType>>& unnamed,

goalc/compiler/Util.cpp

@@ -167,6 +167,19 @@ goos::Arguments Compiler::get_va(const goos::Object& form, const goos::Object& r
   return args;
 }
 
+/*!
+ * Parse arguments into a goos::Arguments format.
+ */
+goos::Arguments Compiler::get_va_no_named(const goos::Object& form, const goos::Object& rest) {
+  goos::Arguments args;
+
+  std::string err;
+  if (!goos::get_va_no_named(rest, &err, &args)) {
+    throw_compiler_error(form, err);
+  }
+  return args;
+}
+
 /*!
  * Check arguments in a goos::Arguments format (named and unnamed) and throw a compiler error if it
  * fails.

goalc/compiler/compilation/Macro.cpp

@@ -136,9 +136,11 @@ Val* Compiler::compile_gscond(const goos::Object& form, const goos::Object& rest
  * Current only supports 'thing or '(). Static lists/pairs should be added at some point.
  */
 Val* Compiler::compile_quote(const goos::Object& form, const goos::Object& rest, Env* env) {
-  auto args = get_va(form, rest);
+  auto args = get_va_no_named(form, rest);
-  va_check(form, args, {{}}, {});
+  if (args.unnamed.size() != 1) {
-  auto thing = args.unnamed.at(0);
+    throw_compiler_error(form, "invalid number of arguments to compile quote");
+  }
+  auto& thing = args.unnamed.front();
   switch (thing.type) {
     case goos::ObjectType::SYMBOL:
       return compile_get_sym_obj(thing.as_symbol()->name, env);

test/decompiler/reference/jak1/decompiler-macros.gc

@@ -697,8 +697,8 @@
 (define *sparticle-fields* '())
 (doenum (name val 'sp-field-id)
   (append!! *sparticle-fields* (list (if (string-starts-with? (symbol->string name) "spt-")
-                                         (string-substr (symbol->string name) 4 0)
+                                         (string->symbol (string-substr (symbol->string name) 4 0))
-                                         (symbol->string name))
+                                         name)
                                      val name (member name '(spt-vel-x
                                                              spt-vel-y
                                                              spt-vel-z
@@ -740,13 +740,13 @@
                     ,@(apply (lambda (x)
                     (let* ((head (symbol->string (car x)))
                           (params (cdr x))
-                          (field-name (string-substr head 1 0))
+                          (field-name (string->symbol (string-substr head 1 0)))
                           (field (assoc field-name *sparticle-fields*)))
                       (when (not field)
                         (fmt #t "unknown sparticle field {}\n" x))
                       (when (neq? (string-ref head 0) #\:)
                         (fmt #t "invalid sparticle field {}\n" x))
-                      (when (member (string->symbol field-name) *sparticle-fields-banned*)
+                      (when (member field-name *sparticle-fields-banned*)
                         (fmt #t "you cannot use sparticle field {}\n" field-name))
                     (let* ((field-id (cadr field))
                           (field-enum-name (caddr field))
@@ -759,20 +759,20 @@
                         (fmt #t "field {} must come after field {}, not before\n" field-name (car (nth last-field-id *sparticle-fields*))))
                       (set! last-field-id field-id)
                       (cond
-                        ((eq? field-name "flags")
+                        ((eq? field-name 'flags)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value (sp-cpuinfo-flag ,@param0) :random-mult 1)
                           )
-                        ((eq? field-name "texture")
+                        ((eq? field-name 'texture)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :tex ,param0 :flags (sp-flag int))
                           )
-                        ((eq? field-name "next-launcher")
+                        ((eq? field-name 'next-launcher)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value ,param0 :flags (sp-flag launcher))
                           )
-                        ((eq? field-name "sound")
+                        ((eq? field-name 'sound)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :sound ,param0 :flags (sp-flag object))
                           )
-                        ((and (= 2 param-count) (symbol? param0) (eq? (symbol->string param0) ":copy"))
+                        ((and (= 2 param-count) (symbol? param0) (eq? param0 ':copy))
-                          (let* ((other-field (assoc (symbol->string (cadr (member (string->symbol ":copy") params))) *sparticle-fields*))
+                          (let* ((other-field (assoc (cadr (member ':copy params)) *sparticle-fields*))
                                 (other-field-id (cadr other-field)))
                             (when (>= other-field-id field-id)
                               (fmt #t "warning copying to sparticle field {} - you can only copy from fields before this one!\n" field-name))
@@ -780,9 +780,9 @@
                                                               :initial-value ,(- other-field-id field-id) :random-mult 1)
                             )
                           )
-                        ((and (= 2 param-count) (symbol? param0) (eq? (symbol->string param0) ":data"))
+                        ((and (= 2 param-count) (symbol? param0) (eq? param0 ':data))
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag object)
-                                                            :pntr (the-as pointer ,(cadr (member (string->symbol ":data") params))))
+                                                            :pntr (the-as pointer ,(cadr (member ':data params))))
                           )
                         ((and (= 1 param-count) (param-symbol? param0))
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag symbol)

test/decompiler/reference/jak2/decompiler-macros.gc

@@ -1041,8 +1041,8 @@
 (define *sparticle-fields* '())
 (doenum (name val 'sp-field-id)
   (append!! *sparticle-fields* (list (if (string-starts-with? (symbol->string name) "spt-")
-                                         (string-substr (symbol->string name) 4 0)
+                                         (string->symbol (string-substr (symbol->string name) 4 0))
-                                         (symbol->string name))
+                                         name)
                                      val name (member name '(spt-vel-x
                                                              spt-vel-y
                                                              spt-vel-z
@@ -1084,18 +1084,18 @@
                     ,@(apply (lambda (x)
                     (let* ((head (symbol->string (car x)))
                           (params (cdr x))
-                          (field-name (string-substr head 1 0))
+                          (field-name (string->symbol (string-substr head 1 0)))
                           (field (assoc field-name *sparticle-fields*)))
                       (when (not field)
                         (fmt #t "unknown sparticle field {}\n" x))
                       (when (neq? (string-ref head 0) #\:)
                         (fmt #t "invalid sparticle field {}\n" x))
-                      (when (member (string->symbol field-name) *sparticle-fields-banned*)
+                      (when (member field-name *sparticle-fields-banned*)
                         (fmt #t "you cannot use sparticle field {}\n" field-name))
                     (let* ((field-id (cadr field))
                           (field-enum-name (caddr field))
                           (vel? (and #f (cadddr field)))
-                          (store? (member (string->symbol ":store") params))
+                          (store? (member ':store params))
                           (param-count (if store? (1- (length params)) (length params)))
                           (param0 (and (>= param-count 1) (first params)))
                           (param1 (and (>= param-count 2) (second params)))
@@ -1104,20 +1104,20 @@
                         (fmt #t "field {} must come after field {}, not before\n" field-name (car (nth last-field-id *sparticle-fields*))))
                       (set! last-field-id field-id)
                       (cond
-                        ((eq? field-name "flags")
+                        ((eq? field-name 'flags)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value (sp-cpuinfo-flag ,@param0) :random-mult 1)
                           )
-                        ((eq? field-name "texture")
+                        ((eq? field-name 'texture)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :tex ,param0 :flags (sp-flag int))
                           )
-                        ((eq? field-name "next-launcher")
+                        ((eq? field-name 'next-launcher)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :initial-value ,param0 :flags (sp-flag launcher))
                           )
-                        ((eq? field-name "sound")
+                        ((eq? field-name 'sound)
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :sound ,param0 :flags (sp-flag object))
                           )
-                        ((and (= 2 param-count) (symbol? param0) (eq? (symbol->string param0) ":copy"))
+                        ((and (= 2 param-count) (symbol? param0) (eq? param0 ':copy))
-                          (let* ((other-field (assoc (symbol->string (cadr (member (string->symbol ":copy") params))) *sparticle-fields*))
+                          (let* ((other-field (assoc (cadr (member ':copy params)) *sparticle-fields*))
                                 (other-field-id (cadr other-field)))
                             (when (>= other-field-id field-id)
                               (fmt #t "warning copying to sparticle field {} - you can only copy from fields before this one!\n" field-name))
@@ -1125,9 +1125,9 @@
                                                               :initial-value ,(- other-field-id field-id) :random-mult 1)
                             )
                           )
-                        ((and (= 2 param-count) (symbol? param0) (eq? (symbol->string param0) ":data"))
+                        ((and (= 2 param-count) (symbol? param0) (eq? param0 ':data))
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag object)
-                                                            :object ,(cadr (member (string->symbol ":data") params)))
+                                                            :object ,(cadr (member ':data params)))
                           )
                         ((and (= 1 param-count) (param-symbol? param0))
                           `(new 'static 'sp-field-init-spec :field (sp-field-id ,field-enum-name) :flags (sp-flag symbol)