* boot/translator.boot (translateToplevel): Handle record structures.

	* boot/tokens.boot: "with" is now a keyword in Boot.
	* boot/parser.boot (bpSignature): The typing is required afte the
	colong.
	(bpFieldList): New.
	(bpGlobalAccessors): Likewise.
	(bpAccessorDefinitionList): Likewise.
	(bpAccessorDefinition): Likewise.
	(bpFieldSection): Likewise.
	(bpSelectField): Likewise.
	(bpRecord): Likewise.
	(bpStruct): Use it to implement record structures.
	* boot/ast.boot (%Ast): Add %Record and %AccessorDef.
	(bfRecordDef): New.

9 files changed, 339 insertions, 60 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index b9d767a1..ea883533 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,20 @@
+2012-05-22  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/translator.boot (translateToplevel): Handle record structures.
+	* boot/tokens.boot: "with" is now a keyword in Boot.
+	* boot/parser.boot (bpSignature): The typing is required afte the
+	colong.
+	(bpFieldList): New.
+	(bpGlobalAccessors): Likewise.
+	(bpAccessorDefinitionList): Likewise.
+	(bpAccessorDefinition): Likewise.
+	(bpFieldSection): Likewise.
+	(bpSelectField): Likewise.
+	(bpRecord): Likewise.
+	(bpStruct): Use it to implement record structures.
+	* boot/ast.boot (%Ast): Add %Record and %AccessorDef.
+	(bfRecordDef): New.
+
 2012-05-21  Gabriel Dos Reis  <gdr@cse.tamu.edu>
 
 	* boot/ast.boot (needsPROG): Remove.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 467caa3f..b3c568b4 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -62,6 +62,8 @@ structure %Ast ==
   %Namespace(%Symbol)                   -- namespace AxiomCore
   %Import(%Ast)                         -- import module; import namespace foo
   %ImportSignature(%Symbol,%Signature)  -- import function declaration
+  %Record(%List,%List)                  -- Record(num: %Short, den: %Short)
+  %AccessorDef(%Symbol,%Ast)            -- numerator == (.num)
   %TypeAlias(%Head, %List)              -- type alias definition
   %Signature(%Symbol,%Mapping)          -- op: S -> T
   %Mapping(%Ast, %List)                 -- (S1, S2) -> T
@@ -1336,6 +1338,22 @@ bfDs n ==
 bfEnum(t,csts) ==
   ['DEFTYPE,t,nil,backquote(['MEMBER,:csts],nil)]
 
