Add INLINE syntax

src/codegen/monomorphize.lisp

@@ -414,11 +414,12 @@ propagate dictionaries that have been moved by the hoister."
       (action (:after node-application) #'apply-candidate)
       (action (:after node-direct-application) #'apply-candidate)))))
 
-(defun monomorphize (name manager package resolve-table optimize-node env)
+(defun monomorphize (name manager package resolve-table inline-p-table optimize-node env)
   (declare (type symbol name)
            (type candidate-manager manager)
            (type package package)
            (type hash-table resolve-table)
+           (type hash-table inline-p-table)
            (type function optimize-node)
            (type tc:environment env)
            (values binding-list &optional))
@@ -435,16 +436,23 @@ propagate dictionaries that have been moved by the hoister."
 
           :for name := (compile-candidate-name candidate)
           :for code := (tc:lookup-code env name)
+          :for function-env-entry := (tc:lookup-function env name :no-error t)
+          :for inline-p := (and (node-abstraction-p code)
+                                function-env-entry
+                                (tc:function-env-entry-inline-p function-env-entry))
           :for new-code := (funcall optimize-node (compile-candidate candidate code env) env)
 
           :for new-code_ := (progn
                               (candidate-selection new-code manager resolve-table package env)
                               (rewrite-callsites new-code manager resolve-table env))
 
           :for new-code__ := (funcall optimize-node new-code_ env)
+          :for candidate-name := (candidate-manager-get manager candidate)
 
           :do (candidate-selection new-code__ manager resolve-table package env)
-          :do (push (cons (candidate-manager-get manager candidate) (rewrite-callsites new-code__ manager resolve-table env))
-                    binding-group))
+          :do (push (cons candidate-name (rewrite-callsites new-code__ manager resolve-table env))
+                    binding-group)
+          :do (when inline-p
+                (setf (gethash candidate-name inline-p-table) t)))
 
     binding-group))

src/codegen/optimizer.lisp

@@ -58,7 +58,7 @@
 
 (in-package #:coalton-impl/codegen/optimizer)
 
-(defun update-function-env (bindings env)
+(defun update-function-env (bindings inline-p-table env)
   (declare (type binding-list bindings)
            (type tc:environment env)
            (values tc:environment))
@@ -77,7 +77,8 @@
                     name
                     (tc:make-function-env-entry
                      :name name
-                     :arity arity))))
+                     :arity arity
+                     :inline-p (gethash name inline-p-table)))))
     (dolist (name toplevel-values)
       (when (tc:lookup-function env name :no-error t)
         (setf env (tc:unset-function env name)))))
@@ -91,9 +92,10 @@
       (setf (gethash name table) (tc:function-env-entry-arity entry)))
     table))
 
