Misc cleanup.

6 files changed, 110 insertions, 38 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 82ef78c4..21383c4d 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,15 @@
+2008-07-23  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/parser.boot (bpExportItemTail): New.
+	(bpExportItem): Likewise.
+	(bpExportItemList): Use it.
+	(bpSimplMapping): New.
+	(bpMapping): Use it.
+	* boot/translator.boot (translateToplevel): Tidy.
+	* include/open-axiom.h [__MINGW32__]: Include <windows.h>.
+	* interp/astr.boot: Export functions.
+	* interp/posit.boot: Likewise.
+
 2008-07-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/compiler.boot (compNot): Rename from compileNot.
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 1cf9330f..abb743f7 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -411,11 +411,35 @@ bpConstTok() ==
      bpString()
 
 
+++ Subroutine of bpExportItem.  Parses tails of ExportItem.
+bpExportItemTail() ==
+  bpEqKey "BEC" and (bpAssign() or bpTrap()) and
+    bpPush %Assignment(bpPop2(), bpPop1())
+      or bpSimpleDefinitionTail()
+
+++ ExportItem:
+++   Structure
+++   TypeAliasDefinition
+++   Signature
+++   Signature := Where
+++   Signature  == Where
+bpExportItem() ==
+  bpEqPeek "STRUCTURE" => bpStruct()
+  a := bpState()
+  bpName() =>
+    bpEqPeek "COLON" =>
+      bpRestore a
+      bpSignature() or bpTrap()
+      bpExportItemTail() or true
+    bpRestore a
+    bpTypeAliasDefition()
+  false
+
 ++ ExportItemList:
 ++    Signature
 ++    ExportItemList Signature
 bpExportItemList() ==
-  bpListAndRecover function bpSignature
+  bpListAndRecover function bpExportItem
 
 ++ Exports:
 ++   pile-bracketed ExporItemList
@@ -460,13 +484,25 @@ bpSignature() ==
   bpName() and bpEqKey "COLON" and bpMapping()
     and bpPush Signature(bpPop2(), bpPop1())
 
+++ SimpleMapping:
+++   Application
+++   Application -> Application
+bpSimpleMapping() ==
+  bpApplication() =>
+    bpEqKey "ARROW" and (bpApplication() or bpTrap()) and
+      bpPush Mapping(bpPop1(), bfUntuple bpPop1())
+    true
+  false
+
 ++ Parse a mapping expression
 ++   Mapping:
-++      (Name | IdList) -> Name
+++     (IdList) -> Application
+++      SimpleMapping
 bpMapping() ==
-  (bpName() or bpParenthesized function bpIdList) and 
-     bpEqKey "ARROW" and bpName() and 
+  bpParenthesized function bpIdList and 
+     bpEqKey "ARROW" and bpApplication() and 
        bpPush Mapping(bpPop1(), bfUntuple bpPop1())
+         or bpSimpleMapping()
 
 bpCancel()==
     a:=bpState()
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 2aee7c21..01778e2e 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -38,8 +38,8 @@ import scanner
 import pile
 import parser
 import ast
-module translator
 namespace BOOTTRAN
+module translator
 
 ++ If non nil, holds the name of the current module being translated.
 $currentModuleName := nil
@@ -502,7 +502,7 @@ translateToplevel(b,export?) ==
       $currentModuleName := m 
       $foreignsDefsForCLisp := nil
       [["PROVIDE", STRING m],
-        :[translateToplevel(d,true) for d in ds]]
+        :[first translateToplevel(d,true) for d in ds]]
 
     Import(m) => 
       [["IMPORT-MODULE", STRING m]]
diff --git a/src/include/open-axiom.h b/src/include/open-axiom.h
index 1ae28921..b34733bd 100644
--- a/src/include/open-axiom.h
+++ b/src/include/open-axiom.h
@@ -57,6 +57,7 @@ typedef uint8_t openaxiom_byte;
 
 /* The opaque datatype.  */
 #ifdef __MINGW32__
