From e8fa0a31f5e1ec2f3269cd2cd5cd18a78fd60a4a Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 18 Nov 2008 18:03:21 +0000
Subject: 	* interp/nrunfast.boot (resolveNiladicConstructors): New. 
 (newHasTest): Use it to handle signature export test. 	*
 testsuite/interpreter/has.input: New.

---
 src/interp/nrunfast.boot | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

(limited to 'src/interp')

diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 2f419f37..b7ee04da 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -591,6 +591,19 @@ lazyDomainSet(lazyForm,thisDomain,slot) ==
   name := CAR form
   setShellEntry(thisDomain,slot,slotDomain)
  
+
+++ `type' is a type form constructed by the new parser.
+++ Return a type form where all niladic constructors are
+++ resolved to constructor calls.  Note: it is assumed that no
+++ such resolution has already occured.
+resolveNiladicConstructors type ==
+  atom type => 
+    IDENTP type and niladicConstructorFromDB type => [type]
+    type
+  for args in tails rest type repeat
+    rplac(first args, resolveNiladicConstructors first args)
+  type
+
 --=======================================================
 --                   HasCategory/Attribute
 --=======================================================
@@ -637,6 +650,15 @@ newHasTest(domform,catOrAtt) ==
   null isAtom and constructor? op  =>
     domain := eval mkEvalable domform
     newHasCategory(domain,catOrAtt)
+  catOrAtt is [":",op,type] =>
+    sig := 
+      type is ["Mapping",:sig'] =>
+         for ts in tails sig' repeat
+           rplac(first ts, resolveNiladicConstructors first ts)
+         sig'
+      -- a constant; make it look like op: () -> type
+      [resolveNiladicConstructors type]
+    HasSignature(evalDomain domform, [op,sig])
   newHasAttribute(eval mkEvalable domform,catOrAtt)
  
 lazyMatchAssocV(x,auxvec,catvec,domain) ==      --new style slot4
-- 
cgit v1.2.3