* boot/tokens.boot: "@" is now a new keyword.

	* boot/ast.boot (bfRestrict): New.
	(bpTyped): Rename from bpTagged.  Accept type restriction.
	* boot/utility.boot (drop): Restrict the result to a %List.

9 files changed, 97 insertions, 68 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 3ede6c74..9adb8f94 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
 2012-05-23  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* boot/tokens.boot: "@" is now a new keyword.
+	* boot/ast.boot (bfRestrict): New.
+	(bpTyped): Rename from bpTagged.  Accept type restriction.
+	* boot/utility.boot (drop): Restrict the result to a %List.
+
+2012-05-23  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/database.boot (%Constructor): New.
 	(makeConstructor): Likewise.
 	(makeInitialDB): Tidy.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 54d9b7ed..3d21b6f7 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -74,6 +74,7 @@ structure %Ast ==
   %EqualPattern(%Ast)                   -- =x        -- patterns
   %Colon(%Symbol)                       -- :x
   %QualifiedName(%Symbol,%Symbol)       -- m::x
+  %Restrict(%Ast,%Ast)                  -- x@t
   %DefaultValue(%Symbol,%Ast)           -- opt. value for function param.
   %Key(%Symbol,%Ast)                    -- k <- x
   %Bracket(%Ast)                        -- [x, y]
@@ -1146,6 +1147,9 @@ bfTagged(a,b)==
     a
   ["THE",b,a]
  
+bfRestrict(x,t) ==
+  ["THE",t,x]
+
 bfAssign(l,r)==
   bfTupleP l => bfSetelt(second l,CDDR l ,r)
   l is ["%Place",:l'] => ["SETF",l',r]
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 414f21ca..a830a7d9 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -626,14 +626,20 @@ bpTyping() ==
     bpPush %Forall(bpPop2(), bpPop1())
   bpMapping() or bpSimpleMapping()
 
-++ Tagged:
-++   Name : Typing
-bpTagged()==
+++ Typed:
+++   Application : Typing
+++   Application @ Typing
+bpTyped()==
   bpApplication() and
-     (bpEqKey "COLON" and bpRequire function bpTyping and
-       bpPush bfTagged(bpPop2(),bpPop1()) or true)
+     bpEqKey "COLON" =>
+       bpRequire function bpTyping and
+         bpPush bfTagged(bpPop2(),bpPop1())
+     bpEqKey "AT" =>
+       bpRequire function bpTyping and
+         bpPush bfRestrict(bpPop2(), bpPop1())
+     true
  
