From 2227d0b0e896b63b8f27ff3ba8b9fc74495a8acb Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 19 Oct 2011 20:57:45 +0000
Subject: 	* interp/postpar.boot (postNormalizeName): New. 
 (postAtom): Use it. 	(postMDef): Do not generate artificial list of nils. 
 Leave left-hand-side as written in source code. 	* interp/compiler.boot
 (compMacro): Tidy. 	* interp/define.boot (checkRepresentation): Likewise. 
 * interp/parse.boot (parseMDEF): Likewise. 	* algebra/syntax.spad.pamphlet
 (MacroAst): Adjust.

---
 src/ChangeLog                     | 11 +++++++++++
 src/algebra/syntax.spad.pamphlet  |  5 ++++-
 src/interp/compiler.boot          | 11 ++++++-----
 src/interp/define.boot            |  2 +-
 src/interp/parse.boot             |  8 +++-----
 src/interp/postpar.boot           | 39 +++++++++++++++++++++++++--------------
 src/share/algebra/browse.daase    |  2 +-
 src/share/algebra/category.daase  |  2 +-
 src/share/algebra/compress.daase  |  2 +-
 src/share/algebra/interp.daase    |  4 ++--
 src/share/algebra/operation.daase |  2 +-
 11 files changed, 56 insertions(+), 32 deletions(-)

(limited to 'src')

diff --git a/src/ChangeLog b/src/ChangeLog
index b1c04f2e..2c93d014 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2011-10-19  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/postpar.boot (postNormalizeName): New.
+	(postAtom): Use it.
+	(postMDef): Do not generate artificial list of nils.
+	Leave left-hand-side as written in source code.
+	* interp/compiler.boot (compMacro): Tidy.
+	* interp/define.boot (checkRepresentation): Likewise.
+	* interp/parse.boot (parseMDEF): Likewise.
+	* algebra/syntax.spad.pamphlet (MacroAst): Adjust.
+
 2011-10-19  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/property.lisp: Move output-related content to i-output.boo.
diff --git a/src/algebra/syntax.spad.pamphlet b/src/algebra/syntax.spad.pamphlet
index a74815e1..3bbb7145 100644
--- a/src/algebra/syntax.spad.pamphlet
+++ b/src/algebra/syntax.spad.pamphlet
@@ -1671,7 +1671,10 @@ MacroAst(): Public == Private where
       ++ body(m) returns the right hand side of the definition `m'.
   Private == add
     Rep == List SpadAst
-    head x == (second rep x) : HeadAst
+    head x ==
+      z := second rep x
+      z case Identifier => [z] : HeadAst
+      z : HeadAst
     body x == last rep x
     coerce(x: %): OutputForm ==
      elt('MacroAst::OutputForm,
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 44dc7d4d..f2894cd6 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -995,7 +995,7 @@ $macroIfTrue := false
 
 compMacro(form,m,e) ==
   $macroIfTrue: local:= true
-  ["MDEF",lhs,signature,specialCases,rhs] := form
+  ["MDEF",lhs,signature,rhs] := form
   if $verbose then
     prhs :=
       rhs is ['CATEGORY,:.] => ['"-- the constructor category"]
@@ -1007,13 +1007,14 @@ compMacro(form,m,e) ==
       :formatUnabbreviated lhs,'" ==> ",:prhs,'"%d"]
   m=$EmptyMode or m=$NoValueMode =>
     -- Macro names shall be identifiers.
-    not ident? lhs.op =>
-      stackMessage('"invalid left-hand-side in macro definition",nil)
-      e
+    (lhs isnt [.,:.] and not ident? lhs)
+      or (lhs is [op,:.] and not ident? op) =>
+        stackMessage('"invalid left-hand-side in macro definition",nil)
+        e
     -- We do not have the means, at this late stage, to make a distinction
     -- between a niladic functional macro and an identifier that is
     -- defined as a macro.
-    if lhs.args = nil then lhs := lhs.op
+    if lhs is [op] then lhs := op
     ["/throwAway",$NoValueMode,putMacro(lhs,macroExpand(rhs,e),e)]
   nil
 
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 8c127081..5c09de68 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -740,7 +740,7 @@ checkRepresentation(addForm,body,env) ==
       else if addForm ~= nil then
         stackWarning('"%1b differs from the base domain",["Rep"])
       return hasAssignRep := true
-    stmt is ["MDEF",["Rep",:.],:.] =>
+    stmt is ["MDEF","Rep",:.] =>
       stackWarning('"Consider using == definition for %1b",["Rep"])
       return hasAssignRep := true
     stmt is ["IF",.,:l] or stmt is ["SEQ",:l] or stmt is ["exit",:l] =>
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index 2f9b94cc..a2934199 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -213,11 +213,9 @@ parseLhs x ==
 
 parseMDEF: %ParseForm -> %Form
 parseMDEF t ==
-  t isnt ["MDEF",$lhs,tList,specialList,body] => 
-    systemErrorHere ["parseMDEF",t]
-  ["MDEF",parseTran $lhs,parseTypeList tList,parseTranList specialList,
-    parseTranCheckForRecord(body,opOf $lhs)]
- 
+  t isnt ["MDEF",$lhs,tList,body] => systemErrorHere ["parseMDEF",t]
+  ["MDEF",$lhs,parseTypeList tList,parseTranCheckForRecord(body,opOf $lhs)]
+
 parseTranCheckForRecord: (%ParseForm,%ParseForm) -> %Form
 parseTranCheckForRecord(x,op) ==
   x := parseTran x
diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot
index e4148a8f..59b13294 100644
--- a/src/interp/postpar.boot
+++ b/src/interp/postpar.boot
@@ -162,14 +162,20 @@ postMakeCons l ==
     postTran a
   ["cons",postTran first l,postMakeCons rest l]
 
+postNormalizeName: %Symbol -> %Symbol
+postNormalizeName x ==
+  x = "T" => "T$" -- rename T in spad code to avoid clash with Lisp
+  x = "^" => "**" -- always use `**' internally for exponentiation
+  x
+
 postAtom: %Atom -> %ParseForm
 postAtom x ==
