diff options
Diffstat (limited to 'ast')
| -rw-r--r-- | ast/README | 29 | ||||
| -rw-r--r-- | ast/ast-td.scm | 20 | ||||
| -rw-r--r-- | ast/ast.scm | 33 | ||||
| -rw-r--r-- | ast/definitions.scm | 209 | ||||
| -rw-r--r-- | ast/exp-structs.scm | 386 | ||||
| -rw-r--r-- | ast/modules.scm | 252 | ||||
| -rw-r--r-- | ast/predicates.scm | 18 | ||||
| -rw-r--r-- | ast/tc-structs.scm | 62 | ||||
| -rw-r--r-- | ast/type-structs.scm | 159 | ||||
| -rw-r--r-- | ast/valdef-structs.scm | 276 |
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))))) |