From 7616f6e95dd371e340ac65deffe41e605497d6fe Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 2 Dec 2017 16:38:11 -0600
Subject: [PATCH] factor: add inlined quotations in stack effects

---
 core/syntax/syntax.factor         | 23 ++++++++++++-----------
 core/words/inlined/authors.txt    |  1 +
 core/words/inlined/inlined.factor | 23 +++++++++++++++++++++++
 3 files changed, 36 insertions(+), 11 deletions(-)
 create mode 100644 core/words/inlined/authors.txt
 create mode 100644 core/words/inlined/inlined.factor

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index ca566db9ea..867d2adc35 100644
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -12,7 +12,8 @@ interpolate io.pathnames kernel lexer locals.errors
 locals.parser locals.types macros math memoize multiline
 namespaces parser quotations sbufs sequences slots source-files
 splitting stack-checker strings strings.parser typed vectors
-vocabs.parser words words.alias words.constant words.symbol ;
+vocabs.parser words words.alias words.constant words.symbol
+words.inlined ;
 IN: bootstrap.syntax
 
 ! These words are defined as a top-level form, instead of with
@@ -175,7 +176,7 @@ IN: bootstrap.syntax
     ] define-core-syntax
 
     ":" [
-        (:) define-declared
+        (:) apply-inlined-effects define-declared
     ] define-core-syntax
 
     "GENERIC:" [
@@ -306,17 +307,17 @@ IN: bootstrap.syntax
 
     "IH{" [ \ } [ >identity-hashtable ] parse-literal ] define-core-syntax
 
-    "::" [ (::) define-declared ] define-core-syntax
+    "::" [ (::) apply-inlined-effects define-declared ] define-core-syntax
     "M::" [ (M::) define ] define-core-syntax
-    "MACRO:" [ (:) define-macro ] define-core-syntax
-    "MACRO::" [ (::) define-macro ] define-core-syntax
-    "TYPED:" [ (:) define-typed ] define-core-syntax
-    "TYPED::" [ (::) define-typed ] define-core-syntax
-    "MEMO:" [ (:) define-memoized ] define-core-syntax
-    "MEMO::" [ (::) define-memoized ] define-core-syntax
+    "MACRO:" [ (:) apply-inlined-effects define-macro ] define-core-syntax
+    "MACRO::" [ (::) apply-inlined-effects define-macro ] define-core-syntax
+    "TYPED:" [ (:) apply-inlined-effects define-typed ] define-core-syntax
+    "TYPED::" [ (::) apply-inlined-effects define-typed ] define-core-syntax
+    "MEMO:" [ (:) apply-inlined-effects define-memoized ] define-core-syntax
+    "MEMO::" [ (::) apply-inlined-effects define-memoized ] define-core-syntax
     "MEMO[" [ parse-quotation dup infer memoize-quot suffix! ] define-core-syntax
-    "IDENTITY-MEMO:" [ (:) define-identity-memoized ] define-core-syntax
-    "IDENTITY-MEMO::" [ (::) define-identity-memoized ] define-core-syntax
+    "IDENTITY-MEMO:" [ (:) apply-inlined-effects define-identity-memoized ] define-core-syntax
+    "IDENTITY-MEMO::" [ (::) apply-inlined-effects define-identity-memoized ] define-core-syntax
 
     "'[" [ parse-quotation fry append! ] define-core-syntax
 
diff --git a/core/words/inlined/authors.txt b/core/words/inlined/authors.txt
new file mode 100644
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/core/words/inlined/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/core/words/inlined/inlined.factor b/core/words/inlined/inlined.factor
new file mode 100644
index 0000000000..25adcdcf81
--- /dev/null
+++ b/core/words/inlined/inlined.factor
@@ -0,0 +1,23 @@
+! Copyright (C) 2017 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators combinators.short-circuit
+kernel math quotations sequences ;
+IN: words.inlined
+
+: inline-quotation? ( obj -- ? )
+    {
+        [ dup array? [ length>> 2 >= ] [ drop f ] if ]
+        [ second quotation? ]
+    } 1&& ;
+
+: effect>inline-quotations ( effect -- quot/f )
+    in>>
+    [ dup inline-quotation? [ last ] [ drop [ ] ] if ] map
+    dup [ length 0 > ] any? [ '[ _ spread ] ] [ drop f ] if ;
+
+: apply-inlined-effects ( def effect -- def effect )
+    dup effect>inline-quotations dup [
+        swap [ prepose ] dip
+    ] [
+        drop
+    ] if ;