-  x=0 => $Zero
-  x=1 => $One
-  x='T => "T$" -- rename T in spad code to T$
-  ident? x and niladicConstructor? x => [x]
-  x="," => "%Comma"
-  x = "^" => "**"  -- always use `**' internally for exponentiation
+  x is 0 => $Zero
+  x is 1 => $One
+  x is "," => "%Comma"
+  ident? x =>
+    niladicConstructor? x => [x]
+    postNormalizeName x
   x
 
 postBlock: %ParseTree -> %ParseForm
@@ -245,21 +251,26 @@ postDefArgs argl ==
 postMDef: %ParseTree -> %ParseForm
 postMDef(t) ==
   [.,lhs,rhs] := t
-  lhs := postTran lhs
+  lhs :=
+    ident? lhs => postNormalizeName lhs
+    lhs is [.,:.] => [postNormalizeName x for x in lhs]
+    lhs
   [form,targetType]:=
-    lhs is [":",:.] => rest lhs
+    lhs is [":",:.] => lhs.args
     [lhs,nil]
-  form:=
-    form isnt [.,:.] => [form]
+  newLhs :=
+    form is [.,:.] => [(x is [":",a,:.] => a; x) for x in form]
     form
-  newLhs:= [(x is [":",a,:.] => a; x) for x in form]
-  typeList:= [targetType,:[(x is [":",.,t] => t; nil) for x in rest form]]
-  ["MDEF",newLhs,typeList,[nil for x in form],postTran rhs]
+  typeList :=
+    form is [.,:.] =>
+      [targetType,:[(x is [":",.,t] => t; nil) for x in rest form]]
+    nil
+  ["MDEF",newLhs,typeList,postTran rhs]
 
 postElt: %ParseTree -> %ParseForm
 postElt u ==
   u isnt [.,a,b] => systemErrorHere ["postElt",u]
-  a:= postTran a
+  a := postTran a
   b is ["%Sequence",:.] => [["elt",a,"makeRecord"],:postTranList rest b]
   ["elt",a,postTran b]
 
diff --git a/src/share/algebra/browse.daase b/src/share/algebra/browse.daase
index 8a8d280d..353527d1 100644
--- a/src/share/algebra/browse.daase
+++ b/src/share/algebra/browse.daase
@@ -1,5 +1,5 @@
 
-(2004998 . 3527958790)       
+(2004998 . 3528046424)       
 (-18 A S) 
 ((|constructor| (NIL "One-dimensional-array aggregates serves as models for one-dimensional arrays. Categorically,{} these aggregates are finite linear aggregates with the \\spadatt{shallowlyMutable} property,{} that is,{} any component of the array may be changed without affecting the identity of the overall array. Array data structures are typically represented by a fixed area in storage and therefore cannot efficiently grow or shrink on demand as can list structures (see however \\spadtype{FlexibleArray} for a data structure which is a cross between a list and an array). Iteration over,{} and access to,{} elements of arrays is extremely fast (and often can be optimized to open-code). Insertion and deletion however is generally slow since an entirely new data structure must be created for the result."))) 
 NIL 
diff --git a/src/share/algebra/category.daase b/src/share/algebra/category.daase
index 4ce6b2ef..f070e538 100644
--- a/src/share/algebra/category.daase
+++ b/src/share/algebra/category.daase
@@ -1,5 +1,5 @@
 
-(198618 . 3527958793)        
+(198618 . 3528046427)        
 ((((-765)) . T)) 
 ((((-765)) . T)) 
 ((((-765)) . T)) 
diff --git a/src/share/algebra/compress.daase b/src/share/algebra/compress.daase
index ebbeb1aa..db33a4cb 100644
--- a/src/share/algebra/compress.daase
+++ b/src/share/algebra/compress.daase
@@ -1,5 +1,5 @@
 
-(30 . 3527958789)            
+(30 . 3528046424)            
 (3982 |Enumeration| |Mapping| |Record| |Union| |ofCategory| |isDomain|
  ATTRIBUTE |package| |domain| |category| CATEGORY |nobranch| AND |Join|
  |ofType| SIGNATURE "failed" "algebra" |OneDimensionalArrayAggregate&|
diff --git a/src/share/algebra/interp.daase b/src/share/algebra/interp.daase
index 40a86ff1..8bc3dd88 100644
--- a/src/share/algebra/interp.daase
+++ b/src/share/algebra/interp.daase
@@ -1,5 +1,5 @@
 
-(2797332 . 3527958797)       
+(2797332 . 3528046432)       
 ((-1719 (((-83) (-1 (-83) |#2| |#2|) $) 86 T ELT) (((-83) $) NIL T ELT)) (-1717 (($ (-1 (-83) |#2| |#2|) $) 18 T ELT) (($ $) NIL T ELT)) (-3772 ((|#2| $ (-478) |#2|) NIL T ELT) ((|#2| $ (-1135 (-478)) |#2|) 44 T ELT)) (-2283 (($ $) 80 T ELT)) (-3826 ((|#2| (-1 |#2| |#2| |#2|) $ |#2| |#2|) 52 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $ |#2|) 50 T ELT) ((|#2| (-1 |#2| |#2| |#2|) $) 49 T ELT)) (-3403 (((-478) (-1 (-83) |#2|) $) 27 T ELT) (((-478) |#2| $) NIL T ELT) (((-478) |#2| $ (-478)) 96 T ELT)) (-2873 (((-578 |#2|) $) 13 T ELT)) (-3502 (($ (-1 (-83) |#2| |#2|) $ $) 64 T ELT) (($ $ $) NIL T ELT)) (-1936 (($ (-1 |#2| |#2|) $) 37 T ELT)) (-3942 (($ (-1 |#2| |#2|) $) NIL T ELT) (($ (-1 |#2| |#2| |#2|) $ $) 60 T ELT)) (-2290 (($ |#2| $ (-478)) NIL T ELT) (($ $ $ (-478)) 67 T ELT)) (-1341 (((-3 |#2| "failed") (-1 (-83) |#2|) $) 29 T ELT)) (-1934 (((-83) (-1 (-83) |#2|) $) 23 T ELT)) (-3784 ((|#2| $ (-478) |#2|) NIL T ELT) ((|#2| $ (-478)) NIL T ELT) (($ $ (-1135 (-478))) 66 T ELT)) (-2291 (($ $ (-478)) 76 T ELT) (($ $ (-1135 (-478))) 75 T ELT)) (-1933 (((-687) (-1 (-83) |#2|) $) 34 T ELT) (((-687) |#2| $) NIL T ELT)) (-1718 (($ $ $ (-478)) 69 T ELT)) (-3384 (($ $) 68 T ELT)) (-3514 (($ (-578 |#2|)) 73 T ELT)) (-3786 (($ $ |#2|) NIL T ELT) (($ |#2| $) NIL T ELT) (($ $ $) 87 T ELT) (($ (-578 $)) 85 T ELT)) (-3930 (((-765) $) 92 T ELT)) (-1935 (((-83) (-1 (-83) |#2|) $) 22 T ELT)) (-3040 (((-83) $ $) 95 T ELT)) (-2669 (((-83) $ $) 99 T ELT))) 
 (((-18 |#1| |#2|) (-10 -7 (-15 -3040 ((-83) |#1| |#1|)) (-15 -3930 ((-765) |#1|)) (-15 -2669 ((-83) |#1| |#1|)) (-15 -1717 (|#1| |#1|)) (-15 -1717 (|#1| (-1 (-83) |#2| |#2|) |#1|)) (-15 -2283 (|#1| |#1|)) (-15 -1718 (|#1| |#1| |#1| (-478))) (-15 -1719 ((-83) |#1|)) (-15 -3502 (|#1| |#1| |#1|)) (-15 -3403 ((-478) |#2| |#1| (-478))) (-15 -3403 ((-478) |#2| |#1|)) (-15 -3403 ((-478) (-1 (-83) |#2|) |#1|)) (-15 -1719 ((-83) (-1 (-83) |#2| |#2|) |#1|)) (-15 -3502 (|#1| (-1 (-83) |#2| |#2|) |#1| |#1|)) (-15 -3772 (|#2| |#1| (-1135 (-478)) |#2|)) (-15 -2290 (|#1| |#1| |#1| (-478))) (-15 -2290 (|#1| |#2| |#1| (-478))) (-15 -2291 (|#1| |#1| (-1135 (-478)))) (-15 -2291 (|#1| |#1| (-478))) (-15 -3942 (|#1| (-1 |#2| |#2| |#2|) |#1| |#1|)) (-15 -3786 (|#1| (-578 |#1|))) (-15 -3786 (|#1| |#1| |#1|)) (-15 -3786 (|#1| |#2| |#1|)) (-15 -3786 (|#1| |#1| |#2|)) (-15 -3784 (|#1| |#1| (-1135 (-478)))) (-15 -3514 (|#1| (-578 |#2|))) (-15 -1341 ((-3 |#2| "failed") (-1 (-83) |#2|) |#1|)) (-15 -3826 (|#2| (-1 |#2| |#2| |#2|) |#1|)) (-15 -3826 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2|)) (-15 -3826 (|#2| (-1 |#2| |#2| |#2|) |#1| |#2| |#2|)) (-15 -3784 (|#2| |#1| (-478))) (-15 -3784 (|#2| |#1| (-478) |#2|)) (-15 -3772 (|#2| |#1| (-478) |#2|)) (-15 -1933 ((-687) |#2| |#1|)) (-15 -2873 ((-578 |#2|) |#1|)) (-15 -1933 ((-687) (-1 (-83) |#2|) |#1|)) (-15 -1934 ((-83) (-1 (-83) |#2|) |#1|)) (-15 -1935 ((-83) (-1 (-83) |#2|) |#1|)) (-15 -1936 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -3942 (|#1| (-1 |#2| |#2|) |#1|)) (-15 -3384 (|#1| |#1|))) (-19 |#2|) (-1118)) (T -18)) 
 NIL 
@@ -2003,7 +2003,7 @@ NIL
 ((-3390 (*1 *1 *2 *1) (-12 (-5 *2 (-1 (-83) *3)) (-4 *1 (-611 *3)) (-4 *3 (-1118)))) (-3694 (*1 *1 *2 *1) (-12 (-5 *2 (-1 (-83) *3)) (-4 *1 (-611 *3)) (-4 *3 (-1118)))) (-2314 (*1 *2 *1) (-12 (-4 *1 (-611 *3)) (-4 *3 (-1118)) (-5 *2 (-83)))) (-2313 (*1 *2 *1) (-12 (-4 *1 (-611 *3)) (-4 *3 (-1118)) (-5 *2 (-83)))) (-2312 (*1 *2 *1) (-12 (-4 *1 (-611 *3)) (-4 *3 (-1118)) (-5 *2 (-83)))) (-2311 (*1 *1 *1) (-12 (-4 *1 (-611 *2)) (-4 *2 (-1118)))) (-2310 (*1 *2 *1) (-12 (-4 *1 (-611 *2)) (-4 *2 (-1118)))) (-2309 (*1 *1 *1) (-12 (-4 *1 (-611 *2)) (-4 *2 (-1118)))) (-2308 (*1 *2 *1) (-12 (-4 *1 (-611 *3)) (-4 *3 (-1118)) (-5 *2 (-687)))) (-3753 (*1 *1 *1 *2) (-12 (-5 *2 (-478)) (-4 *1 (-611 *3)) (-4 *3 (-1118)))) (-2875 (*1 *1 *1) (-12 (-4 *1 (-611 *2)) (-4 *2 (-1118))))) 
 (-13 (-1053 |t#1|) (-10 -8 (-15 -3390 ($ (-1 (-83) |t#1|) $)) (-15 -3694 ($ (-1 (-83) |t#1|) $)) (-15 -2314 ((-83) $)) (-15 -2313 ((-83) $)) (-15 -2312 ((-83) $)) (-15 -2311 ($ $)) (-15 -2310 (|t#1| $)) (-15 -2309 ($ $)) (-15 -2308 ((-687) $)) (-15 -3753 ($ $ (-478))) (-15 -2875 ($ $)))) 
 (((-34) . T) ((-72) OR (|has| |#1| (-1005)) (|has| |#1| (-72))) ((-547 (-765)) OR (|has| |#1| (-1005)) (|has| |#1| (-547 (-765)))) ((-122 |#1|) . T) ((-548 (-467)) |has| |#1| (-548 (-467))) ((-238 (-478) |#1|) . T) ((-238 (-1135 (-478)) $) . T) ((-240 (-478) |#1|) . T) ((-256 |#1|) -12 (|has| |#1| (-256 |#1|)) (|has| |#1| (-1005))) ((-422 |#1|) . T) ((-533 (-478) |#1|) . T) ((-447 |#1| |#1|) -12 (|has| |#1| (-256 |#1|)) (|has| |#1| (-1005))) ((-588 |#1|) . T) ((-916 |#1|) . T) ((-1005) |has| |#1| (-1005)) ((-1053 |#1|) . T) ((-1118) . T) ((-1157 |#1|) . T)) 
-((-2552 (((-83) $ $) NIL T ELT)) (-3225 (((-1062) $) NIL T ELT)) (-3161 (((-416) $) 10 T ELT)) (-3226 (((-1023) $) NIL T ELT)) (-3930 (((-765) $) 19 T ELT) (($ (-1084)) NIL T ELT) (((-1084) $) NIL T ELT)) (-3216 (((-1038) $) 12 T ELT)) (-1253 (((-83) $ $) NIL T ELT)) (-3040 (((-83) $ $) NIL T ELT))) 
+((-2552 (((-83) $ $) NIL T ELT)) (-3225 (((-1062) $) NIL T ELT)) (-3161 (((-416) $) 14 T ELT)) (-3226 (((-1023) $) NIL T ELT)) (-3930 (((-765) $) 23 T ELT) (($ (-1084)) NIL T ELT) (((-1084) $) NIL T ELT)) (-3216 (((-1038) $) 16 T ELT)) (-1253 (((-83) $ $) NIL T ELT)) (-3040 (((-83) $ $) NIL T ELT))) 
 (((-612) (-13 (-987) (-10 -8 (-15 -3161 ((-416) $)) (-15 -3216 ((-1038) $))))) (T -612)) 
 ((-3161 (*1 *2 *1) (-12 (-5 *2 (-416)) (-5 *1 (-612)))) (-3216 (*1 *2 *1) (-12 (-5 *2 (-1038)) (-5 *1 (-612))))) 
 ((-2552 (((-83) $ $) NIL T ELT)) (-3918 (((-578 |#1|) $) 15 T ELT)) (-3120 (($ $) 19 T ELT)) (-2648 (((-83) $) 20 T ELT)) (-3140 (((-3 |#1| "failed") $) 23 T ELT)) (-3139 ((|#1| $) 21 T ELT)) (-3783 (($ $) 37 T ELT)) (-3920 (($ $) 25 T ELT)) (-2515 (($ $ $) NIL T ELT)) (-2841 (($ $ $) NIL T ELT)) (-2495 (((-83) $ $) 46 T ELT)) (-3817 (((-823) $) 40 T ELT)) (-3121 (($ $) 18 T ELT)) (-3225 (((-1062) $) NIL T ELT)) (-3226 (((-1023) $) NIL T ELT)) (-3785 ((|#1| $) 36 T ELT)) (-3930 (((-765) $) 32 T ELT) (($ |#1|) 24 T ELT) (((-732 |#1|) $) 28 T ELT)) (-1253 (((-83) $ $) NIL T ELT)) (-2550 (((-83) $ $) NIL T ELT)) (-2551 (((-83) $ $) NIL T ELT)) (-3040 (((-83) $ $) 13 T ELT)) (-2668 (((-83) $ $) NIL T ELT)) (-2669 (((-83) $ $) 44 T ELT)) (* (($ $ $) 35 T ELT))) 
diff --git a/src/share/algebra/operation.daase b/src/share/algebra/operation.daase
index 9fccbcda..ee5d52c3 100644
--- a/src/share/algebra/operation.daase
+++ b/src/share/algebra/operation.daase
@@ -1,5 +1,5 @@
 
-(630398 . 3527958791)        
+(630398 . 3528046425)        
 (((*1 *2 *3 *4)
   (|partial| -12 (-5 *3 (-1168 *4)) (-4 *4 (-13 (-954) (-575 (-478))))
    (-5 *2 (-1168 (-343 (-478)))) (-5 *1 (-1197 *4))))) 
-- 
cgit v1.2.3