Import to github.

10 files changed, 1444 insertions, 0 deletions

diff --git a/ast/README b/ast/README
new file mode 100644
index 0000000..ed2497d
--- /dev/null
+++ b/ast/README
@@ -0,0 +1,29 @@
+This directory defines the primary data structures used in the compiler
+using the `define-struct' macro defined in the struct directory.
+
+Structures are divided into the following catagories:
+
+Basic structures: (basic-structs)
+  References to variables, data constructors, classes, type constructors
+    All references contain the name of the object referred to and a
+    field that will receive the actual definition object when scoping
+    has been resolved.
+  Fixity: (l | n | r, Int)
+
+Module structures: (module-structs)
+  The module ast, import & export related ast's, and fixity definition.
+
+Type system structures: (type-structs)
+  The representation of data types and the type related declarations:
+  type, data, class, and instance.
+
+Value declarations: (valdef-structs)
+  
+Expressions: (expr-structs)
+
+Definitions: (definition-structs)
+
+Flic structures: (flic-structs)
+
+
+
diff --git a/ast/ast-td.scm b/ast/ast-td.scm
new file mode 100644
index 0000000..cf70016
--- /dev/null
+++ b/ast/ast-td.scm
@@ -0,0 +1,20 @@
+;;; ast-td.scm -- define ast type descriptor object
+;;;
+;;; author :  Sandra Loosemore
+;;; date   :  6 Oct 1992
+;;;
+
+
+;;; Give the type descriptors for AST nodes extra slots to hold walker
+;;; functions.
+
+(define-struct ast-td
+  (include type-descriptor)
+  (slots
+    (cfn-walker (type (maybe procedure)) (default '#f))
+    (cfn-simple-transform-walker (type (maybe procedure)) (default '#f))
+    (depend-walker (type (maybe procedure)) (default '#f))
+    (ast-to-flic-walker (type (maybe procedure)) (default '#f))
+    (scope-walker (type (maybe procedure)) (default '#f))
+    (type-walker (type (maybe procedure)) (default '#f))
+    (collect-pattern-vars-walker (type (maybe procedure)) (default '#f))))
diff --git a/ast/ast.scm b/ast/ast.scm
new file mode 100644
index 0000000..9169677
--- /dev/null
+++ b/ast/ast.scm
@@ -0,0 +1,33 @@
+;;; ast.scm -- compilation unit definition for ast definitions
+;;;
+;;; author :  John
+;;; date   :  10 Dec 1991
+;;;
+
+
+(define-compilation-unit ast
+  (source-filename "$Y2/ast/")
+  (unit ast-td
+    (source-filename "ast-td"))
+  (unit modules
+    (source-filename "modules.scm")
+    (require ast-td))
+  (unit type-structs
+    (source-filename "type-structs.scm")
+    (require ast-td modules))
+  (unit tc-structs
+    (source-filename "tc-structs.scm")
+    (require ast-td modules))
+  (unit valdef-structs
+    (source-filename "valdef-structs.scm")
+    (require ast-td modules))
+  (unit definitions
+    (source-filename "definitions.scm")
+    (require ast-td modules))
+  (unit exp-structs
+    (source-filename "exp-structs.scm")
+    (require ast-td modules))
+  (unit predicates
+    (require ast-td modules type-structs valdef-structs definitions
+	     exp-structs tc-structs)
+    (source-filename "predicates.scm")))
diff --git a/ast/definitions.scm b/ast/definitions.scm
new file mode 100644
index 0000000..9184b13
--- /dev/null
+++ b/ast/definitions.scm
@@ -0,0 +1,209 @@
+;;; File: ast/definitions.scm   Author: John
+
+;;; this file contains definitions for the named entities in the
+;;; system.  These are used in both the front and back ends of the
+;;; compiler.  These are created early in the compilation process
+;;; (import/export) and filled in during compilation.  Binary interface
+;;; files are just tables mapping names to definitions.
+
+;;; All definitions have these fields for managing name spaces.  All
+;;; names are uniquified; this requires adding `;' to the front of data
+;;; constructors to separate them from type constructors.  Module names
+;;; do not have a `definition' data structure - the `module' structure
+;;; serves the same purpose.
+
+;;; Definitions are found in two places: the symbol tables which are part of
+;;; the module structure and the -ref nodes in the ast structure.  The -ref
+;;; nodes have two fields: a name (from the parser) and a field which will
+;;; point to the associated definition after name resolution.  Name resolution
+;;; happens in a number of different places: top level definitions are
+;;; resolved during import-export, type declarations are resolved during
+;;; type declaration analysis, and everything else is resolved during scoping
+;;; (alpha conversion).  The parser generates pre-resolved -ref nodes when
+;;; parsing some constructs.  These refs denote pre-defined language
+;;; constructs, such as lists, tuples, or prelude functions.
+
+;;; A special set of definitions constitutes the `core' of Haskell.  These
+;;; definitions are pre-allocated and are filled in during the compilation
+;;; of the Prelude.  This allows the bootstrap of the system.
+
+
+;;; All defs require name, unit, and module args to make.
+;;; Other slots should all have appropriate defaults.
+
+(define-struct def
+  (slots
+   ;; the uniquified name (from the definition)
+   (name (type symbol))
+   ;; compilation unit defined in
+   (unit (type symbol))
+   ;; name of the defining module
+   (module (type symbol))
+   ;; used by the closure check
+   (exported? (type bool) (default '#f) (bit #t))
+   ;; for symbols in `core' Haskell; special case for IO
+   (core? (type bool) (default '#f) (bit #t))      
+   ;; Always a core sym.  Used to avoid putting in sym table
+   (prelude? (type bool) (default '#f) (bit #t))
+   ))
+
+
+
+;;; Variable information
+
+(define-struct var
+  (include def)
+  (predicate var?)
+  (slots
+   ;; inferred during type inference
+   (type             (type (maybe ntype))     (default '#f))
+   ;; type affixed by sign-decl or class decl
+   (signature        (type (maybe ntype))     (default '#f))
+   (interface-type   (type (maybe ntype))     (default '#f))
+   ;; most variables have no fixity information.
+   (fixity           (type (maybe fixity))    (default '#f))
+   ;; The following attributes are used by the backend
+   (selector-fn?     (type bool)              (default '#f) (bit #t))
+   (force-strict?    (type bool)              (default '#f) (bit #t))
+   (force-inline?    (type bool)              (default '#f) (bit #t))
+   (toplevel?        (type bool)              (default '#f) (bit #t))
+   (simple?          (type bool)              (default '#f) (bit #t))
+   (strict?          (type bool)              (default '#f) (bit #t))
+   (optimized-refs?  (type bool)              (default '#f) (bit #t))
+   (standard-refs?   (type bool)              (default '#f) (bit #t))
+   (single-ref       (type (maybe int))       (default '#f))
+   (arity            (type int)               (default 0))
+   (referenced       (type int)               (default 0))
+   (value            (type (maybe flic-exp))  (default '#f))
+   (fullname         (type (maybe symbol))    (default '#f))
+   (inline-value     (type (maybe flic-exp))  (default '#f))
+   ;; Only function bindings use these slots
+   (strictness       (type (list bool))       (default '()))
+   (complexity       (type (maybe int))       (default '#f))
+   (optimized-entry  (type (maybe symbol))    (default '#f))
+   (annotations      (type (list annotation-value)) (default '()))
+   (fn-referenced    (type int)               (default 0))
+   (arg-invariant-value  (type (maybe flic-exp))  (default '#f))
+   (arg-invariant?   (type bool)              (default '#f) (bit #t))
+   ))
+  
+
+;;; This defines an individual class method
+
+(define-struct method-var
+  (include var)
+  (predicate method-var?)
+  (slots
+   (class (type class) (uninitialized? #t))
+   (default (type (maybe var)) (uninitialized? #t))
+   (method-signature (type signature) (uninitialized? #t))))
+
+
+;;; A data constructor
+
+(define-struct con
+  (include def)
+  (predicate con?)
+  (slots
+   ;; These slots are initialized in the type declaration phase
+   (arity (type int) (uninitialized? #t))
+   (types (type (list type)) (uninitialized? #t))
+   (slot-strict? (type (list bool)) (default '()))
+   (tag (type int) (uninitialized? #t))
+   (alg (type algdata) (uninitialized? #t))
+   (infix? (type bool) (bit #t) (default '#f))
+   (signature (type ntype) (uninitialized? #t))
+   ;; Assigned during import-export phase
+   (fixity (type (maybe fixity)) (default '#f))
+   (lisp-fns (type t) (default '()))
+   ))
+
+
+;;; Definitions used by the type system.
+
+(define-struct tycon-def
+  (include def)
+  (slots
+   (arity (type integer) (default -1))))
+
+(define-struct synonym
+  (include tycon-def)
+  (predicate synonym?)
+  (slots
+   ;; These slots are explicitly initialized in the type declaration phase.
+   (args (type (list symbol)) (uninitialized? #t))
+   (body (type type) (uninitialized? #t))  ; stored in ast form
+   ))
+
+(define-struct algdata
+  (include tycon-def)
+  (predicate algdata?)
+  (slots
+   ;; These slots are initialized explicitly in the type declaration phase
+   ;; number of constructors
+   (n-constr (type int) (uninitialized? #t)) 
+   (constrs (type (list con)) (uninitialized? #t))
+   (context (type (list context)) (uninitialized? #t))
+   ;; arguments to tycon
+   (tyvars (type (list symbol)) (uninitialized? #t))
+   ;; signature for the type as a whole
+   (signature (type (maybe ntype)) (default '#f))
+   ;; classes this algdata is an instance of
+   (classes (type (list class)) (uninitialized? #t))
+   ;; true if all constructors have 0 arity
+   (enum? (type bool) (bit #t) (uninitialized? #t))
+   ;; true when only constructor
+   (tuple? (type bool) (bit #t) (uninitialized? #t))
+   ;; true for `tuple-syntax' tuples.
+   (real-tuple? (type bool) (bit #t) (uninitialized? #t))
+   ;; instances to derive
+   (deriving (type (list class)) (uninitialized? #t))
+   (export-to-lisp? (type bool) (default '#f) (bit #t))
+   (implemented-by-lisp? (type bool) (default '#f) (bit #t))
+   ))
+
+(define-struct class
+  (include def)
+  (predicate class?)
+  (slots
+   ;; These slots are initialized in the import-export phase
+   (method-vars (type (list method-var)) (uninitialized? #t))
+   ;; These slots are explicitly initialized in the type declaration phase
+   ;; immediate superclasses
+   (super (type (list class)) (uninitialized? #t))
+   ;; all superclasses
+   (super* (type (list class)) (uninitialized? #t))
+   ;; name of class type variable
+   (tyvar (type symbol) (uninitialized? #t))
+   (instances (type (list instance)) (uninitialized? #t))
+   (kind (type (enum standard numeric other)) (uninitialized? #t))
+   (n-methods (type int) (uninitialized? #t))
+   (dict-size (type int) (uninitialized? #t))
+   (selectors (type (list (tuple method-var var))) (uninitialized? #t))
+   ))
+
+;;; Since instances are not named there is no need to include def.  
+
+(define-struct instance
+  (include ast-node)
+  (slots
+   ;; These slots always have initializers supplied with MAKE.
+   (algdata (type algdata))
+   (tyvars (type (list symbol)))
+   (class (type class))
+   (context (type (list context)))
+   (gcontext (type (list (list class))))
+   (dictionary (type var))
+
+   ;; Explicitly initialized during the type declaration phase.
+   (methods (type (list (tuple method-var var))) (uninitialized? #t))
+
+   ;; These slots usually default on creation.
+   (decls (type (list decl)) (default '()))
+   ;; used during verification of derived instances
+   (ok? (type bool) (bit #t) (default #f))
+   ;; marks magically generated tuple instances
+   (special? (type bool) (bit #t) (default #f))
+   (suppress-readers? (type bool) (bit #t) (default #f))
+   ))
+
diff --git a/ast/exp-structs.scm b/ast/exp-structs.scm
new file mode 100644
index 0000000..847723d
--- /dev/null
+++ b/ast/exp-structs.scm
@@ -0,0 +1,386 @@
+;;; File: ast/exp-structs     Author: John
+
+;;; These ast structures define the expression syntax
+
+
+;;; This is simplified; there are additional rules for associativity and
+;;; precedence.
+;;;
+;;; <exp>  -> <lambda-exp>
+;;;        -> <let-exp>
+;;;        -> <if-exp>
+;;;        -> <case-exp>
+;;;        -> <signature-exp>
+;;;        -> <exp> <op> <exp>           ; treated like <fn-app>
+;;;        -> - <exp>
+;;;        -> <fn-app>
+;;;        -> <aexp>
+;;;
+
+(define-struct exp
+  (include ast-node))
+
+
+;;; <lambda-exp> -> \ <apat> ... <apat> -> <exp>
+
+(define-struct lambda
+  (include exp)
+  (slots
+   (pats (type (list pattern)))
+   (body (type exp))))
+
+;;; <let-exp> -> let { <decls> [;] } in <exp>
+
+(define-struct let
+  (include exp)
+  (slots
+   (decls (type (list decl)))
+   (body (type exp))))
+
+;;; <if-exp> -> if <exp> then <exp> else <exp>
+
+(define-struct if
+  (include exp)
+  (slots
+   (test-exp (type exp))
+   (then-exp (type exp))
+   (else-exp (type exp))))
+
+
+;;; <case-exp> -> case <exp> of { <alts> [;] }
+;;;
+;;; <alts>     -> <alt> ; ... ; <alt>
+;;;
+;;; <alt>      -> <pat> -> exp  [where { <decls> [;] } ]
+;;;            -> <pat> <gdpat> [where { <decls> [;] } ]
+
+(define-struct case
+  (include exp)
+  (slots
+   (exp (type exp))
+   (alts (type (list alt)))))
+
+(define-struct alt
+  (include ast-node)
+  (slots
+   (pat (type pattern))
+   ;; defined in valdef-structs
+   (rhs-list (type (list guarded-rhs)))
+   (where-decls (type (list decl)))
+   ;; used internally by cfn
+   (test (type (maybe exp)) (default '#f))
+   ))
+
+;;; <signature-exp> -> <exp> :: [<context> =>] <atype>
+
+(define-struct exp-sign
+  (include exp)
+  (slots
+   (exp (type exp))
+   (signature (type signature))))
+
+
+;;; <fn-app> -> <exp> <aexp>
+
+(define-struct app
+  (include exp)
+  (predicate app?)
+  (slots
+   (fn (type exp))
+   (arg (type exp))))
+
+;;; <aexp> -> <var>                                var-ref
+;;;        -> <con>                                con-ref
+;;;        -> <literal>                            const
+;;;        -> ()                                   constructor is Unit
+;;;        -> ( <exp> )                            
+;;;        -> ( <exp> , ... , <exp> )              constructor is a tuple
+;;;        -> [ <exp> , ... , <exp> ]              list
+;;;        -> <sequence>
+;;;        -> [exp> | <qual> , ... , <qual>]       list-comp
+;;;        -> ( <exp> <op> )                       section-r
+;;;        -> ( <op> <exp> )                       section-l
+;;;
+
+(define-struct aexp
+  (include exp))
+
+
+(define-struct var-ref
+  (include aexp)
+  (predicate var-ref?)
+  (slots
+   (name (type symbol))
+   (var (type def))
+   (infix? (type bool) (bit #t))))
+
+(define-struct con-ref
+  (include aexp)
+  (predicate con-ref?)
+  (slots
+   (name (type symbol))
+   (con (type def))
+   (infix? (type bool) (bit #t))))
+
+(define-struct const
+  (include aexp)
+  (slots
+   (overloaded? (type bool) (default '#t) (bit #t))))
+
+(define-struct integer-const
+  (include const)
+  (predicate integer-const?)
+  (slots
+   (value (type integer))))
+
+(define-struct float-const
+  (include const)
+  (predicate float-const?)
+  (slots
+   (numerator (type integer))
+   (denominator (type integer))
+   (exponent (type integer))))
+
+(define-struct char-const
+  (include const)
+  (predicate char-const?)
+  (slots
+   (value (type char))))
+
+(define-struct string-const
+  (include const)
+  (predicate string-const?)
+  (slots
+   (value (type string))))
+
+(define-struct list-exp
+  (include aexp)
+  (slots
+   (exps (type (list exp)))))
+
+
+;;; <sequence> -> [ <exp> .. ]                  sequence
+;;;            -> [ <exp>, <exp> .. ]           sequence-then
+;;;            -> [ <exp> .. <exp> ]            sequence-to
+;;;            -> [ <exp>, <exp> .. <exp> ]     sequence-then-to
+
+(define-struct sequence
+  (include aexp)
+  (slots
+   (from (type exp))))
+
+(define-struct sequence-to
+  (include aexp)
+  (slots
+   (from (type exp))
+   (to (type exp))))
+
+
+(define-struct sequence-then
+  (include aexp)
+  (slots
+   (from (type exp))
+   (then (type exp))))
+
+(define-struct sequence-then-to
+  (include aexp)
+  (slots
+   (from (type exp))
+   (then (type exp))
+   (to (type exp))))
+
+(define-struct list-comp
+  (include aexp)
+  (slots
+   (exp (type exp))
+   (quals (type (list qual)))))
+
+;;; Op on left
+(define-struct section-l
+  (include aexp)
+  (slots
+   (exp (type exp))
+   (op (type exp))))  ; either con-ref or var-ref
+
+(define-struct section-r
+  (include aexp)
+  (slots
+   (exp (type exp))
+   (op (type exp))))  ; either con-ref or var-ref
+
+;;; <qual> -> <pat> <- <exp>
+;;;        -> <exp>
+
+(define-struct qual
+  (include ast-node))
+
+(define-struct qual-generator
+  (include qual)
+  (slots
+   (pat (type pattern))
+   (exp (type exp))))
+
+(define-struct qual-filter
+  (include qual)
+  (slots
+   (exp (type exp))))
+
+
+;;; This is used as the guard slot in a guarded-rhs to represent lack of a
+;;; guard.  This is the same as True.
+
+(define-struct omitted-guard ; same as True; should print in the guardless form
+  (include exp))
+
+
+;;; These structures are used by the precedence parser.  
+
+(define-struct pp-exp-list  ; list of expressions & ops for the prec parser
+  (include exp)
+  (slots
+   (exps (type (list exp)))))
+
+;; This is a place holder for unary negation in pp-exp expressions.  It is
+;; changed to call the negate function by the prec parser
+
+(define-struct negate
+  (include exp)
+  (predicate negate?))
+
+;; Note: operators are var / con structures with infix? set to #t
+
+;;; The following ast nodes do not directly correspond to Haskell syntax.
+;;; They are generated during internal code transformations.
+
+;;; This returns a number (an Int) associated with the constructor of a
+;;; value.
+
+(define-struct con-number
+  (include exp)
+  (slots
+    (type (type algdata))
+    (value (type exp))))
+
+;;; This selects a value (denoted by the Int in slot) from a data object
+;;; created by a specified constructor.
+
+(define-struct sel
+  (include exp)
+  (slots
+    (constructor (type con))
+    (slot (type int))
+    (value (type exp))))
+
+;;; This returns True if the data value was built with the designated
+;;; constructor
+
+(define-struct is-constructor
+  (include exp)
+  (slots 
+   (constructor (type con))
+   (value (type exp))))
+
+;;; this is for the type checker only.  It turns off
+;;; type checking for the argument.
+
+(define-struct cast
+  (include exp)     
+  (slots 
+   (exp (type exp))))
+
+;; this is used as the body of the let generated by
+;; dependency analysis
+
+(define-struct void  
+  (include exp)
+  (predicate void?))
+  
+
+;;; These structures are for the type checker.  They serve as a placeholder
+;;; for values which will evaluate to methods or dictionaries.
+
+(define-struct placeholder
+  (include exp)
+  (predicate placeholder?)
+  (slots
+   (exp (type (maybe exp)))
+   (tyvar (type ntype))
+   (overloaded-var (type exp))
+   (enclosing-decls (type (list decl)))))
+
+(define-struct method-placeholder
+  (include placeholder)
+  (predicate method-placeholder?)
+  (slots
+   ;; the method to be dispatched
+   (method (type method-var))
+   ))
+
+(define-struct dict-placeholder
+  (include placeholder)
+  (predicate dict-placeholder?)
+  (slots
+   ;; the class of dictionary needed
+   (class (type class))))
+
+(define-struct recursive-placeholder
+  (include exp)
+  (slots
+   (var (type var))
+   (enclosing-decls (type (list decl)))
+   ;; this holds the code associated with recursive
+   ;; functions or variables.  This code instantiates
+   ;; the recursive context if necessary.
+   (exp (type (maybe exp)))
+   ))
+
+;;; This is used in primitive modules only.  It holds the definition of
+;;; a lisp level primitive.
+
+(define-struct prim-definition
+  (include exp)
+  (slots
+   (lisp-name (type symbol))
+   (atts (type (list (tuple symbol t))))))
+
+;;; This is used by the type checker to hang on to the original
+;;; version of a program for message printing.  This is removed by
+;;; the cfn pass.
+
+(define-struct save-old-exp
+  (include exp)
+  (slots
+   (old-exp (type exp))
+   (new-exp (type exp))))
+
+
+;;; This is used for type checking overloaded methods.
+
+(define-struct overloaded-var-ref
+  (include exp)
+  (slots
+    (var (type var))
+    (sig (type ntype))))
+
+
+
+;;; These are used by the CFN.
+
+
+(define-struct case-block
+  (include exp)
+  (slots
+    (block-name (type symbol))
+    (exps       (type (list exp)))))
+
+(define-struct return-from
+  (include exp)
+  (slots
+    (block-name (type symbol))
+    (exp        (type exp))))
+
+(define-struct and-exp
+  (include exp)
+  (slots
+    (exps       (type (list exp)))))
+
diff --git a/ast/modules.scm b/ast/modules.scm
new file mode 100644
index 0000000..e445444
--- /dev/null
+++ b/ast/modules.scm
@@ -0,0 +1,252 @@
+;;;  File: ast/module-structs   Author: John
+
+;;; This contains AST structures which define the basic module structure.
+;;; This is just the skeleton module structure: module, imports, exports,
+;;; fixity, and default decls.
+
+;;; AST nodes defined in the file:
+;;;  module  import-decl  entity  entity-module  entity-var  entity-con
+;;;  entity-class  entity-abbreviated  entity-datatype  fixity-decl
+
+
+
+;;; All AST structs inherit from ast-node.  Not instantiated directly.
+;;; The line-number is a back pointer to the source code.
+
+(define-struct ast-node
+  (type-template ast-td)
+  (slots
+   (line-number (type (maybe source-pointer)) (default '#f))))
+
+(define-struct source-pointer
+  (slots
+   (line (type int))
+   (file (type string))))
+
+;;; <module> -> module <modid> [<exports>] where <body>
+;;;          -> <body>
+;;;
+;;; <exports> -> ( <export>, ... <export> )
+;;;
+;;; <body>   -> { [<impdecls>;] [[<fixdecls>;] <topdecls> [;]] }
+;;;          -> { <impdecls> [;] }
+;;;
+;;; <impdecls> -> <impdecl> ; ... ; <impdecl>
+;;;
+;;; <fixdecls> -> <fix> ; ... ; <fix>
+;;;
+;;; <topdecls> -> <topdecl> ; ... ; <topdecl>
+;;;
+;;; <topdecl> -> <synonym-decl>
+;;;           -> <algdata-decl>
+;;;           -> <class-decl>
+;;;           -> <instance-decl>
+;;;           -> <default-decl>
+;;;           -> <sign-decl>
+;;;           -> <valdef>
+
+;;; The module struct is used to represent the program internally.  Binary
+;;; files containing interface information contain these structures.
+;;; Most compiler passes operate on this structure.  A table maps module
+;;; names to this structure.  Within the module structure, local names are
+;;; mapped to definitions.
+
+;;; Modules are also used to represent interfaces & primitives.
+;;; Some of the module fields may be blank for non-standard modules.
+
+(define-struct module
+  (include ast-node)
+  (slots
+
+    ;; These slots are required.
+
+    (name (type symbol))
+    (type (type (enum standard interface extension)))
+    (prelude? (type bool) (default '#f))  ; True when symbols define the core
+    (interface-module (type (maybe module)) (default '#f))
+        ; link to previously compiled interface
+
+    ;; The unit is filled in by the compilation system
+
+    (unit (type symbol) (default '*undefined*))
+
+    ;; The following slots are defined at parse time.
+    ;; After a module is dumped, these are all empty.
+
+    ;; <exports>, list of exported names
+    (exports (type (list entity)) (default '()))
+    ;; <impdecls>, local import decls
+    (imports (type (list import-decl)) (default '()))
+    ;; <fixdecls>, local fixity decls
+    (fixities (type (list fixity-decl)) (default '()))
+    ;; <synonym-decl>, local type synonym decls
+    (synonyms (type (list synonym-decl)) (default '()))
+    ;; <algdata-decl>, local data decls
+    (algdatas (type (list data-decl)) (default '()))
+    ;; <class-decl>, local class decls
+    (classes (type (list class-decl)) (default '()))
+    ;; <instance-decl>, local instance decls
+    (instances (type (list instance-decl)) (default '()))
+    ;; <default-decl>, default types
+    (annotations (type (list annotation)) (default '()))
+    (default (type (maybe default-decl)) (default '#f))
+    ;; signatures, pattern, function bindings
+    (decls (type (list decl)) (default '()))
+
+    ;; These slots are filled in by the type-declaration-analysis phase
+    ;; after conversion to definition form
+
+    (synonym-defs (type (list synonym)) (default '()))
+    (alg-defs (type (list algdata)) (default '()))
+    (class-defs (type (list class)) (default '()))
+    (instance-defs (type (list instance)) (default '()))
+
+
+    ;; The import-export stage creates a set of tables which are used for
+    ;; imports and exports and local name resolution.  All of these tables
+    ;; are indexed by names.  These tables always deal with definitions.
+    ;; Every variable, type, class, instance, and synonym is converted into
+    ;; a definition.  Blank definitions are created early (in import/export)
+    ;; and different aspects of the definitions are filled in as compilation
+    ;; progresses.  The type-related definitions are filled in during
+    ;; declaration analysis.  Only definitions are saved when a module is
+    ;; written to a file; the ast information is not retained.
+
+    ;; Used to avoid copy of Prelude symbols.
+    (uses-standard-prelude? (type bool) (default '#f))
+    ;; maps symbols in scope to definitions
+    (symbol-table (type (table symbol def)) (default (make-table)))
+    ;; maps names onto groups.
+    (export-table (type (table symbol (list (tuple symbol def))))
+		  (default (make-table)))
+    ;; Note: symbol groups are found in classes and data decls.  An
+    ;; entire group is denoted by the (..) abbreviation in an entity.
+    ;; maps local names onto declared fixities
+    (fixity-table (type (table symbol fixity)) (default (make-table)))
+    ;; maps defs to local names
+    (inverted-symbol-table (type (table symbol symbol)) (default (make-table)))
+    ;; Used internally during import-export
+    (fresh-exports (type (list (list (tuple symbol def)))) (default '()))
+    (exported-modules (type (list module)) (default '()))
+
+    ;; These slots are used to support incremental compilation.
+
+    ;; vars defined in the module
+    (vars (type (list var)) (default '()))
+    ;; for incremental compilation
+    (inherited-env (type (maybe module)) (default '#f))
+    ;; The following slots are for interfaces only
+    ;; These store renaming mappings defined in the import decls of
+    ;; the interface.  Maps local name onto (module, original name).
+    (interface-imports (type (list (tuple symbol (typle symbol symbol))))
+		       (default '()))
+    (interface-codefile (type (list string)) (default '()))
+    ))
+
+
+;;; <impdecl> -> import <modid> [<impspec>] [renaming <renamings>]
+;;;
+;;; <impspec> -> ( <import> , ... , <import> )
+;;;           -> hiding ( <import> , ... , <import> )
+;;;
+;;; <import>  -> <entity>
+;;;
+;;; <renamings> -> ( <renaming>, ... , <renaming> )
+;;;
+;;; <renaming>  -> <varid> to <varid>
+;;;             -> <conid> to <conid>
+
+(define-struct import-decl
+  (include ast-node)
+  (slots
+   ;; <modid>, module imported from
+   (module-name (type symbol))
+   ;; all: import Foo; by-name: import Foo(x) import Foo()
+   (mode (type (enum all by-name)))
+   ;; <impspec>, for mode = all this is the hiding list
+   (specs (type (list entity)))
+   ;; <renamings>, alist maps symbol -> symbol
+   (renamings (type (list renaming)))
+   ;; place to put corresponding module-ast; filled in by import/export.
+   (module (type module) (uninitialized? #t))
+   ))
+
+
+;;; <entity> -> <modid> ..                              entity-module
+;;           -> <varid>                                 entity-var
+;;;          -> <tycon>                                 entity-con
+;;;          -> <tycon> (..)                            entity-abbreviated
+;;;          -> <tycon> ( <conid> , ... , <conid>)      entity-datatype
+;;;          -> <tycls> (..)                            entity-abbreviated
+;;;                note: this is indistinguishable from tycon (..)
+;;;          -> <tycls> ( <varid> , ... , <varid>)      entity-class
+
+(define-struct entity
+  (include ast-node)
+  (slots
+    (name (type symbol))))
+
+(define-struct entity-module
+  (include entity)
+  (predicate entity-module?)
+  (slots
+    ;; a direct pointer to the referenced module added later
+    (module (type module) (uninitialized? #t))
+    ))
+
+(define-struct entity-var
+  (include entity)
+  (predicate entity-var?))
+
+(define-struct entity-con
+  (include entity)
+  (predicate entity-con?))
+
+(define-struct entity-abbreviated
+  (include entity)
+  (predicate entity-abbreviated?))
+
+(define-struct entity-class
+  (include entity)
+  (predicate entity-class?)
+  (slots
+    (methods (type (list symbol)))))
+
+(define-struct entity-datatype
+  (include entity)
+  (predicate entity-datatype?)
+  (slots
+    (constructors (type (list symbol)))))
+
+(define-struct renaming
+  (include ast-node)
+  (slots
+    (from (type symbol))
+    (to (type symbol))
+    (referenced? (type bool))))
+		
+
+;;; <fix> -> infixl [<digit>] <ops>
+;;;       -> infixr [<digit>] <ops>
+;;;       -> infix  [<digit>] <ops>
+;;;
+;;; <ops> -> <op> , ... , <op>
+;;;
+;;; <op>  -> <varop>
+;;;       -> <conop>
+
+;;; Not sure where to put this decl - jcp
+(define-struct fixity
+  (include ast-node)
+  (slots
+    (associativity (type (enum l n r)))
+    (precedence (type int))))
+
+(define-struct fixity-decl
+  (include ast-node)
+  (slots
+    (fixity (type fixity))
+    ;; <ops>
+    (names (type (list symbol)))
+    ))
+
diff --git a/ast/predicates.scm b/ast/predicates.scm
new file mode 100644
index 0000000..20dfc13
--- /dev/null
+++ b/ast/predicates.scm
@@ -0,0 +1,18 @@
+;;; predicates.scm -- various useful predicates, collected from other places
+;;;
+;;; author :  Sandra Loosemore
+;;; date   :  19 Mar 1992
+;;;
+
+
+;;; Some predicates on patterns (used by CFN)
+
+(define-integrable (var-or-wildcard-pat? p)
+  (or (is-type? 'wildcard-pat p)
+      (is-type? 'var-pat p)))
+
+(define-integrable (irrefutable-pat? p)
+  (or (is-type? 'wildcard-pat p)
+      (is-type? 'var-pat p)
+      (is-type? 'irr-pat p)))
+
diff --git a/ast/tc-structs.scm b/ast/tc-structs.scm
new file mode 100644
index 0000000..1433082
--- /dev/null
+++ b/ast/tc-structs.scm
@@ -0,0 +1,62 @@
+;;; These structures are used by the type checker for the internal
+;;; representation of type information.  These are referred to in
+;;; general as `ntype' structures.  Conversions are required between
+;;; ast types and ntypes.
+
+(define-struct ntype
+  (include ast-node))
+
+(define-struct ntycon
+  (include ntype)
+  (predicate ntycon?)
+  (slots
+   (tycon (type def))
+   (args (type (list ntype)))))
+
+(define-struct ntyvar
+  (include ntype)
+  (predicate ntyvar?)
+  (slots
+   ;; non-instantiated tyvars use #f for a value.
+   (value (type (maybe ntype)))
+   ;; could be encoded in value.
+   (context (type (list class)) (default ()))
+   (read-only? (type bool) (default #f) (bit #t))
+   (dict-params (type (list (tuple valdef (list (tuple class var))))))
+   ))
+
+;;; This is used only at the top level of a type during letrec type
+;;; checking.
+
+(define-struct recursive-type
+  (include ntype)
+  (predicate recursive-type?)
+  (slots
+   (type (type ntype))
+   (placeholders (type (list exp)))))
+
+;;; Gtypes are generalized types which can be copied quickly & stored in
+;;; interfaces.  They may contain monomorphic type variables which will not
+;;; be copied.
+
+(define-struct gtype
+  (include ntype)
+  (predicate gtype?)
+  (slots
+   (context (type (list (list class))))
+   (type (type ntype))))
+
+;;; These tyvars just index a list of pre-allocated tyvars.
+
+(define-struct gtyvar
+  (include ntype)
+  (predicate gtyvar?)
+  (slots
+   (varnum (type int))))
+
+(define-struct const-type
+  (include ntype)
+  (predicate const-type?)
+  (slots
+   (type (type ntype))))
+
diff --git a/ast/type-structs.scm b/ast/type-structs.scm
new file mode 100644
index 0000000..0ba4705
--- /dev/null
+++ b/ast/type-structs.scm
@@ -0,0 +1,159 @@
+;;;  File: ast/type-structs   Author: John
+
+;;; This contains AST structures for the type-related declarations,
+;;; including `data', `class', `instance', and `type' decls.  Basic type
+;;; syntax is also defined here.
+
+;;; Structures declared here:
+;;;  type  type-var  type-con  context  signature  synonym-decl
+;;;  data-decl  class-decl  instance-decl
+
+
+;;; <type>  -> <atype>
+;;;         -> <type> -> <type>                              ***
+;;;         -> <tycon> <atype> ... <atype>                   tycon
+;;;
+;;; <atype> -> <tyvar>                                       tyvar
+;;;         -> <tycon>                                       tycon
+;;;         -> ()                                            ***
+;;;         -> ( <type> )                                    grouping syntax
+;;;         -> ( <type> , ... , <type>)                      ***
+;;;         -> [ <type> ]                                    ***
+;;; *** Special <tycon> cases
+
+;;; Type with no context - either a tyvar or a constructor
+(define-struct type
+  (include ast-node))
+
+(define-struct tyvar
+  (include type)
+  (predicate tyvar?)
+  (slots
+   (name (type symbol))))
+
+(define-struct tycon
+  (include type)
+  (predicate tycon?)
+  (slots
+   (name (type symbol))
+   (def (type def))
+   (args (type (list type)))))
+
+;;; <signature> -> [<context> =>] <type>
+;;;
+;;; <context> -> <class>
+;;;           -> (<class> , ... , <class>)
+
+;;; A single class, variable pair
+(define-struct context
+  (include ast-node)
+  (slots
+   (class (type class-ref))
+   (tyvar (type symbol))))
+
+
+;;; Type + context
+(define-struct signature
+  (include type)
+  (slots
+   (context (type (list context)))
+   (type (type type))))
+
+
+;;; Major type declarations.  Note: no explicit structures for <simple>
+;;; or <inst> are needed - these are just special cases of type.
+
+;;; <synonym-decl> -> type <simple> = <type>
+;;;
+;;; <simple> -> <tycon> <tyvar> ... <tyvar>
+
+(define-struct synonym-decl
+  (include ast-node)
+  (slots
+   (simple (type type))
+   (body (type type))))
+
+
+;;; <aldata-decl> -> data [<context> => ] <simple> = <constrs> 
+;;;                    [deriving <tycls> | ( <tycls> , ... <tycls>) ]
+;;;
+;;; <constrs>     -> <constr> | ... | <constr>
+;;;
+
+(define-struct data-decl
+  (include ast-node)
+  (slots
+   (context (type (list context)))
+   (simple (type type))
+   (constrs (type (list constr)))  
+   (deriving (type (list class-ref)))
+   (annotations (type (list annotation-value)))))
+
+;;; <constr>      -> <con> <atype> ... <atype>
+;;;               -> <type> <conop> <type>
+
+(define-struct constr
+  (include ast-node)
+  (slots
+   (constructor (type con-ref))  ; this con-ref has an infix? flag.
+   (types (type (list (tuple type (list annotation-value)))))))
+
+
+;;; <class-decl> -> class [<context> => ] <class> [where { <cbody> [;] } ]
+;;;
+;;; <cbody> -> [<csigns> ; ] [ <valdefs> ]
+;;;
+;;; <csigns> -> <signdecl> ; ... ; <signdecl>
+
+(define-struct class-decl
+  (include ast-node)
+  (slots
+   (class (type class-ref))
+   (super-classes (type (list context)))
+   (class-var (type symbol))              ; name of type var for this class in decls
+   (decls (type (list decl)))))           ; <cbody>
+
+
+;;; <instance-decl> -> instance [<context> =>] <tycls> <inst>
+;;;                      [where { <valdefs> [;] } ]
+;;;
+;;; <inst> -> <tycon>
+;;;        -> ( <tycon> <tyvar> ... <tyvar> )
+;;;        -> ( <tyvar> , ... , <tyvar>)
+;;;        -> ()
+;;;        -> [ <tyvar> ]
+;;;        -> ( <tyvar> -> <tyvar>)
+;;;
+
+(define-struct instance-decl
+  (include ast-node)
+  (slots
+   ;; <context>
+   (context (type (list context)))
+   ;; <tycls>
+   (class (type class-ref))
+   ;;
+   (simple (type type))
+   ;; <valdefs>
+   (decls (type (list valdef)))
+   ))
+
+
+
+;;; <default-decl> -> default <type>
+;;;                -> default ( <type> , ... , <type> )
+
+(define-struct default-decl
+  (include ast-node)
+  (slots
+   (types (type (list type)))))
+
+
+;;; <tycls> -> <aconid>
+
+(define-struct class-ref
+  (include ast-node)
+  (slots
+   (name (type symbol))
+   (class (type def))))
+
diff --git a/ast/valdef-structs.scm b/ast/valdef-structs.scm
new file mode 100644
index 0000000..eb0dc88
--- /dev/null
+++ b/ast/valdef-structs.scm
@@ -0,0 +1,276 @@
+;;; File: ast/valdef-structs    Author: John
+
+;;; Ast structure for local declarations
+
+;;; <decl> -> <signdecl>
+;;;        -> <valdef>
+
+;;; decl contains value declarations and type signatures.(
+;;; type related decls are topdecls and are separated from
+;;; these decls.
+
+(define-struct decl   
+  (include ast-node))
+                      
+
+
+;;; <signdecl> -> <vars> :: [<context> =>] <type>
+;;;
+;;; <vars>     -> <var> , ... , <var>
+;;;
+
+(define-struct signdecl ; this affixes a signature to a list of variables
+  (include decl)
+  (predicate signdecl?)
+  (slots
+   (vars (type (list var-ref)))
+   (signature (type signature))))
+
+;;; This is introduced into decl lists by dependency analysis
+(define-struct recursive-decl-group
+  (include decl)
+  (slots
+   ;; none of these are recursive decl groups
+   (decls (type (list decl)))
+   ))
+
+;;; <valdef>  -> <lhs> = <exp> [where { <decls> [;] }]
+;;;           -> <lhs> <gdrhs> [where { <decls> [;] }]
+;;;
+;;; <lhs>     -> <apat>
+;;;           -> <funlhs>
+;;;
+;;; <funlhs>  -> <afunlhs>
+;;;           -> <pat> <varop> <pat>
+;;;           -> <lpat> <varop> <pat>
+;;;           -> <pat> <varop> <rpat>
+;;;
+;;; <afunlhs> -> <var> <apat>
+;;;           -> ( <funlhs> ) <apat>    (infix operator with more than 2 args)
+;;;           -> <afunlhs> <apat>       (multiple argument pattern)
+
+(define-struct valdef  ; this defines values.
+  (include decl)
+  (predicate valdef?)
+  (slots
+   ;; this pattern contains all new variables defined.
+   ;; For a function definition the pattern will always
+   ;; be a simple variable.
+   (lhs (type pattern))
+   ;; this is a list of right hand sides.
+   ;; for a pattern definition, this list is always a singleton.  For
+   ;; a function definition, there is a member for every successive
+   ;; alternative for the function.
+   (definitions (type (list single-fun-def)))
+   ;; this is used internally by dependency analysis
+   (depend-val (type int) (uninitialized? #t))
+   ;; this is filled in by the type phase
+   (dictionary-args (type (list var)) (uninitialized? #t))
+   ;; used for defaulting
+   (module (type symbol) (default '|Prelude|))
+   ))
+
+(define-struct single-fun-def
+  (include ast-node)
+  (slots
+   ;; this list is always empty for pattern definition
+   ;; and always non-empty for function definition.
+   ;; The length of this list is the arity of the function.
+   ;; All single-fun-defs for a function have the same arity.
+   (args (type (list pattern)))
+   ;; <gdrhs>, this contains a list of guard , expression pairs
+   (rhs-list (type (list guarded-rhs)))
+   ;; this contains declarations local to the
+   ;; single fun def.  It scopes over the args.  The
+   ;; guarded-rhs may refer to these values.
+   (where-decls (type (list decl)))
+   ;; true when declared in infix style.  Used for printing
+   ;; and to check precs in prec parsing.
+   (infix? (type bool) (bit #t))
+   ))
+
+
+
+;;; <gdrhs>   -> <gd> = <exp> [<gdrhs>]
+;;;
+;;; <gd>      -> | <exp>
+
+(define-struct guarded-rhs ; a single guarded expression.  A special expression
+  (include ast-node)
+  (slots
+   ;; node - omitted-guard - is used when no guard given
+   (guard (type exp))
+   (rhs (type exp))))
+
+
+;;; Some examples of the above:
+;;; (a,b) | z>y = (z,y)
+;;;       | otherwise = (1,2)
+;;;   where z = x-2
+;;;
+;;;  valdef:
+;;;    lhs = (a,b)
+;;;    definitions =
+;;;       [single-fun-def:
+;;;         args = []
+;;;         rhs-list = [guarded-rhs: guard = z>y
+;;;                                  rhs = (z,y),
+;;;                     guarded-rhs: guard = otherwise
+;;;                                  rhs = (1,2)]
+;;;         where-decls = [valdef: lhs = z
+;;;                                definitions =
+;;;                                   [single-fun-def:
+;;;                                      args = []
+;;;                                      rhs-list = [guarded-rhs:
+;;;                                                    guard = omitted-guard
+;;;                                                    exp = x-2]
+;;;                                      where-decls = []]]]
+;;;
+;;;  fact 0 = 1
+;;;  fact (n+1) = (n+1)*fact n
+;;;
+;;;  valdef:
+;;;    lhs = fact
+;;;    definitions =
+;;;       [single-fun-def:
+;;;         args = [0]
+;;;         rhs-list = [guarded-rhs: guard = omitted-guard
+;;;                                  rhs = 1]
+;;;         where-decls = [],
+;;;        single-fun-def:
+;;;         args = [n+1]
+;;;         rhs-list = [guarded-rhs: guard = omitted-guard
+;;;                                  rhs = (n+1)*fact n]
+;;;         where-decls = []]
+
+
+
+
+;;; Definitions for patterns
+
+;;; This is a simplification; the real syntax is complicated by
+;;; rules for precedence and associativity.
+;;;
+;;; <pat>   -> <pat> <conop> <pat>           pcon
+;;;         -> <pat> + <integer>             plus-pat
+;;;         -> - <integer-or-float>          *** ???  const-pat?
+;;;         -> <apat>
+;;;         -> <con> <apat> .... <apat>      pcon
+;;;
+;;; <apat>  -> <var>                         var-pat
+;;;         -> <var> @ <apat>                as-pat
+;;;         -> <con>                         *** ??? var-pat?
+;;;         -> <literal>                     const-pat
+;;;         -> _                             wildcard-pat
+;;;         -> ()                            pcon special case
+;;;         -> ( <pat> )                     (grouping syntax)
+;;;         -> ( <pat> , ... , <pat> )       pcon special case
+;;;         -> [ <pat> , ... , <pat> ]       list-pat
+;;;         -> ~ <apat>                      irr-pat
+
+(define-struct pattern
+  (include ast-node))
+
+(define-struct apat
+  (include pattern))
+
+(define-struct as-pat  ;; var@pat
+  (include apat)
+  (slots
+   (var (type var-ref))
+   (pattern (type pattern))))
+
+(define-struct irr-pat ;; ~pat
+  (include apat)
+  (slots
+   (pattern (type pattern))))
+
+(define-struct var-pat  ;; v
+  (include apat)
+  (predicate var-pat?)
+  (slots
+   (var (type var-ref))))
+
+(define-struct wildcard-pat  ;; _
+  (include apat)
+  (predicate wildcard-pat?))
+
+(define-struct const-pat  ;; literal
+  (include apat)
+  (predicate const-pat?)
+  (slots
+   (value (type const))
+   ;; this is the code that actually performs the match.
+   ;; it's filled in by type phase.
+   (match-fn (type exp) (uninitialized? #t))))
+
+(define-struct plus-pat  ;; p+k
+  (include pattern)
+  (slots
+   (pattern (type pattern))
+   (k (type integer))
+   ;; code to check for match, filled in by type phase
+   (match-fn (type exp) (uninitialized? #t))
+   ;; code to bind result, filled in by type phase
+   (bind-fn (type exp) (uninitialized? #t))
+   ))
+
+(define-struct pcon      ;; con pat1 pat2 ...
+  (include pattern)      ;; pat1 con pat2
+  (predicate pcon?)
+  (slots
+   (name (type symbol))
+   (con (type def))
+   (pats (type (list pattern)))
+   (infix? (type bool) (bit #t))))
+
+(define-struct list-pat   ;; [p1,p2,...]
+  (include apat)
+  (slots
+   (pats (type (list pattern)))))
+
+;;; The following structs deal with prec parsing of patterns.
+
+(define-struct pp-pat-list
+  (include pattern)
+  (slots
+   (pats (type (list pattern)))))
+
+(define-struct pp-pat-plus
+  (include pattern)
+  (predicate pp-pat-plus?))
+
+(define-struct pp-pat-negated
+  (include pattern)
+  (predicate pp-pat-negated?))
+
+
+
+;;; Structs for annotations
+
+(define-struct annotation
+  (include decl)
+  (predicate annotation?))
+
+(define-struct annotation-decl
+  (include annotation)
+  (predicate annotation-decl?)
+  (slots
+   (names (type (list symbol)))
+   (annotations (type (list annotation-value)))))
+
+(define-struct annotation-value
+  (include annotation)
+  (predicate annotation-value?)
+  (slots
+   (name (type symbol))
+   (args (type (list t)))))
+
+;;; This is a list of annotations placed in where decls lists in the same
+;;; manner a signdecls.
+
+(define-struct annotation-decls
+  (include annotation)
+  (predicate annotation-decls?)
+  (slots
+    (annotations (type (list annotation)))))