From 89a2d8163cb83cfcfe8cfb64bddb2addbf1840be Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Mon, 5 Jul 2010 07:48:13 +0000
Subject: 	* interp/compiler.boot (compTopLevel): Bind $whereDecls. 
 (recordDeclarationInSideCondition): New.  Update it. 	(compWhere): Call it. 
 * interp/define.boot ($whereDecls): Define at toplevel. 
 (typeDependencyPath): New. 	(inferConstructorImplicitParameters):
 Likewise. 	(compDefineFunctor1): Use it.

---
 src/interp/compiler.boot | 20 ++++++++++++++++++--
 src/interp/define.boot   | 25 ++++++++++++++++++++++++-
 2 files changed, 42 insertions(+), 3 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 44f9c6bf..77212ee9 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -100,7 +100,8 @@ compTopLevel(x,m,e) ==
   $NRTderivedTargetIfTrue: local := false
   $killOptimizeIfTrue: local:= false
   $forceAdd: local:= false
-  -- start with a base list of domains we may inline.
+  $whereDecls: local := nil
+  -- start with a base list of domains we may want to inline.
   $optimizableConstructorNames: local := $SystemInlinableConstructorNames
   x is ["DEF",:.] or x is ["where",["DEF",:.],:.] =>
     ([val,mode,.]:= compOrCroak(x,m,e); [val,mode,e])
@@ -918,13 +919,28 @@ compileQuasiquote(["[||]",:form],m,e) ==
 
 
 --% WHERE
+
+++ The form `item' appears in a side condition of a where-expression.
+++ Register all declarations it locally introduces.
+recordDeclarationInSideCondition(item,e) ==
+  item is [":",x,t] =>
+    t := macroExpand(t,e)
+    IDENTP x => $whereDecls := [[x,t],:$whereDecls]
+    x is ['%Comma,:.] =>
+      $whereDecls := [:[[x',t] for x' in x.args],:$whereDecls]
+  item is ['SEQ,:stmts,["exit",.,val]] =>
+    for stmt in stmts repeat
+      recordDeclarationInSideCondition(stmt,e)
+    recordDeclarationInSideCondition(val,e)
+
 compWhere: (%Form,%Mode,%Env) -> %Maybe %Triple
 compWhere([.,form,:exprList],m,eInit) ==
   $insideExpressionIfTrue: local:= false
-  $insideWhereIfTrue: local:= true
+  $insideWhereIfTrue: local := true
   e := eInit
   u :=
     for item in exprList repeat
+      recordDeclarationInSideCondition(item,e)
       [.,.,e]:= comp(item,$EmptyMode,e) or return "failed"
   u="failed" => return nil
   $insideWhereIfTrue := false
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 748b4a13..bf90b572 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -103,6 +103,8 @@ $lisplibSuperDomain := nil
 $sigList := []
 $atList := []
 
+++ List of declarations appearing as side conditions of a where-expression.
+$whereDecls := nil
 
 ++ True if the current functor definition refines a domain.
 $subdomain := false
@@ -581,6 +583,26 @@ predicatesFromAttributes: %List -> %List
 predicatesFromAttributes attrList ==
   removeDuplicates [second x for x in attrList]
 
+++ Subroutine of inferConstructorImplicitParameters.
+typeDependencyPath(m,path,e) ==
+  IDENTP m and assoc(m,$whereDecls) =>
+    get(m,'value,e) => nil  -- parameter was given value
+    [[m,:reverse path],:typeDependencyPath(getmode(m,e),path,e)]
+  isAtomicForm m => nil
+  [ctor,:args] := m
+  -- We don't expect implicit parameters in builtin constructors.
+  ctor in $BuiltinConstructorNames => nil
+  -- FIXME: assume constructors cannot be parameters
+  not constructor? ctor => nil
+  [:typeDependencyPath(m',[i,:path],e) for m' in args for i in 0..]
+
+++ Given the list `parms' of explicit constructor parameters, compute
+++ a list of pairs `(p . path)' where `p' is a parameter implicitly
+++ introduced (either directly or indirectly) by a declaration of
+++ one of the explicit parameters.
+inferConstructorImplicitParameters(parms,e) ==
+  removeDuplicates
+    [:typeDependencyPath(getmode(p,e),[i],e) for p in parms for i in 0..]
  
 compDefineFunctor(df,m,e,prefix,fal) ==
   $domainShell: local := nil -- holds the category of the object being compiled
@@ -628,7 +650,8 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
     $functorKind: local :=
       $functorTarget is ["CATEGORY",key,:.] => key
       "domain"
-    $e:= giveFormalParametersValues(argl,$e)
+    $e := giveFormalParametersValues(argl,$e)
+    $implicitParameters: local := inferConstructorImplicitParameters(argl,$e)
     [ds,.,$e]:= compMakeCategoryObject(target,$e) or return
        stackAndThrow('"   cannot produce category object: %1pb",[target])
     $compileExportsOnly => compDefineExports(form, ds.1, signature',$e)
-- 
cgit v1.2.3