+#include <windows.h>
 typedef HANDLE openaxiom_handle;
 #else
 typedef void* openaxiom_handle;
diff --git a/src/interp/astr.boot b/src/interp/astr.boot
index ecf8768a..b506c23a 100644
--- a/src/interp/astr.boot
+++ b/src/interp/astr.boot
@@ -33,6 +33,11 @@
 
 import vmlisp
 namespace BOOT
+module astr where
+  ncTag: %Thing -> %Symbol
+  ncAlist: %Thing -> %List
+  ncEltQ: %List -> %Thing
+  ncPutQ: (%List,%Thing,%Thing) -> %Thing
 
 --% Attributed Structures (astr)
 -- For objects which are pairs where the CAR field is either just a tag
@@ -40,25 +45,25 @@ namespace BOOT
  
 -- Pick off the tag
 ncTag x ==
-   not PAIRP x => ncBug('S2CB0031,[])
-   x := QCAR x
+   atom x => ncBug('S2CB0031,[])
+   x := first x
    IDENTP x => x
-   not PAIRP x => ncBug('S2CB0031,[])
-   QCAR x
+   atom x => ncBug('S2CB0031,[])
+   first x
  
 -- Pick off the property list
 ncAlist x ==
-   not PAIRP x => ncBug('S2CB0031,[])
-   x := QCAR x
-   IDENTP x => NIL
-   not PAIRP x => ncBug('S2CB0031,[])
-   QCDR x
+   atom x => ncBug('S2CB0031,[])
+   x := first x
+   IDENTP x => nil
+   atom x => ncBug('S2CB0031,[])
+   rest x
 
  --- Get the entry for key k on x's association list
 ncEltQ(x,k) ==
    r := QASSQ(k,ncAlist x)
-   NULL r => ncBug ('S2CB0007,[k])
-   CDR r
+   null r => ncBug ('S2CB0007,[k])
+   rest r
  
 -- Put (k . v) on the association list of x and return v
 -- case1: ncPutQ(x,k,v) where k is a key (an identifier), v a value
@@ -70,9 +75,9 @@ ncPutQ(x,k,v) ==
       for key in k for val in v repeat ncPutQ(x,key,val)
       v
    r := QASSQ(k,ncAlist x)
-   if NULL r then
-      r := CONS( CONS(k,v), ncAlist x)
-      RPLACA(x,CONS(ncTag x,r))
+   if null r then
+      r := [[k,:v], :ncAlist x]
+      RPLACA(x,[ncTag x,:r])
    else
       RPLACD(r,v)
    v
diff --git a/src/interp/posit.boot b/src/interp/posit.boot
index 0e12dbfc..77911e8b 100644
--- a/src/interp/posit.boot
+++ b/src/interp/posit.boot
@@ -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-2008, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -34,6 +34,11 @@
 import sys_-macros
 import astr
 namespace BOOT
+module posit where
+  %Position <=> %List
+  tokType: %List -> %Symbol
+  tokPart: %List -> %Thing
+  tokPosn: %List -> %Position
 
 $nopos ==
   ['noposition]
@@ -52,7 +57,7 @@ pfPosOrNopos pf ==
     poNoPosition()
  
 poIsPos? pos ==
-    PAIRP pos and PAIRP CAR pos and LENGTH CAR pos = 5
+    PAIRP pos and PAIRP first pos and #first pos = 5
  
 lnCreate(extBl, st, gNo, :optFileStuff) ==
     lNo :=
@@ -81,7 +86,7 @@ lnFileName lineObject    ==
     ncBug('"there is no file name in %1", [lineObject] )
  
 lnFileName? lineObject   ==
-    NOT PAIRP (fN := lineObject.4)  => NIL
+    atom (fN := lineObject.4)  => nil
     fN
  
 lnPlaceOfOrigin lineObject ==
@@ -91,7 +96,8 @@ lnImmediate? lineObject  ==
     not lnFileName? lineObject
  
 poGetLineObject posn ==
-    CAR posn
+    first posn
+
 pfGetLineObject posn == poGetLineObject posn
  
 pfSourceStok x==
@@ -113,23 +119,25 @@ pfSourceToken form ==
 tokConstruct(hd,tok,:pos)==
          a:=cons(hd,tok)
          IFCAR pos =>
-             pfNoPosition? CAR pos=> a
-             ncPutQ(a,"posn",CAR pos)
+             pfNoPosition? first pos=> a
+             ncPutQ(a,"posn",first pos)
              a
          a
 
 tokType x== ncTag x
-tokPart x== CDR x
+
+tokPart x== rest x
+
 tokPosn x==
      a:= QASSQ("posn",ncAlist x)
-     if a then CDR a else pfNoPosition()
+     if a then rest a else pfNoPosition()
 
 pfAbSynOp form ==
-    hd := CAR form
+    hd := first form
     IFCAR hd or hd
 
 pfAbSynOp?(form, op) ==
-    hd := CAR form
+    hd := first form
     EQ(hd, op) or EQCAR(hd, op)
 
 pfLeaf? form ==
@@ -141,10 +149,10 @@ pfLeaf(x,y,:z)      == tokConstruct(x,y, IFCAR z or pfNoPosition())
 pfLeafToken form    == tokPart form
 pfLeafPosition form == tokPosn form
 
-pfTree(x,y)         == CONS(x,y)       -- was ==>
-pfParts  form       == CDR form       -- was ==>
-pfFirst  form       == CADR form       -- was ==>
-pfSecond form       == CADDR form       -- was ==>
+pfTree(x,y)   == [x,:y]
+pfParts  form == rest form
+pfFirst  form == second form
+pfSecond form == third form
 
 pfPosn pf == pfSourcePosition pf
  
@@ -172,44 +180,54 @@ pfSourcePositionlist x==
       else APPEND(pfSourcePositions first x,pfSourcePositionlist rest x)
  
  
-poCharPosn posn       == CDR posn
+poCharPosn posn == rest posn
+
 pfCharPosn posn == poCharPosn posn
  
 poLinePosn posn       ==
     posn => lnLocalNum  poGetLineObject posn  --VECP posn =>
     CDAR posn
+
 pfLinePosn posn == poLinePosn posn
  
 poGlobalLinePosn posn ==
     posn => lnGlobalNum poGetLineObject posn
     ncBug('"old style pos objects have no global positions",[])
+
 pfGlobalLinePosn posn == poGlobalLinePosn posn
  
 poFileName posn       ==
     posn => lnFileName poGetLineObject posn
     CAAR posn
+
 pfFileName posn == poFileName posn
  
 poFileName? posn       ==
-    posn = ['noposition] => NIL
+    posn = ['noposition] => nil
     posn => lnFileName? poGetLineObject posn
     CAAR posn
+
 pfFileName? posn == poFileName? posn
  
 poPlaceOfOrigin posn ==
     lnPlaceOfOrigin poGetLineObject posn
+
 pfPlaceOfOrigin posn == poPlaceOfOrigin posn
  
 poNopos? posn ==
     posn = ['noposition]
+
 pfNopos? posn == poNopos? posn
+
 poPosImmediate? txp==
-    poNopos? txp => NIL
+    poNopos? txp => nil
     lnImmediate? poGetLineObject txp
+
 pfPosImmediate? txp == poPosImmediate? txp
  
 poImmediate? txp==
     lnImmediate? poGetLineObject txp
+
 pfImmediate? txp == poImmediate? txp
  
  
@@ -222,7 +240,7 @@ pfPrintSrcLines(pf) ==
   lines := pfSourcePositions pf
   lno := 0
   for l in lines repeat
-    line := car l
+    line := first l
     if lno < lnGlobalNum(line) then 
       FORMAT(true, '"   ~A~%",  lnString line)
       lno := lnGlobalNum(line)