+bfRecordDef(s,fields,accessors) ==
+  parms := [x for f in fields | f is ['%Signature,x,.]]
+  fun := makeSymbol strconc('"mk",symbolName s)
+  ctor := makeSymbol strconc('"MAKE-",symbolName s)
+  recDef := ["DEFSTRUCT",s,:[x for ['%Signature,x,.] in fields]]
+  ctorDef :=
+    args := [:[bfColonColon("KEYWORD",p),p] for p in parms]
+    ["DEFMACRO",fun,parms,["LIST",quote ctor,:args]]
+  accDefs :=
+    accessors = nil => nil
+    x := bfGenSymbol()
+    [["DEFMACRO",acc,[x],
+       ["LIST",quote makeSymbol strconc(symbolName s,'"-",symbolName f),x]]
+         for ['%AccessorDef,acc,f] in accessors]
+  [recDef,ctorDef,:accDefs]
+
 bfHandlers(n,e,hs) == main(n,e,hs,nil) where
   main(n,e,hs,xs) ==
     hs = nil =>
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 516b47de..e698c359 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
+-- Copyright (C) 2007-2012, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -495,7 +495,7 @@ bpTypeAliasDefition() ==
 ++  Signature:
 ++    Name COLON Mapping
 bpSignature() ==
-  bpName() and bpEqKey "COLON" and bpTyping()
+  bpName() and bpEqKey "COLON" and bpRequire function bpTyping
     and bpPush %Signature(bpPop2(), bpPop1())
 
 ++ SimpleMapping:
@@ -1153,8 +1153,50 @@ bpStruct()==
    bpEqKey "STRUCTURE" and
       bpRequire function bpName and
         (bpEqKey "DEF" or bpTrap()) and
-           bpTypeList() and bpPush %Structure(bpPop2(),bpPop1())
+           (bpRecord() or bpTypeList()) and
+             bpPush %Structure(bpPop2(),bpPop1())
  
+++ Record:
+++   "Record" "(" FieldList ")"
+bpRecord() ==
+  s := bpState()
+  bpName() and bpPop1() is "Record" =>
+    (bpParenthesized function bpFieldList or bpTrap()) and
+      bpGlobalAccessors() and
+        bpPush %Record(bfUntuple bpPop2(),bpPop1())
+  bpRestore s
+  false
+
+++ FieldList:
+++    Signature
+++    Signature , FieldList
+bpFieldList() ==
+  bpTuple function bpSignature
+
+bpGlobalAccessors() ==
+  bpEqKey "WITH" =>
+    bpPileBracketed function bpAccessorDefinitionList or bpTrap()
+  bpPush nil
+
+bpAccessorDefinitionList() ==
+  bpListAndRecover function bpAccessorDefinition
+
+++ AccessorDefinition:
+++   Name DEF FieldSection
+bpAccessorDefinition() ==
+  bpRequire function bpName and
+    (bpEqKey "DEF" or bpTrap()) and
+       bpRequire function bpFieldSection and
+         bpPush %AccessorDef(bpPop2(),bpPop1())
+
+++ FieldSection:
+++    "(" DOT Name ")"
+bpFieldSection() ==
+  bpParenthesized function bpSelectField
+
+bpSelectField() ==
+  bpEqKey "DOT" and bpName()
+
 bpTypeList() == 
   bpPileBracketed function bpTypeItemList
     or bpTypeItem() and bpPush [bpPop1()]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 808755db..59f68b8c 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -27,114 +27,119 @@
 (DEFUN |%ImportSignature| #1=(|bfVar#8| |bfVar#9|)
   (CONS '|%ImportSignature| (LIST . #1#)))
 
-(DEFUN |%TypeAlias| #1=(|bfVar#10| |bfVar#11|)
+(DEFUN |%Record| #1=(|bfVar#10| |bfVar#11|) (CONS '|%Record| (LIST . #1#)))
+
+(DEFUN |%AccessorDef| #1=(|bfVar#12| |bfVar#13|)
+  (CONS '|%AccessorDef| (LIST . #1#)))
+
+(DEFUN |%TypeAlias| #1=(|bfVar#14| |bfVar#15|)
   (CONS '|%TypeAlias| (LIST . #1#)))
 
-(DEFUN |%Signature| #1=(|bfVar#12| |bfVar#13|)
+(DEFUN |%Signature| #1=(|bfVar#16| |bfVar#17|)
   (CONS '|%Signature| (LIST . #1#)))
 
-(DEFUN |%Mapping| #1=(|bfVar#14| |bfVar#15|) (CONS '|%Mapping| (LIST . #1#)))
+(DEFUN |%Mapping| #1=(|bfVar#18| |bfVar#19|) (CONS '|%Mapping| (LIST . #1#)))
 
-(DEFUN |%Forall| #1=(|bfVar#16| |bfVar#17|) (CONS '|%Forall| (LIST . #1#)))
+(DEFUN |%Forall| #1=(|bfVar#20| |bfVar#21|) (CONS '|%Forall| (LIST . #1#)))
 
-(DEFUN |%Dynamic| #1=(|bfVar#18|) (CONS '|%Dynamic| (LIST . #1#)))
+(DEFUN |%Dynamic| #1=(|bfVar#22|) (CONS '|%Dynamic| (LIST . #1#)))
 
-(DEFUN |%SuffixDot| #1=(|bfVar#19|) (CONS '|%SuffixDot| (LIST . #1#)))
+(DEFUN |%SuffixDot| #1=(|bfVar#23|) (CONS '|%SuffixDot| (LIST . #1#)))
 
-(DEFUN |%Quote| #1=(|bfVar#20|) (CONS '|%Quote| (LIST . #1#)))
+(DEFUN |%Quote| #1=(|bfVar#24|) (CONS '|%Quote| (LIST . #1#)))
 
-(DEFUN |%EqualPattern| #1=(|bfVar#21|) (CONS '|%EqualPattern| (LIST . #1#)))
+(DEFUN |%EqualPattern| #1=(|bfVar#25|) (CONS '|%EqualPattern| (LIST . #1#)))
 
-(DEFUN |%Colon| #1=(|bfVar#22|) (CONS '|%Colon| (LIST . #1#)))
+(DEFUN |%Colon| #1=(|bfVar#26|) (CONS '|%Colon| (LIST . #1#)))
 
-(DEFUN |%QualifiedName| #1=(|bfVar#23| |bfVar#24|)
+(DEFUN |%QualifiedName| #1=(|bfVar#27| |bfVar#28|)
   (CONS '|%QualifiedName| (LIST . #1#)))
 
-(DEFUN |%DefaultValue| #1=(|bfVar#25| |bfVar#26|)
+(DEFUN |%DefaultValue| #1=(|bfVar#29| |bfVar#30|)
   (CONS '|%DefaultValue| (LIST . #1#)))
 
-(DEFUN |%Key| #1=(|bfVar#27| |bfVar#28|) (CONS '|%Key| (LIST . #1#)))
+(DEFUN |%Key| #1=(|bfVar#31| |bfVar#32|) (CONS '|%Key| (LIST . #1#)))
 
-(DEFUN |%Bracket| #1=(|bfVar#29|) (CONS '|%Bracket| (LIST . #1#)))
+(DEFUN |%Bracket| #1=(|bfVar#33|) (CONS '|%Bracket| (LIST . #1#)))
 
-(DEFUN |%UnboundedSegment| #1=(|bfVar#30|)
+(DEFUN |%UnboundedSegment| #1=(|bfVar#34|)
   (CONS '|%UnboundedSegment| (LIST . #1#)))
 
-(DEFUN |%BoundedSgement| #1=(|bfVar#31| |bfVar#32|)
+(DEFUN |%BoundedSgement| #1=(|bfVar#35| |bfVar#36|)
   (CONS '|%BoundedSgement| (LIST . #1#)))
 
-(DEFUN |%Tuple| #1=(|bfVar#33|) (CONS '|%Tuple| (LIST . #1#)))
+(DEFUN |%Tuple| #1=(|bfVar#37|) (CONS '|%Tuple| (LIST . #1#)))
 
-(DEFUN |%ColonAppend| #1=(|bfVar#34| |bfVar#35|)
+(DEFUN |%ColonAppend| #1=(|bfVar#38| |bfVar#39|)
   (CONS '|%ColonAppend| (LIST . #1#)))
 
-(DEFUN |%Pretend| #1=(|bfVar#36| |bfVar#37|) (CONS '|%Pretend| (LIST . #1#)))
+(DEFUN |%Pretend| #1=(|bfVar#40| |bfVar#41|) (CONS '|%Pretend| (LIST . #1#)))
 
-(DEFUN |%Is| #1=(|bfVar#38| |bfVar#39|) (CONS '|%Is| (LIST . #1#)))
+(DEFUN |%Is| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Is| (LIST . #1#)))
 
-(DEFUN |%Isnt| #1=(|bfVar#40| |bfVar#41|) (CONS '|%Isnt| (LIST . #1#)))
+(DEFUN |%Isnt| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Isnt| (LIST . #1#)))
 
-(DEFUN |%Reduce| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Reduce| (LIST . #1#)))
+(DEFUN |%Reduce| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Reduce| (LIST . #1#)))
 
-(DEFUN |%PrefixExpr| #1=(|bfVar#44| |bfVar#45|)
+(DEFUN |%PrefixExpr| #1=(|bfVar#48| |bfVar#49|)
   (CONS '|%PrefixExpr| (LIST . #1#)))
 
-(DEFUN |%Call| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Call| (LIST . #1#)))
+(DEFUN |%Call| #1=(|bfVar#50| |bfVar#51|) (CONS '|%Call| (LIST . #1#)))
 
-(DEFUN |%InfixExpr| #1=(|bfVar#48| |bfVar#49| |bfVar#50|)
+(DEFUN |%InfixExpr| #1=(|bfVar#52| |bfVar#53| |bfVar#54|)
   (CONS '|%InfixExpr| (LIST . #1#)))
 
-(DEFUN |%ConstantDefinition| #1=(|bfVar#51| |bfVar#52|)
+(DEFUN |%ConstantDefinition| #1=(|bfVar#55| |bfVar#56|)
   (CONS '|%ConstantDefinition| (LIST . #1#)))
 
-(DEFUN |%Definition| #1=(|bfVar#53| |bfVar#54| |bfVar#55|)
+(DEFUN |%Definition| #1=(|bfVar#57| |bfVar#58| |bfVar#59|)
   (CONS '|%Definition| (LIST . #1#)))
 
-(DEFUN |%Macro| #1=(|bfVar#56| |bfVar#57| |bfVar#58|)
+(DEFUN |%Macro| #1=(|bfVar#60| |bfVar#61| |bfVar#62|)
   (CONS '|%Macro| (LIST . #1#)))
 
-(DEFUN |%Lambda| #1=(|bfVar#59| |bfVar#60|) (CONS '|%Lambda| (LIST . #1#)))
+(DEFUN |%Lambda| #1=(|bfVar#63| |bfVar#64|) (CONS '|%Lambda| (LIST . #1#)))
 
-(DEFUN |%SuchThat| #1=(|bfVar#61|) (CONS '|%SuchThat| (LIST . #1#)))
+(DEFUN |%SuchThat| #1=(|bfVar#65|) (CONS '|%SuchThat| (LIST . #1#)))
 
-(DEFUN |%Assignment| #1=(|bfVar#62| |bfVar#63|)
+(DEFUN |%Assignment| #1=(|bfVar#66| |bfVar#67|)
   (CONS '|%Assignment| (LIST . #1#)))
 
-(DEFUN |%While| #1=(|bfVar#64|) (CONS '|%While| (LIST . #1#)))
+(DEFUN |%While| #1=(|bfVar#68|) (CONS '|%While| (LIST . #1#)))
 
-(DEFUN |%Until| #1=(|bfVar#65|) (CONS '|%Until| (LIST . #1#)))
+(DEFUN |%Until| #1=(|bfVar#69|) (CONS '|%Until| (LIST . #1#)))
 
-(DEFUN |%For| #1=(|bfVar#66| |bfVar#67| |bfVar#68|) (CONS '|%For| (LIST . #1#)))
+(DEFUN |%For| #1=(|bfVar#70| |bfVar#71| |bfVar#72|) (CONS '|%For| (LIST . #1#)))
 
-(DEFUN |%Implies| #1=(|bfVar#69| |bfVar#70|) (CONS '|%Implies| (LIST . #1#)))
+(DEFUN |%Implies| #1=(|bfVar#73| |bfVar#74|) (CONS '|%Implies| (LIST . #1#)))
 
-(DEFUN |%Iterators| #1=(|bfVar#71|) (CONS '|%Iterators| (LIST . #1#)))
+(DEFUN |%Iterators| #1=(|bfVar#75|) (CONS '|%Iterators| (LIST . #1#)))
 
-(DEFUN |%Cross| #1=(|bfVar#72|) (CONS '|%Cross| (LIST . #1#)))
+(DEFUN |%Cross| #1=(|bfVar#76|) (CONS '|%Cross| (LIST . #1#)))
 
-(DEFUN |%Repeat| #1=(|bfVar#73| |bfVar#74|) (CONS '|%Repeat| (LIST . #1#)))
+(DEFUN |%Repeat| #1=(|bfVar#77| |bfVar#78|) (CONS '|%Repeat| (LIST . #1#)))
 
-(DEFUN |%Pile| #1=(|bfVar#75|) (CONS '|%Pile| (LIST . #1#)))
+(DEFUN |%Pile| #1=(|bfVar#79|) (CONS '|%Pile| (LIST . #1#)))
 
-(DEFUN |%Append| #1=(|bfVar#76|) (CONS '|%Append| (LIST . #1#)))
+(DEFUN |%Append| #1=(|bfVar#80|) (CONS '|%Append| (LIST . #1#)))
 
-(DEFUN |%Case| #1=(|bfVar#77| |bfVar#78|) (CONS '|%Case| (LIST . #1#)))
+(DEFUN |%Case| #1=(|bfVar#81| |bfVar#82|) (CONS '|%Case| (LIST . #1#)))
 
-(DEFUN |%Return| #1=(|bfVar#79|) (CONS '|%Return| (LIST . #1#)))
+(DEFUN |%Return| #1=(|bfVar#83|) (CONS '|%Return| (LIST . #1#)))
 
-(DEFUN |%Leave| #1=(|bfVar#80|) (CONS '|%Leave| (LIST . #1#)))
+(DEFUN |%Leave| #1=(|bfVar#84|) (CONS '|%Leave| (LIST . #1#)))
 
-(DEFUN |%Throw| #1=(|bfVar#81|) (CONS '|%Throw| (LIST . #1#)))
+(DEFUN |%Throw| #1=(|bfVar#85|) (CONS '|%Throw| (LIST . #1#)))
 
-(DEFUN |%Catch| #1=(|bfVar#82| |bfVar#83|) (CONS '|%Catch| (LIST . #1#)))
+(DEFUN |%Catch| #1=(|bfVar#86| |bfVar#87|) (CONS '|%Catch| (LIST . #1#)))
 
-(DEFUN |%Finally| #1=(|bfVar#84|) (CONS '|%Finally| (LIST . #1#)))
+(DEFUN |%Finally| #1=(|bfVar#88|) (CONS '|%Finally| (LIST . #1#)))
 
-(DEFUN |%Try| #1=(|bfVar#85| |bfVar#86|) (CONS '|%Try| (LIST . #1#)))
+(DEFUN |%Try| #1=(|bfVar#89| |bfVar#90|) (CONS '|%Try| (LIST . #1#)))
 
-(DEFUN |%Where| #1=(|bfVar#87| |bfVar#88|) (CONS '|%Where| (LIST . #1#)))
+(DEFUN |%Where| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Where| (LIST . #1#)))
 
-(DEFUN |%Structure| #1=(|bfVar#89| |bfVar#90|)
+(DEFUN |%Structure| #1=(|bfVar#93| |bfVar#94|)
   (CONS '|%Structure| (LIST . #1#)))
 
 (DEFPARAMETER |$inDefIS| NIL)
@@ -2467,6 +2472,148 @@
 (DEFUN |bfEnum| (|t| |csts|)
   (LIST 'DEFTYPE |t| NIL (|backquote| (CONS 'MEMBER |csts|) NIL)))
 
+(DEFUN |bfRecordDef| (|s| |fields| |accessors|)
+  (LET* (|accDefs|
+         |f|
+         |acc|
+         |ctorDef|
+         |args|
+         |recDef|
+         |ctor|
+         |fun|
+         |parms|
+         |ISTMP#2|
+         |x|
+         |ISTMP#1|)
+    (PROGN
+     (SETQ |parms|
+             (LET ((|bfVar#2| NIL)
+                   (|bfVar#3| NIL)
+                   (|bfVar#1| |fields|)
+                   (|f| NIL))
+               (LOOP
+                (COND
+                 ((OR (NOT (CONSP |bfVar#1|))
+                      (PROGN (SETQ |f| (CAR |bfVar#1|)) NIL))
+                  (RETURN |bfVar#2|))
+                 (T
+                  (AND (CONSP |f|) (EQ (CAR |f|) '|%Signature|)
+                       (PROGN
+                        (SETQ |ISTMP#1| (CDR |f|))
+                        (AND (CONSP |ISTMP#1|)
+                             (PROGN
+                              (SETQ |x| (CAR |ISTMP#1|))
+                              (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                              (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))))))
+                       (COND
+                        ((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS |x| NIL))
+                         (SETQ |bfVar#3| |bfVar#2|))
+                        (T (RPLACD |bfVar#3| #1#)
+                         (SETQ |bfVar#3| (CDR |bfVar#3|)))))))
+                (SETQ |bfVar#1| (CDR |bfVar#1|)))))
+     (SETQ |fun| (INTERN (CONCAT "mk" (SYMBOL-NAME |s|))))
+     (SETQ |ctor| (INTERN (CONCAT "MAKE-" (SYMBOL-NAME |s|))))
+     (SETQ |recDef|
+             (CONS 'DEFSTRUCT
+                   (CONS |s|
+                         (LET ((|bfVar#6| NIL)
+                               (|bfVar#7| NIL)
+                               (|bfVar#5| |fields|)
+                               (|bfVar#4| NIL))
+                           (LOOP
+                            (COND
+                             ((OR (NOT (CONSP |bfVar#5|))
+                                  (PROGN (SETQ |bfVar#4| (CAR |bfVar#5|)) NIL))
+                              (RETURN |bfVar#6|))
+                             (T
+                              (AND (CONSP |bfVar#4|)
+                                   (EQ (CAR |bfVar#4|) '|%Signature|)
+                                   (PROGN
+                                    (SETQ |ISTMP#1| (CDR |bfVar#4|))
+                                    (AND (CONSP |ISTMP#1|)
+                                         (PROGN
+                                          (SETQ |x| (CAR |ISTMP#1|))
+                                          (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                                          (AND (CONSP |ISTMP#2|)
+                                               (NULL (CDR |ISTMP#2|))))))
+                                   (COND
+                                    ((NULL |bfVar#6|)
+                                     (SETQ |bfVar#6| #2=(CONS |x| NIL))
+                                     (SETQ |bfVar#7| |bfVar#6|))
+                                    (T (RPLACD |bfVar#7| #2#)
+                                     (SETQ |bfVar#7| (CDR |bfVar#7|)))))))
+                            (SETQ |bfVar#5| (CDR |bfVar#5|)))))))
+     (SETQ |ctorDef|
+             (PROGN
+              (SETQ |args|
+                      (LET ((|bfVar#9| NIL)
+                            (|bfVar#10| NIL)
+                            (|bfVar#8| |parms|)
+                            (|p| NIL))
+                        (LOOP
+                         (COND
+                          ((OR (NOT (CONSP |bfVar#8|))
+                               (PROGN (SETQ |p| (CAR |bfVar#8|)) NIL))
+                           (RETURN |bfVar#9|))
+                          (T
+                           (LET ((|bfVar#11|
+                                  (LIST (|bfColonColon| 'KEYWORD |p|) |p|)))
+                             (COND ((NULL |bfVar#11|) NIL)
+                                   ((NULL |bfVar#9|)
+                                    (SETQ |bfVar#9| |bfVar#11|)
+                                    (SETQ |bfVar#10| (|lastNode| |bfVar#9|)))
+                                   (T (RPLACD |bfVar#10| |bfVar#11|)
+                                    (SETQ |bfVar#10|
+                                            (|lastNode| |bfVar#10|)))))))
+                         (SETQ |bfVar#8| (CDR |bfVar#8|)))))
+              (LIST 'DEFMACRO |fun| |parms|
+                    (CONS 'LIST (CONS (|quote| |ctor|) |args|)))))
+     (SETQ |accDefs|
+             (COND ((NULL |accessors|) NIL)
+                   (T (SETQ |x| (|bfGenSymbol|))
+                    (LET ((|bfVar#14| NIL)
+                          (|bfVar#15| NIL)
+                          (|bfVar#13| |accessors|)
+                          (|bfVar#12| NIL))
+                      (LOOP
+                       (COND
+                        ((OR (NOT (CONSP |bfVar#13|))
+                             (PROGN (SETQ |bfVar#12| (CAR |bfVar#13|)) NIL))
+                         (RETURN |bfVar#14|))
+                        (T
+                         (AND (CONSP |bfVar#12|)
+                              (EQ (CAR |bfVar#12|) '|%AccessorDef|)
+                              (PROGN
+                               (SETQ |ISTMP#1| (CDR |bfVar#12|))
+                               (AND (CONSP |ISTMP#1|)
+                                    (PROGN
+                                     (SETQ |acc| (CAR |ISTMP#1|))
+                                     (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                                     (AND (CONSP |ISTMP#2|)
+                                          (NULL (CDR |ISTMP#2|))
+                                          (PROGN
+                                           (SETQ |f| (CAR |ISTMP#2|))
+                                           T)))))
+                              (COND
+                               ((NULL |bfVar#14|)
+                                (SETQ |bfVar#14|
+                                        #3=(CONS
+                                            (LIST 'DEFMACRO |acc| (LIST |x|)
+                                                  (LIST 'LIST
+                                                        (|quote|
+                                                         (INTERN
+                                                          (CONCAT
+                                                           (SYMBOL-NAME |s|)
+                                                           "-"
+                                                           (SYMBOL-NAME |f|))))
+                                                        |x|))
+                                            NIL))
+                                (SETQ |bfVar#15| |bfVar#14|))
+                               (T (RPLACD |bfVar#15| #3#)
+                                (SETQ |bfVar#15| (CDR |bfVar#15|)))))))
+                       (SETQ |bfVar#13| (CDR |bfVar#13|)))))))
+     (CONS |recDef| (CONS |ctorDef| |accDefs|)))))
+
 (DEFUN |bfHandlers| (|n| |e| |hs|) (|bfHandlers,main| |n| |e| |hs| NIL))
 
 (DEFUN |bfHandlers,main| (|n| |e| |hs| |xs|)
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 85db17da..fa16a127 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -462,7 +462,7 @@
        (|bpPush| (|%TypeAlias| (|bpPop2|) (|bpPop1|)))))
 
 (DEFUN |bpSignature| ()
-  (AND (|bpName|) (|bpEqKey| 'COLON) (|bpTyping|)
+  (AND (|bpName|) (|bpEqKey| 'COLON) (|bpRequire| #'|bpTyping|)
        (|bpPush| (|%Signature| (|bpPop2|) (|bpPop1|)))))
 
 (DEFUN |bpSimpleMapping| ()
@@ -1098,9 +1098,40 @@
 
 (DEFUN |bpStruct| ()
   (AND (|bpEqKey| 'STRUCTURE) (|bpRequire| #'|bpName|)
-       (OR (|bpEqKey| 'DEF) (|bpTrap|)) (|bpTypeList|)
+       (OR (|bpEqKey| 'DEF) (|bpTrap|)) (OR (|bpRecord|) (|bpTypeList|))
        (|bpPush| (|%Structure| (|bpPop2|) (|bpPop1|)))))
 
+(DEFUN |bpRecord| ()
+  (LET* (|s|)
+    (PROGN
+     (SETQ |s| (|bpState|))
+     (COND
+      ((AND (|bpName|) (EQ (|bpPop1|) '|Record|))
+       (AND (OR (|bpParenthesized| #'|bpFieldList|) (|bpTrap|))
+            (|bpGlobalAccessors|)
+            (|bpPush| (|%Record| (|bfUntuple| (|bpPop2|)) (|bpPop1|)))))
+      (T (|bpRestore| |s|) NIL)))))
+
+(DEFUN |bpFieldList| () (|bpTuple| #'|bpSignature|))
+
+(DEFUN |bpGlobalAccessors| ()
+  (COND
+   ((|bpEqKey| 'WITH)
+    (OR (|bpPileBracketed| #'|bpAccessorDefinitionList|) (|bpTrap|)))
+   (T (|bpPush| NIL))))
+
+(DEFUN |bpAccessorDefinitionList| ()
+  (|bpListAndRecover| #'|bpAccessorDefinition|))
+
+(DEFUN |bpAccessorDefinition| ()
+  (AND (|bpRequire| #'|bpName|) (OR (|bpEqKey| 'DEF) (|bpTrap|))
+       (|bpRequire| #'|bpFieldSection|)
+       (|bpPush| (|%AccessorDef| (|bpPop2|) (|bpPop1|)))))
+
+(DEFUN |bpFieldSection| () (|bpParenthesized| #'|bpSelectField|))
+
+(DEFUN |bpSelectField| () (AND (|bpEqKey| 'DOT) (|bpName|)))
+
 (DEFUN |bpTypeList| ()
   (OR (|bpPileBracketed| #'|bpTypeItemList|)
       (AND (|bpTypeItem|) (|bpPush| (LIST (|bpPop1|))))))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 0ed1016a..d75c74a2 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -38,12 +38,12 @@
         (LIST "or" 'OR) (LIST "rem" 'REM) (LIST "repeat" 'REPEAT)
         (LIST "return" 'RETURN) (LIST "quo" 'QUO) (LIST "structure" 'STRUCTURE)
         (LIST "then" 'THEN) (LIST "throw" 'THROW) (LIST "try" 'TRY)
-        (LIST "until" 'UNTIL) (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 "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)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index a337d62e..37d7aa38 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -585,7 +585,17 @@
        (T |x|)))))
 
 (DEFUN |translateToplevel| (|b| |export?|)
-  (LET* (|csts| |lhs| |t| |ISTMP#2| |sig| |ns| |n| |ISTMP#1| |xs|)
+  (LET* (|csts|
+         |accessors|
+         |fields|
+         |lhs|
+         |t|
+         |ISTMP#2|
+         |sig|
+         |ns|
+         |n|
+         |ISTMP#1|
+         |xs|)
     (DECLARE
      (SPECIAL |$activeNamespace| |$InteractiveMode| |$constantIdentifiers|
       |$foreignsDefsForCLisp| |$currentModuleName|))
@@ -700,6 +710,18 @@
              (|%Structure|
               (LET ((|t| (CADR |b|)) (|alts| (CADDR |b|)))
                 (COND
+                 ((AND (CONSP |alts|) (EQ (CAR |alts|) '|%Record|)
+                       (PROGN
+                        (SETQ |ISTMP#1| (CDR |alts|))
+                        (AND (CONSP |ISTMP#1|)
+                             (PROGN
+                              (SETQ |fields| (CAR |ISTMP#1|))
+                              (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                              (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
+                                   (PROGN
+                                    (SETQ |accessors| (CAR |ISTMP#2|))
+                                    T))))))
+                  (|bfRecordDef| |t| |fields| |accessors|))
                  ((AND (CONSP |alts|) (NULL (CDR |alts|))
                        (PROGN
                         (SETQ |ISTMP#1| (CAR |alts|))
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index cb3491df..b31eeec3 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -90,6 +90,7 @@ shoeKeyWords == [  _
             ['"throw", "THROW"], _
             ['"try",   "TRY"], _
             ['"until",  "UNTIL"], _
+            ['"with",   "WITH" ], _
             ['"where",  "WHERE"], _
             ['"while",  "WHILE"], _
             ['".", "DOT"], _
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 6fca0944..79228477 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -480,6 +480,7 @@ translateToplevel(b,export?) ==
     %Macro(op,args,body) => bfMDef(op,args,body)
 
     %Structure(t,alts) =>
+      alts is ['%Record,fields,accessors] => bfRecordDef(t,fields,accessors)
       alts is [['Enumeration,:csts]] => [bfEnum(t,csts)]
       [bfCreateDef alt for alt in alts]