* interp/compiler.boot (compTopLevel): Initialize list of

	optimizable domain constructors.
	(processInlineRequest): New.
	* interp/define.boot (spadCompileOrSetq): Tidy.
	(mutateToNothing): New.
	(doIt): Use it.  Add support for inline directives.
	* interp/fnewmeta.lisp (PARSE-Inline): New.
	* interp/metalex.lisp (KEYWORDS): Include 'inline'.

7 files changed, 61 insertions, 11 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 0a6ffee6..f7804a76 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2009-03-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/compiler.boot (compTopLevel): Initialize list of
+	optimizable domain constructors.
+	(processInlineRequest): New.
+	* interp/define.boot (spadCompileOrSetq): Tidy.
+	(mutateToNothing): New.
+	(doIt): Use it.  Add support for inline directives.
+	* interp/fnewmeta.lisp (PARSE-Inline): New.
+	* interp/metalex.lisp (KEYWORDS): Include 'inline'.
+
 2009-02-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/nruncomp.boot (genDeltaEntry): Return optimized
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index ae68d089..7f903248 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -93,10 +93,12 @@ $compileOnlyCertainItems := []
 
 compTopLevel: (%Form,%Mode,%Env) -> %Maybe %Triple
 compTopLevel(x,m,e) ==
---+ signals that target is derived from lhs-- see NRTmakeSlot1Info
+  -- signals that target is derived from lhs-- see NRTmakeSlot1Info
   $NRTderivedTargetIfTrue: local := false
   $killOptimizeIfTrue: local:= false
   $forceAdd: local:= false
+  -- start with a base list of domains we may inline.
+  $optimizableConstructorNames: local := $SystemInlinableConstructorNames
   x is ["DEF",:.] or x is ["where",["DEF",:.],:.] =>
     ([val,mode,.]:= compOrCroak(x,m,e); [val,mode,e])
         --keep old environment after top level function defs
@@ -829,7 +831,7 @@ setqSingle(id,val,m,E) ==
     addBinding(id,newProplist,e')
   if isDomainForm(val,e') then
     if isDomainInScope(id,e') then
-      stackWarning("domain valued variable %1b has been reassigned within its scope",[id])
+      stackWarning('"domain valued variable %1b has been reassigned within its scope",[id])
     e':= augModemapsFromDomain1(id,val,e')
       --all we do now is to allocate a slot number for lhs
       --e.g. the %LET form below will be changed by putInLocalDomainReferences
@@ -1911,6 +1913,27 @@ compMatch(["%Match",subject,altBlock],m,e) ==
 
 
 --%
+--% Inline Requests
+--%
+
+++ We are processing a capsule and `t is nominated in an inline
+++ directive.  This means that the compiler can `bypass' the usual 
+++ indirect call through domain interface and attempt to resolve
+++ modemap references.  
+++ Concretely, this means that `t is evaluated.
+processInlineRequest(t,e) ==
+  T := compOrCroak(t,$EmptyMode,e)
+  not isCategoryForm(T.mode,e) =>
+    stackAndThrow('"%1b does not designate a domain",[t])
+  atom T.expr =>
+    stackWarning('"inline request for type variable %1bp is meaningless",[t])
+  T.expr is [ctor] =>
+    $optimizableConstructorNames := [ctor,:$optimizableConstructorNames]
+  -- Don't try too hard; the current domain evaluation is insane.
+  stackWarning('"Ignoring inline arequest for non-niladic type %1bp",[t])
+
+
+--%
 --% ITERATORS
 --%
  
diff --git a/src/interp/define.boot b/src/interp/define.boot
index c3173e82..6a2aecbb 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1287,10 +1287,9 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) ==
            LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ macform]
            sayBrightly ['"     ",:bright nam,'"is replaced by",:bright body]
 
-  if GET(nam,"SPADreplace") then
-    form := [nam,[lam,vl,["DECLARE",["IGNORE",E]],body]]
-  else
-    form := [nam,[lam,vl,body]]
+  form := 
+    GET(nam,"SPADreplace") => [nam,[lam,vl,["DECLARE",["IGNORE",E]],body]]
+    [nam,[lam,vl,body]]
 
   $insideCapsuleFunctionIfTrue => 
     $optExportedFunctionReference =>
@@ -1439,6 +1438,12 @@ compSingleCapsuleItem(item,$predl,$e) ==
   doIt(macroExpandInPlace(item,$e),$predl)
   $e
  
+
+++ subroutine of doIt.  Called to generate runtime noop insn.
+mutateToNothing item ==
+  RPLACA(item,'PROGN)
+  RPLACD(item,NIL)
+
 doIt(item,$predl) ==
   $GENNO: local:= 0
   item is ['SEQ,:l,['exit,1,x]] =>
@@ -1483,8 +1488,10 @@ doIt(item,$predl) ==
      for dom in doms repeat
        sayBrightly ['"   importing ",:formatUnabbreviated dom]
      [.,.,$e] := compOrCroak(item,$EmptyMode,$e)
-     RPLACA(item,'PROGN)
-     RPLACD(item,NIL) -- creates a no-op
+     mutateToNothing item
+  item is ["%Inline",type] =>
+    processInlineRequest(type,$e)
+    mutateToNothing item
   item is ["IF",:.] => doItIf(item,$predl,$e)
   item is ["where",b,:l] => compOrCroak(item,$EmptyMode,$e)
   item is ["MDEF",:.] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e)
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index fd15745d..9867963c 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2009, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -454,6 +454,14 @@
            (CONS '|import|
                  (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))))) 
 
+;; domain inlining.  Same syntax as import directive; except
+;; deliberate restriction on naming one type at a time.
+;; -- gdr, 2009-02-28.
+(DEFUN |PARSE-Inline| ()
+  (AND (MATCH-ADVANCE-STRING "inline")
+       (MUST (|PARSE-Expr| 1000))
+       (PUSH-REDUCTION '|PARSE-Inline|
+           (CONS '|%Inline| (CONS (POP-STACK-1) NIL)))))
 
 (DEFUN |PARSE-Infix| ()
   (AND (PUSH-REDUCTION '|PARSE-Infix| (CURRENT-SYMBOL))
diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp
index 5a4d718d..aebd2aaa 100644
--- a/src/interp/metalex.lisp
+++ b/src/interp/metalex.lisp
@@ -575,7 +575,7 @@ empty (if File-Closed (return nil))
     |has| |with| |add| |case| |in| |by| |pretend| |mod|
     |exquo| |div| |quo| |else| |rem| |then| |suchthat|
     |if| |yield| |iterate| |from| |exit| |leave| |return|
-    |not| |unless| |repeat| |until| |while| |for| |import|)
+    |not| |unless| |repeat| |until| |while| |for| |import| |inline|)
 
 "Alphabetic literal strings occurring in the New Meta code constitute
 keywords.   These are recognized specifically by the AnyId production,
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index c0027b68..3d328de7 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -134,6 +134,7 @@
           (|until| 130 190 (|PARSE-Loop|))
           (|repeat| 130 190 (|PARSE-Loop|))
           (|import| 120 0 (|PARSE-Import|) )
+          (|inline| 120 0 (|PARSE-Inline|) )
           (|unless|)
           (|add| 900 120)
           (|with| 1000 300 (|PARSE-With|))
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index e3372db5..32105963 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -553,7 +553,7 @@ $SpecialDomainNames ==
     SubDomain)
 
 
-$optimizableConstructorNames ==
+$SystemInlinableConstructorNames ==
   '(List               _
     Integer            _ 
     PositiveInteger    _