-(defun optimize-bindings (bindings monomorphize-table package env)
+(defun optimize-bindings (bindings monomorphize-table inline-p-table package env)
   (declare (type binding-list bindings)
            (type hash-table monomorphize-table)
+           (type hash-table inline-p-table)
            (type package package)
            (type tc:environment env)
            (values binding-list tc:environment))
@@ -129,6 +131,7 @@
                               manager
                               package
                               resolve-table
+                              inline-p-table
                               (lambda (node env)
                                 (optimize-node node env))
                               env)
@@ -138,7 +141,7 @@
 
 
       ;; Update function env
-      (setf env (update-function-env bindings env))
+      (setf env (update-function-env bindings inline-p-table env))
 
 
       (let ((function-table (make-function-table env)))
@@ -422,7 +425,9 @@ requires direct constructor calls."
                  ((name (node-rator-name node))
                   (code (tc:lookup-code env name :no-error t))
                   (_    (and (node-abstraction-p code)
-                             (funcall heuristic code)
+                             (or (alexandria:when-let (fun-env-entry (tc:lookup-function env name :no-error t))
+                                   (tc:function-env-entry-inline-p fun-env-entry))
+                                 (funcall heuristic code))
                              (<= (length call-stack)
                                  max-depth)
                              (<= (count name call-stack)
@@ -461,7 +466,7 @@ requires direct constructor calls."
 NODE in the environment ENV."
   (if settings:*coalton-heuristic-inlining*
       (heuristic-inline-applications node env)
-      node))
+      (heuristic-inline-applications node env :heuristic (constantly nil))))
 
 (defun inline-methods (node env)
   (declare (type node node)

src/codegen/program.lisp

@@ -137,9 +137,10 @@ Example:
               (setf (gethash (car binding) offsets) offset))
         :append instance-bindings))
 
-(defun compile-translation-unit (translation-unit monomorphize-table env)
+(defun compile-translation-unit (translation-unit monomorphize-table inline-p-table env)
   (declare (type tc:translation-unit translation-unit)
            (type hash-table monomorphize-table)
+           (type hash-table inline-p-table)
            (type tc:environment env))
 
   (let* ((offsets (make-hash-table))
@@ -150,7 +151,7 @@ Example:
          (definition-names (mapcar #'car definitions)))
 
     (multiple-value-bind (definitions env)
-        (optimize-bindings definitions monomorphize-table *package* env)
+        (optimize-bindings definitions monomorphize-table inline-p-table *package* env)
 
       (let ((sccs (node-binding-sccs definitions))
             (lisp-forms (tc:translation-unit-lisp-forms translation-unit)))

src/entry.lisp

@@ -63,6 +63,8 @@
 
                 (let ((monomorphize-table (make-hash-table :test #'eq))
 
+                      (inline-p-table (make-hash-table :test #'eq))
+
                       (translation-unit
                         (tc:make-translation-unit
                          :types type-definitions
@@ -84,9 +86,29 @@
                                              monomorphize-table)
                                     t))
 
+                  (loop :for define :in (parser:program-defines program)
+                        :when (parser:toplevel-define-inline-p define)
+                          :do (setf (gethash (parser:node-variable-name (parser:toplevel-define-name define))
+                                             inline-p-table)
+                                    t))
+
+                  (loop :for declare :in (parser:program-declares program)
+                        :when (parser:toplevel-declare-inline-p declare)
+                          :do (setf (gethash (parser:identifier-src-name (parser:toplevel-declare-name declare))
+                                             inline-p-table)
+                                    t))
+
+                  (loop :for ty-instance :in ty-instances
+                        :for method-codegen-syms := (tc:get-table (tc:ty-class-instance-method-codegen-syms ty-instance))
+                        :for method-inline-p := (tc:ty-class-instance-method-inline-p ty-instance)
+                        :do (maphash (lambda (method-name method-codegen-sym)
+                                       (when (tc:get-value method-inline-p method-name)
+                                         (setf (gethash method-codegen-sym inline-p-table) t)))
+                                     method-codegen-syms))
+
                   (analysis:analyze-translation-unit translation-unit env)
 
-                  (codegen:compile-translation-unit translation-unit monomorphize-table env))))))))))
+                  (codegen:compile-translation-unit translation-unit monomorphize-table inline-p-table env))))))))))
 
 
 (defun expression-entry-point (node)

src/package.lisp

@@ -29,6 +29,7 @@
    #:repr
    #:lisp-toplevel
    #:monomorphize
+   #:inline
    #:specialize
    #:unable-to-codegen)
 

src/parser/renamer.lisp

@@ -474,7 +474,8 @@
         :docstring (source:docstring toplevel)
         :body (rename-variables-generic% (toplevel-define-body toplevel) new-ctx)
         :location (source:location toplevel)
-        :monomorphize (toplevel-define-monomorphize toplevel))
+        :monomorphize (toplevel-define-monomorphize toplevel)
+        :inline-p (toplevel-define-inline-p toplevel))
        ctx)))
 
   (:method ((method instance-method-definition) ctx)
@@ -490,7 +491,8 @@
         :name (instance-method-definition-name method)
         :params (rename-variables-generic% (instance-method-definition-params method) new-ctx)
         :body (rename-variables-generic% (instance-method-definition-body method) new-ctx)
-        :location (source:location method))
+        :location (source:location method)
+        :inline-p (instance-method-definition-inline-p method))
        ctx)))
 
   (:method ((toplevel toplevel-define-instance) ctx)