-- Atze Dijkstra, 20051123: adapted to shuffle format, for stepwise use, extended to cater for EH extensions -- Andres Loeh, May 21, 2002 -- Read using a monospaced font! -- At some places we still have to look at, -- a "-- ToDo:" comment is inserted DATA AGItf | AGItf module : Module DATA Module | Module range : Range name : MaybeName fileheaderpragmas : Pragmas exports : MaybeExports body : Body TYPE Exports = [ Export ] TYPE MaybeExports = MAYBE Exports DATA Export | Variable range : Range name : Name | TypeOrClass range : Range name : Name names : MaybeNames -- constructors or field names or class methods | TypeOrClassComplete range : Range name : Name | Module range : Range name : Name -- this is a module name -- Since the parser cannot distinguish between types or constructors, -- or between types and type classes, we do not have different cases (yet?). DATA Body | Body range : Range importdeclarations : ImportDeclarations declarations : Declarations TYPE ImportDeclarations = [ ImportDeclaration ] DATA ImportDeclaration | Import range : Range qualified : Bool name : Name asname : MaybeName importspecification : MaybeImportSpecification | Empty range : Range SET AllImportDeclaration = ImportDeclaration ImportDeclarations TYPE MaybeImportSpecification = MAYBE ImportSpecification DATA ImportSpecification | Import range : Range hiding : Bool imports : Imports SET AllImportSpecification = ImportSpecification MaybeImportSpecification TYPE Imports = [ Import ] DATA Import | Variable range : Range name : Name | TypeOrClass range : Range name : Name names : MaybeNames -- constructors or field names or class methods | TypeOrClassComplete range : Range name : Name -- cf. Export SET AllTopLevel = Module Body SET AllModule = AllTopLevel AllImportDeclaration Import Imports AllImportSpecification Export Exports MaybeExports SET AllModuleDeclaration = AllModule AllDeclaration TYPE MaybeDeclarations = MAYBE Declarations TYPE Declarations = [ Declaration ] DATA Declaration {- *** -} | FunctionBindings {- *** -} range : Range bindings : FunctionBindings -- should all be for the same function | PatternBinding range : Range pattern : Pattern righthandside : RightHandSide | TypeSignature range : Range names : Names type : Type -- may have context | Fixity range : Range fixity : Fixity priority : {Maybe Int} operators : Names -- A fusion declaration 'fuse f' triggers fusion behavior (inlining, elimination of build/unbuild pairs) for the body of 'f' | FusionDeclaration range : Range fusename : Name -- with : Name -- A fusion conversion declaration 'convert g,h' marks this combi to be a build/unbuild pair, to be eliminated by fusion (of 'f' above). -- Checked type constraint: g :: a->b, h :: b->a, i.e. they should be eachothers inverse. | FusionConversion range : Range absname : Name conname : Name | Empty range : Range | Data {- *** -} range : Range context : ContextItems typelefthandside : TypeLeftHandSide constructors : Constructors derivings : Derivings | Newtype range : Range context : ContextItems typelefthandside : TypeLeftHandSide constructors : Constructor -- has only one field, no strictness derivings : Derivings | GADT range : Range context : ContextItems typelefthandside : TypeLeftHandSide constructors : Constructors derivings : Derivings | KindSignature range : Range names : Names kind : Kind | ForeignImport range : Range callconvention : FFIWay safety : {Maybe String} importname : {Maybe String} name : Name type : Type | ForeignExport range : Range callconvention : FFIWay exportname : {Maybe String} name : Name type : Type | Class range : Range context : ContextItems -- is a "simple" context typelefthandside : TypeLeftHandSide -- simpletype : SimpleType dependencies : FunctionalDependencies where : MaybeDeclarations -- cannot have everything | Instance range : Range instVariant : InstVariant maybeinstancename : MaybeName useimplicitly : Bool context : ContextItems -- is a "simple" context -- name : Name -- types : Types type : Type where : MaybeDeclarations -- cannot have everything | InstanceUseImplicitly range : Range expression : Expression -- name : Name -- types : Types type : Type | Default range : Range name : MaybeName types : Types -- should be instances of Num | Type range : Range typelefthandside : TypeLeftHandSide -- simpletype : SimpleType type : Type | Pragma range : Range pragma : Pragma | Module range : Range name : MaybeName exports : MaybeExports TYPE FunctionalDependencies = [ FunctionalDependency ] DATA FunctionalDependency | Dependency range : Range fromtypevariables : Names totypevariables : Names TYPE Derivings = [ Deriving ] DATA Deriving | Deriving range : Range maybeinstancename : MaybeName useimplicitly : Bool name : Name SET AllDeriving = Deriving Derivings SET AllDeclarationPlain = Declaration Declarations MaybeDeclarations SET AllDeclaration = AllDeclarationPlain FunctionalDependency FunctionalDependencies AllDeriving TYPE Pragmas = [ Pragma ] DATA Pragma | Language range : Range pragmas : Names | OptionsUHC range : Range options : {String} | Derivable range : Range className : Name fieldName : Name defaultName : Name | ExcludeIfTarget range : Range targetNames : {[String]} | CHR range : Range chrRules : {String} SET AllPragma = Pragma Pragmas TYPE Kinds = [ Kind ] DATA Kind {- *** -} | NormalApplication {- *** -} range : Range function : Kind arguments : Kinds | InfixApplication {- *** -} range : Range leftKind : Kind operator : Kind rightKind : Kind | Constructor {- *** -} range : Range name : Name | Parenthesized range : Range kind : Kind | Variable {- *** -} range : Range name : Name | Forall range : Range kindvariables : Names kind : Kind | Annotate range : Range annotation : KindAnnotation kind : Kind SET AllKind = Kind Kinds KindAnnotation TYPE Types = [ Type ] TYPE MaybeType = MAYBE Type DATA Type {- *** -} | NormalApplication {- *** -} range : Range function : Type arguments : Types | InfixApplication {- *** -} range : Range leftType : Type operator : Type rightType : Type | InfixApplicationChainTop range : Range type : Type | Constructor {- *** -} range : Range name : Name | Parenthesized range : Range type : Type | SectionApplication range : Range leftType : MaybeType operator : Type rightType : MaybeType | Annotate range : Range annotation : TypeAnnotation type : Type | Wildcard range : Range | MonoWildcard range : Range | Variable {- *** -} range : Range name : Name | NamedWildcard range : Range name : Name | Forall range : Range typevariables : Names type : Type | Exists range : Range typevariables : Names type : Type | RowUpdate range : Range type : Type rowTypeUpdates : RowTypeUpdates | RowEmpty range : Range | RowRecUpdate range : Range type : Type rowTypeUpdates : RowTypeUpdates | RowRecEmpty range : Range | RowSumUpdate range : Range type : Type rowTypeUpdates : RowTypeUpdates | RowSumEmpty range : Range | Qualified range : Range context : ContextItems type : Type | TupleConstructor {- *** -} range : Range arity : Int TYPE ContextItems = [ ContextItem ] DATA ContextItem | Class range : Range name : Name -- that is the class types : Types -- in Haskell 98, this is only one type | Forall range : Range typevariables : Names context : ContextItem | Arrow range : Range argument : ContextItem result : ContextItem | Implicits range : Range | NoImplicits range : Range | RowLacksLabel range : Range rowvariable : Name name : Name | Equal range : Range type1 : Type type2 : Type SET AllContextItem = ContextItem ContextItems TYPE Constructors = [ Constructor ] DATA Constructor | Constructor range : Range constructor : Name types : Types | Infix range : Range leftType : Type constructorOperator : Name rightType : Type | Record range : Range constructor : Name fieldDeclarations : FieldDeclarations | Contexted range : Range context : ContextItems constructor : Constructor | GADTFunction range : Range constructor : Name type : Type SET AllConstructor = Constructor Constructors TYPE FieldDeclarations = [ FieldDeclaration ] DATA FieldDeclaration | FieldDeclaration range : Range names : Names type : Type SET AllFieldDeclaration = FieldDeclaration FieldDeclarations SET AllType = Type Types MaybeType TypeAnnotation AllConstructor TypeLeftHandSide AllFieldDeclaration AllRowTypeUpdate AllContextItem TYPE Expressions = [ Expression ] TYPE MaybeExpression = MAYBE Expression DATA Expression {- *** -} | Literal {- *** -} range : Range literal : Literal | Variable {- *** -} range : Range name : Name | Constructor {- *** -} range : Range name : Name | TupleConstructor {- *** -} range : Range arity : Int | Parenthesized range : Range expression : Expression | NormalApplication {- *** -} range : Range function : Expression arguments : Expressions | SectionApplication range : Range leftExpression : MaybeExpression operator : Expression rightExpression : MaybeExpression | InfixApplication range : Range leftExpression : Expression operator : Expression rightExpression : Expression | InfixApplicationChainTop range : Range expression : Expression | Lambda {- *** -} range : Range patterns : Patterns expression : Expression | Let {- *** -} range : Range isStrict : Bool declarations : Declarations expression : Expression | Tuple range : Range expressions : Expressions | Typed range : Range expression : Expression type : Type | Negate range : Range expression : Expression | Annotate range : Range annotation : ExpressionAnnotation expression : Expression | ImpredicativeApplication {- *** -} range : Range function : Expression arguments : Expressions | If range : Range guardExpression : Expression thenExpression : Expression elseExpression : Expression | Case {- *** -} range : Range expression : Expression alternatives : Alternatives | List range : Range expressions : Expressions | Enum range : Range from : Expression then : MaybeExpression to : MaybeExpression | Comprehension range : Range expression : Expression qualifiers : Qualifiers | RecordConstruction range : Range name : Name recordExpressionBindings : RecordExpressionBindings | RecordUpdate range : Range expression : Expression recordExpressionBindings : RecordExpressionBindings | RowRecordUpdate range : Range expression : Expression rowRecordExpressionUpdates : RowRecordExpressionUpdates | RowRecordEmpty range : Range | RowRecordSelect range : Range expression : Expression name : Name | Do range : Range statements : Statements | ImplicitApplication range : Range function : Expression arguments : ContextedExpressions | ImplicitLambda range : Range patterns : ContextedPatterns expression : Expression -- Representation examples (ranges are skipped): -- -- o "(+) 2 3" as -- -- Expression_NormalApplication -- (Expression_SectionApplication -- Nothing (Name_Operator [] "+") Nothing) -- [Expression_Literal (Literal_Int "2") -- ,Expression_Literal (Literal_Int "3")] -- -- ToDo: Now that we distinguish operators from identifiers, is -- there a good reason not to say -- -- Expression_NormalApplication -- (Expression_Variable (Name_Operator [] "+")) -- [Expression_Literal (Literal_Int "2") -- ,Expression_Literal (Literal_Int "3")] -- -- o "(+3) 2" as -- -- Expression_NormalApplication -- (Expression_SectionApplication -- Nothing (Name_Operator [] "+") -- (Just (Expression_Literal (Literal_Int "3")))) -- [Expression_Literal (Literal_Int "2")] -- -- o "(2+) 3" as -- -- Expression_NormalApplication -- (Expression_SectionApplication -- (Just (Expression_Literal (Literal_Int "2"))) -- (Name_Operator [] "+") Nothing) -- [Expression_Literal (Literal_Int "3")] -- -- o "2 + 3" as -- -- Expression_InfixApplication -- (Just (Expression_Literal (Literal_Int "2"))) -- (Name_Operator [] "+") -- (Just (Expression_Literal (Literal_Int "3"))) -- -- o "mod 5 2" as -- -- Expression_NormalApplication -- (Expression_Variable (Name_Identifier [] "mod")) -- [Expression_Literal (Literal_Int "5") -- ,Expression_Literal (Literal_Int "3")] -- -- o "(`mod` 2) 5" as -- -- Expression_NormalApplication -- (Expression_SectionApplication -- Nothing (Name_Identifier [] "mod") -- (Just (Expression_Literal (Literal_Int "2")))) -- [Expression_Literal (Literal_Int "5")] -- -- o "(5 `mod`) 2" as -- -- Expression_NormalApplication -- (Expression_SectionApplication -- (Just (Expression_Literal (Literal_Int "5"))) -- (Name_Identifier [] "mod") Nothing) -- [Expression_Literal (Literal_Int "2")] -- -- o "(mod 5) 2" as -- -- Expression_NormalApplication -- (Expression_Parenthesized -- (Expression_NormalApplication -- (Expression_Variable (Name_Identifier [] "mod")) -- [Expression_Literal (Literal_Int "5")])) -- [Expression_Literal (Literal_Int "2")] -- -- o "5 `mod` 2" as -- -- Expression_InfixApplication -- (Just (Expression_Literal (Literal_Int "5"))) -- (Name_Identifier [] "mod") -- (Just (Expression_Literal (Literal_Int "2"))) -- -- o "-2" as -- -- Expression_Negate (Expression_Literal (Literal_Int "2")) -- -- o "(-2)" as -- -- Expression_Parenthesized -- (Expression_Negate (Expression_Literal (Literal_Int "2"))) -- -- o "(2-)" as -- -- Expression_SectionApplication -- (Just (Expression_Literal (Literal_Int "2"))) -- (Name_Operator [] "-") Nothing -- -- Summary: -- Sections are represented as partial infix applications. Backquotes -- and parentheses that originate from pre/in-fixing an operator/identifier -- are not stored explicitly. TYPE ContextedExpressions = [ ContextedExpression ] DATA ContextedExpression | Contexted range : Range expression : Expression context : ContextItem TYPE Statements = [ Statement ] DATA Statement | Expression range : Range expression : Expression | Let range : Range declarations : Declarations | Generator range : Range pattern : Pattern expression : Expression | Empty range : Range SET AllStatement = Statement Statements TYPE Qualifiers = [ Qualifier ] DATA Qualifier | Guard range : Range guard : Expression -- type: Boolean | Let range : Range declarations : Declarations | Generator range : Range pattern : Pattern expression : Expression | Empty range : Range SET AllQualifier = Qualifier Qualifiers TYPE Alternatives = [ Alternative ] DATA Alternative | Alternative range : Range pattern : Pattern righthandside : RightHandSide | Empty range : Range SET AllAlternative = Alternative Alternatives TYPE GuardedExpressions = [ GuardedExpression ] DATA GuardedExpression -- ToDo: or _Guard? | GuardedExpression range : Range guard : Expression -- type: Boolean expression : Expression SET AllGuardedExpression = GuardedExpression GuardedExpressions TYPE RecordExpressionBindings = [ RecordExpressionBinding ] DATA RecordExpressionBinding | Binding range : Range name : Name expression : Expression SET AllRecordExpressionBinding = RecordExpressionBinding RecordExpressionBindings TYPE RowRecordExpressionUpdates = [ RowRecordExpressionUpdate ] DATA RowRecordExpressionUpdate | Update range : Range name : Name expression : Expression | Extends range : Range name : MaybeName expression : Expression SET AllRowRecordExpressionUpdate = RowRecordExpressionUpdate RowRecordExpressionUpdates TYPE RowTypeUpdates = [ RowTypeUpdate ] DATA RowTypeUpdate | Extends range : Range name : MaybeName type : Type SET AllRowTypeUpdate = RowTypeUpdate RowTypeUpdates TYPE FunctionBindings = [ FunctionBinding ] DATA FunctionBinding | FunctionBinding range : Range lefthandside : LeftHandSide righthandside : RightHandSide SET AllFunctionBinding = FunctionBinding FunctionBindings DATA LeftHandSide | Function range : Range name : Name patterns : Patterns | Infix range : Range leftPattern : Pattern operator : Name rightPattern : Pattern | Parenthesized range : Range lefthandside : LeftHandSide patterns : Patterns | Typed range : Range lefthandside : LeftHandSide type : Type DATA TypeLeftHandSide | Function range : Range name : Name patterns : TypePatterns | Infix range : Range leftPattern : TypePattern operator : Name rightPattern : TypePattern | Parenthesized range : Range lefthandside : TypeLeftHandSide patterns : TypePatterns DATA RightHandSide | Expression range : Range expression : Expression where : MaybeDeclarations | Guarded range : Range guardedexpressions : GuardedExpressions where : MaybeDeclarations SET AllExpression = Expression Expressions MaybeExpression ExpressionAnnotation AllFunctionBinding LeftHandSide RightHandSide AllAlternative AllGuardedExpression AllQualifier AllRecordExpressionBinding AllRowRecordExpressionUpdate AllStatement ContextedExpression ContextedExpressions TYPE Patterns = [ Pattern ] DATA Pattern | Literal range : Range sign : Int literal : Literal | Variable range : Range name : Name | Constructor range : Range name : Name patterns : Patterns | Parenthesized range : Range pattern : Pattern | As range : Range name : Name pattern : Pattern | Wildcard range : Range | Tuple range : Range arity : Int patterns : Patterns | Annotate range : Range annotation : PatternAnnotation pattern : Pattern | Typed range : Range pattern : Pattern type : Type | InfixConstructor range : Range leftPattern : Pattern constructorOperator : Name rightPattern : Pattern | List range : Range patterns : Patterns | Record range : Range name : Name recordPatternBindings : RecordPatternBindings | RowRecordBinding range : Range pattern : Pattern rowRecordPattternBindings: RowRecordPatternBindings | RowRecordEmpty range : Range | Irrefutable range : Range pattern : Pattern | Bang range : Range pattern : Pattern TYPE ContextedPatterns = [ ContextedPattern ] DATA ContextedPattern | Contexted range : Range pattern : Pattern context : ContextItem SET AllContextedPattern = ContextedPattern ContextedPatterns SET AllPattern = Pattern Patterns PatternAnnotation AllRowRecordPatternBinding AllRecordPatternBinding AllContextedPattern TYPE RecordPatternBindings = [ RecordPatternBinding ] DATA RecordPatternBinding | Binding range : Range name : Name pattern : Pattern | Pun range : Range name : Name SET AllRecordPatternBinding = RecordPatternBinding RecordPatternBindings DATA RowRecordPatternBinding | Binding range : Range name : MaybeName pattern : Pattern TYPE RowRecordPatternBindings = [ RowRecordPatternBinding ] SET AllRowRecordPatternBinding = RowRecordPatternBinding RowRecordPatternBindings TYPE TypePatterns = [ TypePattern ] DATA TypePattern | Variable range : Range name : Name SET AllTypePattern = TypePattern TypePatterns DATA TypeAnnotation | Strict | AnnotationName name : Name | AnnotationVar name : Name var : Name DATA ExpressionAnnotation | Empty DATA PatternAnnotation | Empty DATA KindAnnotation | Empty DATA Literal {- *** -} | Int {- *** -} range : Range base : Int value : String | Char {- *** -} range : Range value : String -- without the quotes | String {- ??? -} range : Range value : String -- without the quotes | Float range : Range value : String TYPE Strings = [ String ] SET AllBasics = Strings Literal SET AllNT = AllModuleDeclaration AllType AllPattern AllExpression AllBasics AllTypePattern AllKind AllPragma {- Documented Design Decisions: o All names are spelt out. o All constructor names are prefixed with the type name followed by an underscore. This preserves uniqueness, and the AG system can do that automatically. o Ranges are included everywhere as the first field, except in list and maybe types. o Naming convention for list types: append an `s' to the name of the element type. o Naming convention for maybe types: prepend base type with `Maybe'. o All of Haskell should be expressible without too much reinterpretation. That means that the syntax contains cases for ugly constructs such as the `default' statement or n+k/successor patterns. o We keep a few extensions in mind and are thus more general than Haskell in many places. For instance, the abstract syntax allows: <> multi-parameter type classes <> existential types <> rank-n polymorphic and qualified types <> hierarchical module names <> Haskell toplevel declarations everywhere o `Expression_InfixApplication' is used to store prefixed operators. o `Expression_SectionApplication' is used to store sections. o General where rule: A "where" with no declarations is represented as "Just []". A missing "where" clause is represented as "Nothing". o If two different cases can be joined into one by using a `Bool' to distinguish or by using maybe types, then they _usually_ should. o Literals are stored as strings rather than in their corresponding Haskell types, leaving it to each project to do conversions if necessary. The strings should store the literal in the same way as it appears in the source, but without the single or double quotes for character or string literals. o We do not include nonterminals that do not have resemblance in the concrete syntax, although they might be convenient for AG usage. Examples discussed were special root-like nonterminals for expressions and types, or a `BindingGroup' nonterminal. o Although parentheses can be represented in the abstract syntax, the program using it will probably not always do so. For instance, most compilers will work on type expressions and not insert parentheses at the correct positions. There might be different pretty printers needed: literal and optimizing. ToDo: Create different levels of the abstract syntax. Types, constructors, maybe even fields should be categorised. There should be a really small core, and different standardised extensions levels. Some of the extensions might even be not yet discussed at all (kinds, functional dependencies, ...) Andres has started marking some types and some constructors he thinks are most important with {- *** -}. -}