-bpExpt()== bpRightAssoc('(POWER),function bpTagged)
+bpExpt()== bpRightAssoc('(POWER),function bpTyped)
  
 bpInfKey s ==
   tokenClass $stok = "KEY" and
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 89380ea0..249192fa 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -55,91 +55,93 @@
 (DEFUN |%QualifiedName| #1=(|bfVar#27| |bfVar#28|)
   (CONS '|%QualifiedName| (LIST . #1#)))
 
-(DEFUN |%DefaultValue| #1=(|bfVar#29| |bfVar#30|)
+(DEFUN |%Restrict| #1=(|bfVar#29| |bfVar#30|) (CONS '|%Restrict| (LIST . #1#)))
+
+(DEFUN |%DefaultValue| #1=(|bfVar#31| |bfVar#32|)
   (CONS '|%DefaultValue| (LIST . #1#)))
 
-(DEFUN |%Key| #1=(|bfVar#31| |bfVar#32|) (CONS '|%Key| (LIST . #1#)))
+(DEFUN |%Key| #1=(|bfVar#33| |bfVar#34|) (CONS '|%Key| (LIST . #1#)))
 
-(DEFUN |%Bracket| #1=(|bfVar#33|) (CONS '|%Bracket| (LIST . #1#)))
+(DEFUN |%Bracket| #1=(|bfVar#35|) (CONS '|%Bracket| (LIST . #1#)))
 
-(DEFUN |%UnboundedSegment| #1=(|bfVar#34|)
+(DEFUN |%UnboundedSegment| #1=(|bfVar#36|)
   (CONS '|%UnboundedSegment| (LIST . #1#)))
 
-(DEFUN |%BoundedSgement| #1=(|bfVar#35| |bfVar#36|)
+(DEFUN |%BoundedSgement| #1=(|bfVar#37| |bfVar#38|)
   (CONS '|%BoundedSgement| (LIST . #1#)))
 
-(DEFUN |%Tuple| #1=(|bfVar#37|) (CONS '|%Tuple| (LIST . #1#)))
+(DEFUN |%Tuple| #1=(|bfVar#39|) (CONS '|%Tuple| (LIST . #1#)))
 
-(DEFUN |%ColonAppend| #1=(|bfVar#38| |bfVar#39|)
+(DEFUN |%ColonAppend| #1=(|bfVar#40| |bfVar#41|)
   (CONS '|%ColonAppend| (LIST . #1#)))
 
-(DEFUN |%Pretend| #1=(|bfVar#40| |bfVar#41|) (CONS '|%Pretend| (LIST . #1#)))
+(DEFUN |%Pretend| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Pretend| (LIST . #1#)))
 
-(DEFUN |%Is| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Is| (LIST . #1#)))
+(DEFUN |%Is| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Is| (LIST . #1#)))
 
-(DEFUN |%Isnt| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Isnt| (LIST . #1#)))
+(DEFUN |%Isnt| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Isnt| (LIST . #1#)))
 
-(DEFUN |%Reduce| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Reduce| (LIST . #1#)))
+(DEFUN |%Reduce| #1=(|bfVar#48| |bfVar#49|) (CONS '|%Reduce| (LIST . #1#)))
 
-(DEFUN |%PrefixExpr| #1=(|bfVar#48| |bfVar#49|)
+(DEFUN |%PrefixExpr| #1=(|bfVar#50| |bfVar#51|)
   (CONS '|%PrefixExpr| (LIST . #1#)))
 
-(DEFUN |%Call| #1=(|bfVar#50| |bfVar#51|) (CONS '|%Call| (LIST . #1#)))
+(DEFUN |%Call| #1=(|bfVar#52| |bfVar#53|) (CONS '|%Call| (LIST . #1#)))
 
-(DEFUN |%InfixExpr| #1=(|bfVar#52| |bfVar#53| |bfVar#54|)
+(DEFUN |%InfixExpr| #1=(|bfVar#54| |bfVar#55| |bfVar#56|)
   (CONS '|%InfixExpr| (LIST . #1#)))
 
-(DEFUN |%ConstantDefinition| #1=(|bfVar#55| |bfVar#56|)
+(DEFUN |%ConstantDefinition| #1=(|bfVar#57| |bfVar#58|)
   (CONS '|%ConstantDefinition| (LIST . #1#)))
 
-(DEFUN |%Definition| #1=(|bfVar#57| |bfVar#58| |bfVar#59|)
+(DEFUN |%Definition| #1=(|bfVar#59| |bfVar#60| |bfVar#61|)
   (CONS '|%Definition| (LIST . #1#)))
 
-(DEFUN |%Macro| #1=(|bfVar#60| |bfVar#61| |bfVar#62|)
+(DEFUN |%Macro| #1=(|bfVar#62| |bfVar#63| |bfVar#64|)
   (CONS '|%Macro| (LIST . #1#)))
 
-(DEFUN |%Lambda| #1=(|bfVar#63| |bfVar#64|) (CONS '|%Lambda| (LIST . #1#)))
+(DEFUN |%Lambda| #1=(|bfVar#65| |bfVar#66|) (CONS '|%Lambda| (LIST . #1#)))
 
-(DEFUN |%SuchThat| #1=(|bfVar#65|) (CONS '|%SuchThat| (LIST . #1#)))
+(DEFUN |%SuchThat| #1=(|bfVar#67|) (CONS '|%SuchThat| (LIST . #1#)))
 
-(DEFUN |%Assignment| #1=(|bfVar#66| |bfVar#67|)
+(DEFUN |%Assignment| #1=(|bfVar#68| |bfVar#69|)
   (CONS '|%Assignment| (LIST . #1#)))
 
-(DEFUN |%While| #1=(|bfVar#68|) (CONS '|%While| (LIST . #1#)))
+(DEFUN |%While| #1=(|bfVar#70|) (CONS '|%While| (LIST . #1#)))
 
-(DEFUN |%Until| #1=(|bfVar#69|) (CONS '|%Until| (LIST . #1#)))
+(DEFUN |%Until| #1=(|bfVar#71|) (CONS '|%Until| (LIST . #1#)))
 
-(DEFUN |%For| #1=(|bfVar#70| |bfVar#71| |bfVar#72|) (CONS '|%For| (LIST . #1#)))
+(DEFUN |%For| #1=(|bfVar#72| |bfVar#73| |bfVar#74|) (CONS '|%For| (LIST . #1#)))
 
-(DEFUN |%Implies| #1=(|bfVar#73| |bfVar#74|) (CONS '|%Implies| (LIST . #1#)))
+(DEFUN |%Implies| #1=(|bfVar#75| |bfVar#76|) (CONS '|%Implies| (LIST . #1#)))
 
-(DEFUN |%Iterators| #1=(|bfVar#75|) (CONS '|%Iterators| (LIST . #1#)))
+(DEFUN |%Iterators| #1=(|bfVar#77|) (CONS '|%Iterators| (LIST . #1#)))
 
-(DEFUN |%Cross| #1=(|bfVar#76|) (CONS '|%Cross| (LIST . #1#)))
+(DEFUN |%Cross| #1=(|bfVar#78|) (CONS '|%Cross| (LIST . #1#)))
 
-(DEFUN |%Repeat| #1=(|bfVar#77| |bfVar#78|) (CONS '|%Repeat| (LIST . #1#)))
+(DEFUN |%Repeat| #1=(|bfVar#79| |bfVar#80|) (CONS '|%Repeat| (LIST . #1#)))
 
-(DEFUN |%Pile| #1=(|bfVar#79|) (CONS '|%Pile| (LIST . #1#)))
+(DEFUN |%Pile| #1=(|bfVar#81|) (CONS '|%Pile| (LIST . #1#)))
 
-(DEFUN |%Append| #1=(|bfVar#80|) (CONS '|%Append| (LIST . #1#)))
+(DEFUN |%Append| #1=(|bfVar#82|) (CONS '|%Append| (LIST . #1#)))
 
-(DEFUN |%Case| #1=(|bfVar#81| |bfVar#82|) (CONS '|%Case| (LIST . #1#)))
+(DEFUN |%Case| #1=(|bfVar#83| |bfVar#84|) (CONS '|%Case| (LIST . #1#)))
 
-(DEFUN |%Return| #1=(|bfVar#83|) (CONS '|%Return| (LIST . #1#)))
+(DEFUN |%Return| #1=(|bfVar#85|) (CONS '|%Return| (LIST . #1#)))
 
-(DEFUN |%Leave| #1=(|bfVar#84|) (CONS '|%Leave| (LIST . #1#)))
+(DEFUN |%Leave| #1=(|bfVar#86|) (CONS '|%Leave| (LIST . #1#)))
 
-(DEFUN |%Throw| #1=(|bfVar#85|) (CONS '|%Throw| (LIST . #1#)))
+(DEFUN |%Throw| #1=(|bfVar#87|) (CONS '|%Throw| (LIST . #1#)))
 
-(DEFUN |%Catch| #1=(|bfVar#86| |bfVar#87|) (CONS '|%Catch| (LIST . #1#)))
+(DEFUN |%Catch| #1=(|bfVar#88| |bfVar#89|) (CONS '|%Catch| (LIST . #1#)))
 
-(DEFUN |%Finally| #1=(|bfVar#88|) (CONS '|%Finally| (LIST . #1#)))
+(DEFUN |%Finally| #1=(|bfVar#90|) (CONS '|%Finally| (LIST . #1#)))
 
-(DEFUN |%Try| #1=(|bfVar#89| |bfVar#90|) (CONS '|%Try| (LIST . #1#)))
+(DEFUN |%Try| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Try| (LIST . #1#)))
 
-(DEFUN |%Where| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Where| (LIST . #1#)))
+(DEFUN |%Where| #1=(|bfVar#93| |bfVar#94|) (CONS '|%Where| (LIST . #1#)))
 
-(DEFUN |%Structure| #1=(|bfVar#93| |bfVar#94|)
+(DEFUN |%Structure| #1=(|bfVar#95| |bfVar#96|)
   (CONS '|%Structure| (LIST . #1#)))
 
 (DEFPARAMETER |$inDefIS| NIL)
@@ -2075,6 +2077,8 @@
                 |a|)))
         (T (LIST 'THE |b| |a|))))
 
+(DEFUN |bfRestrict| (|x| |t|) (LIST 'THE |t| |x|))
+
 (DEFUN |bfAssign| (|l| |r|)
   (LET* (|l'|)
     (COND ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 53eb4f53..e4862eb5 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -585,14 +585,18 @@
     (|bpPush| (|%Forall| (|bpPop2|) (|bpPop1|))))
    (T (OR (|bpMapping|) (|bpSimpleMapping|)))))
 
-(DEFUN |bpTagged| ()
+(DEFUN |bpTyped| ()
   (AND (|bpApplication|)
-       (OR
-        (AND (|bpEqKey| 'COLON) (|bpRequire| #'|bpTyping|)
-             (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
-        T)))
+       (COND
+        ((|bpEqKey| 'COLON)
+         (AND (|bpRequire| #'|bpTyping|)
+              (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|)))))
+        ((|bpEqKey| 'AT)
+         (AND (|bpRequire| #'|bpTyping|)
+              (|bpPush| (|bfRestrict| (|bpPop2|) (|bpPop1|)))))
+        (T T))))
 
-(DEFUN |bpExpt| () (|bpRightAssoc| '(POWER) #'|bpTagged|))
+(DEFUN |bpExpt| () (|bpRightAssoc| '(POWER) #'|bpTyped|))
 
 (DEFUN |bpInfKey| (|s|)
   (DECLARE (SPECIAL |$ttok| |$stok|))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index abb77212..34e00c36 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -54,15 +54,16 @@
         (LIST "then" 'THEN) (LIST "throw" 'THROW) (LIST "try" 'TRY)
         (LIST "until" 'UNTIL) (LIST "with" 'WITH) (LIST "where" 'WHERE)
         (LIST "while" 'WHILE) (LIST "." 'DOT) (LIST ":" 'COLON)
-        (LIST "::" 'COLON-COLON) (LIST "," 'COMMA) (LIST ";" 'SEMICOLON)
-        (LIST "*" 'TIMES) (LIST "**" 'POWER) (LIST "/" 'SLASH) (LIST "+" 'PLUS)
-        (LIST "-" 'MINUS) (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE)
-        (LIST ">=" 'GE) (LIST "=" 'SHOEEQ) (LIST "~=" 'SHOENE) (LIST ".." 'SEG)
-        (LIST "#" 'LENGTH) (LIST "=>" 'EXIT) (LIST "->" 'ARROW)
-        (LIST "<-" 'LARROW) (LIST ":=" 'BEC) (LIST "+->" 'GIVES)
-        (LIST "==" 'DEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN)
-        (LIST ")" 'CPAREN) (LIST "[" 'OBRACK) (LIST "]" 'CBRACK)
-        (LIST "'" 'QUOTE) (LIST "|" 'BAR)))
+        (LIST "::" 'COLON-COLON) (LIST "@" 'AT) (LIST "," 'COMMA)
+        (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES) (LIST "**" 'POWER)
+        (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS) (LIST "<" 'LT)
+        (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE) (LIST "=" 'SHOEEQ)
+        (LIST "~=" 'SHOENE) (LIST ".." 'SEG) (LIST "#" 'LENGTH)
+        (LIST "=>" 'EXIT) (LIST "->" 'ARROW) (LIST "<-" 'LARROW)
+        (LIST ":=" 'BEC) (LIST "+->" 'GIVES) (LIST "==" 'DEF)
+        (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) (LIST ")" 'CPAREN)
+        (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) (LIST "'" 'QUOTE)
+        (LIST "|" 'BAR)))
 
 (DEFUN |shoeKeyTableCons| ()
   (LET* (|KeyTable|)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 80244b61..4de1d345 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -165,12 +165,15 @@
 (DEFUN |drop| (|n| |l|)
   (COND
    ((NOT (MINUSP |n|))
-    (LOOP
-     (COND
-      ((NOT (AND (PLUSP |n|) (CONSP |l|) (PROGN (SETQ |l| (CDR |l|)) T)))
-       (RETURN NIL))
-      (T (SETQ |n| (- |n| 1)))))
-    |l|)
+    (LET ((|bfVar#1| 1))
+      (LOOP
+       (COND
+        ((OR (> |bfVar#1| |n|)
+             (NOT (AND (CONSP |l|) (PROGN (SETQ |l| (CDR |l|)) T))))
+         (RETURN NIL))
+        (T NIL))
+       (SETQ |bfVar#1| (+ |bfVar#1| 1))))
+    (THE (|%List| |%Thing|) |l|))
    (T (|take| (+ (LENGTH |l|) |n|) |l|))))
 
 (DEFUN |copyTree| (|t|)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index ac4d665a..7b0c786f 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -110,6 +110,7 @@ shoeKeyWords == [  _
             ['".", "DOT"], _
             ['":", "COLON"], _
             ['"::", "COLON-COLON"], _
+            ['"@",  "AT" ], _
             ['",", "COMMA"], _
             ['";", "SEMICOLON"], _
             ['"*", "TIMES"], _
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 294f9d71..42bbbf00 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -107,9 +107,8 @@ takeWhile(f,l) ==
 ++ If `n' is negative, drop from the end.
 drop(n,l) ==
   n >= 0 =>
-    while n > 0 and l is [.,:l] repeat
-      n := n - 1
-    l
+    for . in 1..n while l is [.,:l] repeat nil
+    l@%List(%Thing)
   take(#l+n,l)
 
 copyTree t ==