pec (empty) → 0.1
raw patch · 31 files changed
+7680/−0 lines, 31 filesdep +arraydep +basedep +cmdargssetup-changed
Dependencies added: array, base, cmdargs, derive, directory, filepath, mtl, process
Files
- DESIGN +103/−0
- FAQ +82/−0
- LICENSE +30/−0
- Language/Pec/Abs.hs +151/−0
- Language/Pec/Doc.html +695/−0
- Language/Pec/ErrM.hs +26/−0
- Language/Pec/Layout.hs +262/−0
- Language/Pec/Lex.x +156/−0
- Language/Pec/Par.hs +3137/−0
- Language/Pec/Print.hs +314/−0
- Main.hs +694/−0
- Makefile +45/−0
- Pec.cf +136/−0
- Pec/Base.hs +599/−0
- Pec/Makefile +2/−0
- README +36/−0
- Setup.hs +8/−0
- THANKS +16/−0
- TODO +55/−0
- pec.cabal +46/−0
- test_cases/Makefile +16/−0
- test_cases/Prelude.pec +287/−0
- test_cases/Stack.pec +50/−0
- test_cases/StrBuf.pec +48/−0
- test_cases/TestArray.pec +69/−0
- test_cases/TestLoad.pec +13/−0
- test_cases/TestPrims.pec +260/−0
- test_cases/TestStack.pec +39/−0
- test_cases/TestStrBuf.pec +46/−0
- test_cases/TestTuple.pec +119/−0
- test_cases/TestVariant.pec +140/−0
+ DESIGN view
@@ -0,0 +1,103 @@+INTRO + +Pec is a strict, impure, procedural language. It is intended to have +the look and feel of Haskell and compile to LLVM and C. It is +strongly influenced by all three languages: + +Haskell + - Strong typing with Hindley-Milner type inference + - Variants, tuples, records + - case expressions, pattern matching + - User defined, polymorphic data structures + - Parametric polymorphism, ad-hoc polymorphism, laziness, + user-defined operators, etc. (provided via Haskell DSL) + - Modules + - Syntax/Layout + - productive + +LLVM & C + - compiles to LLVM (C planned) + - easy integration + - efficient + - simple run-time system + - arbitrary sized integers + - single static assignment (SSA) names + - no garbage collection + - no closures + - no objects + +Pec + - small syntax + - safe pointers + - type system prevents out of bounds array indexing + - no recursion + - no operator precedence + +LANGUAGE ARCHITECTURE + +pec is made up of two sub-languages, the pec "application" language and +the pec "library" DSL. In this sense it is very similar to the +relationship between C and the C pre-processor (although the "library" +DSL should provide a dramatically better user experience than cpp). +The intent is that the majority of code will be written in the +"application" language by application programmers. "Library" code +(code that needs parametric polymorphism and other advanced features) +will be written by library programmers that know both pec and Haskell +and understand the provided DSL. In fact, the goal is to offload as +much as possible from the pec compiler to the libraries (e.g. type +bool is implemented in a library). These two types of code can be +interspersed in a single .pec file. + +Syntax for the "application" language is contained in the pec.cf file. +This file used by bnfc to automatically derive a lexer and a parser +for the language. The precise syntax for the "application" language +can be found in Language/Pec/Doc.html. + +Syntax for the "library" language is simply Haskell +syntax prefixed by a '>' at the start of a line. + +Check out the .pec files in the test directory to get a better feel +for how pec works. + +COMPILER ARCHITECTURE + +The pec compiler leverages several tools in its compilation pipeline. +This allows the compiler to be small and nimble (but can also have +drawbacks, e.g. error messages). + +Main.hs implements the compiler pipeline. Pec/Base.hs is the code +generation library used by the generated Haskell modules. It also +provides the pec "library" DSL. + +Pec compilation begins by specifying the "main" pec module on the +command line. + + e.g. pec Foo.pec + +The main module is parsed and its import dependencies are noted. This +is then repeated recursively for each dependency. + + e.g. Foo.pec, Bar.pec, Baz.pec + +These pec modules are all transformed to corresponding Haskell modules +and a "main" Haskell module. These Haskell modules contain the code +needed to generate the goal LLVM/C code. They also contain enough +type information for the ghc type inference/checking to be leveraged. + + e.g. Foo_.hs, Bar_.hs, Baz_.hs, Foo_main.hs + +ghc is then used to infer/check types and build the code generation +executable. + + e.g. ghc --make Foo_main.hs + +When run, the resulting executable will create corresponding LLVM IR +modules. + + e.g. Foo.ll, Bar.ll, Baz.ll + +LLVM is then used to transform the LLVM IR into LLVM bitcode and from +there to the desired executable. + +The pec compiler doesn't currently generate C, but that is high on the +TODO list.
+ FAQ view
@@ -0,0 +1,82 @@+The pec programming language FAQ + +Q: How mature is pec? + +A: It's not :) Good ideas/help is appreciated in all areas, from +language design, implementation, test cases, etc. That being said, +you should be able to use the pec compiler to write fairly +sophisticated prototype applications (see examples in the test case +directory). Comments/questions/bug reports can be sent to brettletner +at gmail dot com. + +Q: Where did the name 'pec' come from? + +A: A long time ago it stood for Pure Embedded Compiler. pec is no +longer pure, but I still liked the name. Now I guess it stands for +pec embedded compiler :) + +Q: Why isn't pec pure? + +A: Mostly I wanted to make it easier for C programmers to migrate. A +pure language with the same target market seems like a fine thing, +though. + +Q: How does the type system prevent out of bounds array indexing? + +A: It uses Haskell classes and built-in "Count" types. See the paper +"Lightweight static capabilities" by Kiselyov and Shan for more +information. + +Q: Can I use the type system to prevent other common sources of +errors, e.g. divide by zero? + +A: Yes. + +Q: Why no garbage collection? + +A: GC is generally (right or wrong) frowned upon in embedded +development. It makes the run-time system more complicated and +makes integration with other GC'd languages more difficult. A GC'd +language with the same target market seems like a fine thing, though. + +Q: Why no recursion? + +A: Recursion is generally (right or wrong) frowned upon in embedded +development. Also, not having recursion leaves open the possibility +of compiling the whole program into a state machine. + +Q: Why no closures? + +A: Pec doesn't have a heap, so it can't have "upward" +closures. "Downward" closures may be added in the future. + +Q: Why no objects? + +A: Personal preference. + +Q: Why no parallelism/concurrency? + +A: I just haven't thought about it yet. My best guess is that it will +eventually be based on STM, but help is needed here. + +Q: Why no operator precedence? + +A: It is better style to just put the parens in and removes all code +review discussion as to whether you should have parens or not. Also, +I was too lazy to implement it :) + +Q: This "safe" pointer isn't safe at all, what gives? + +foo = do + p = new (Just 'a') + case p of + Nothing -> () + Just c -> do + p <- Nothing + putCh @c + +A: The second assignment to p (i.e. p <- Nothing) should be disallowed +while c is in scope. The compiler currently doesn't prevent this (and +other similar errors such as returning a pointer to the (soon to be +invalidated) stack). If anyone has an idea on how to prevent this I'd +love to hear it.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Brett Letner + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Brett Letner nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Language/Pec/Abs.hs view
@@ -0,0 +1,151 @@+module Language.Pec.Abs where++-- Haskell module generated by the BNF converter+++newtype Frac = Frac String deriving (Eq,Ord,Show)+newtype Uident = Uident String deriving (Eq,Ord,Show)+newtype Lident = Lident String deriving (Eq,Ord,Show)+newtype USym = USym String deriving (Eq,Ord,Show)+newtype Number = Number String deriving (Eq,Ord,Show)+newtype Count = Count String deriving (Eq,Ord,Show)+data Module =+ Module Modid ExportDecl [TopDecl]+ deriving (Eq,Ord,Show)++data ExportDecl =+ ExpAllD+ | ExpListD [Export]+ deriving (Eq,Ord,Show)++data Export =+ TypeEx Con Spec+ | VarEx Var+ deriving (Eq,Ord,Show)++data Spec =+ Neither+ | Decon+ | Both+ deriving (Eq,Ord,Show)++data TopDecl =+ ImportD Modid AsSpec+ | ExternD ExtNm Var Type+ | TypeD Con [TyVar] TyDecl+ | AscribeD Var Type+ | VarD Var Exp+ | ProcD Var [Exp] Exp+ deriving (Eq,Ord,Show)++data AsSpec =+ AsAS Con+ | EmptyAS+ deriving (Eq,Ord,Show)++data ExtNm =+ SomeNm String+ | NoneNm+ deriving (Eq,Ord,Show)++data Exp =+ BlockE [Exp]+ | LetS Exp Exp+ | LetE Exp Exp Exp+ | StoreE Exp Exp+ | CaseE Exp [CaseAlt]+ | BranchE [BranchAlt]+ | BinOpE Exp USym Exp+ | AppE Exp Exp+ | UnOpE UnOp Exp+ | IdxE Exp Exp+ | FldE Exp Field+ | ArrayE [Exp]+ | RecordE [FieldD]+ | TupleE [Exp]+ | AscribeE Exp Type+ | CountE Count+ | VarE Var+ | LitE Lit+ deriving (Eq,Ord,Show)++data UnOp =+ Load+ deriving (Eq,Ord,Show)++data CaseAlt =+ CaseAlt CasePat Exp+ deriving (Eq,Ord,Show)++data CasePat =+ ConP Con Var+ | LitP Lit+ | VarP Var+ deriving (Eq,Ord,Show)++data BranchAlt =+ BranchAlt BranchPat Exp+ deriving (Eq,Ord,Show)++data BranchPat =+ BoolBP Exp+ | DefaultBP+ deriving (Eq,Ord,Show)++data Type =+ TyFun Type Type+ | TyArray Type Type+ | TyConstr Con [Type]+ | TyTuple [Type]+ | TyCount Count+ | TyVarT TyVar+ | TyConstr0 Con+ deriving (Eq,Ord,Show)++data TyDecl =+ TyRecord [FieldT]+ | TyTagged [ConC]+ | TySyn Type+ deriving (Eq,Ord,Show)++data ConC =+ ConC Con [Type]+ deriving (Eq,Ord,Show)++data FieldT =+ FieldT Field Type+ deriving (Eq,Ord,Show)++data Lit =+ CharL Char+ | StringL String+ | IntL Number+ | FracL Frac+ | EnumL Con+ deriving (Eq,Ord,Show)++data FieldD =+ FieldD Field Exp+ deriving (Eq,Ord,Show)++data Var =+ Var Lident+ deriving (Eq,Ord,Show)++data Con =+ Con Uident+ deriving (Eq,Ord,Show)++data Modid =+ Modid Uident+ deriving (Eq,Ord,Show)++data Field =+ Field Lident+ deriving (Eq,Ord,Show)++data TyVar =+ VarTV Lident+ | CntTV Lident+ deriving (Eq,Ord,Show)+
+ Language/Pec/Doc.html view
@@ -0,0 +1,695 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<META NAME="generator" CONTENT="http://txt2tags.org"> +<TITLE>The Language Pec</TITLE> +</HEAD><BODY BGCOLOR="white" TEXT="black"> +<CENTER> +<H1>The Language Pec</H1> +<FONT SIZE="4"><I>BNF Converter</I></FONT><BR> +</CENTER> + +<P> +This document was automatically generated by the <I>BNF-Converter</I>. It was generated together with the lexer, the parser, and the abstract syntax module, which guarantees that the document matches with the implementation of the language (provided no hand-hacking has taken place). +</P> + +<H2>The lexical structure of Pec</H2> + +<H3>Literals</H3> + +<P> +String literals <I>String</I> have the form +<CODE>"</CODE><I>x</I><CODE>"</CODE>, where <I>x</I> is any sequence of any characters +except <CODE>"</CODE> unless preceded by <CODE>\</CODE>. +</P> +<P> +Character literals <I>Char</I> have the form +<CODE>'</CODE><I>c</I><CODE>'</CODE>, where <I>c</I> is any single character. +</P> +<P> +Frac literals are recognized by the regular expression +<CODE>`</CODE>'-'? digit+ '.' digit+ ('e' '-'? digit+)?<CODE>`</CODE> +</P> +<P> +Uident literals are recognized by the regular expression +<CODE>`</CODE>upper (letter | digit | '_')*<CODE>`</CODE> +</P> +<P> +Lident literals are recognized by the regular expression +<CODE>`</CODE>(lower | '_') (letter | digit | '_')*<CODE>`</CODE> +</P> +<P> +USym literals are recognized by the regular expression +<CODE>`</CODE>('!' | '#' | '$' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '\' | '^' | '|' | '~')+<CODE>`</CODE> +</P> +<P> +Number literals are recognized by the regular expression +<CODE>`</CODE>'-'? digit+<CODE>`</CODE> +</P> +<P> +Count literals are recognized by the regular expression +<CODE>`</CODE>'#' digit+<CODE>`</CODE> +</P> + +<H3>Reserved words and symbols</H3> + +<P> +The set of reserved words is the set of terminals appearing in the grammar. Those reserved words that consist of non-letter characters are called symbols, and they are treated in a different way from those that are similar to identifiers. The lexer follows rules familiar from languages like Haskell, C, and Java, including longest match and spacing conventions. +</P> +<P> +The reserved words used in Pec are the following: +</P> + +<TABLE ALIGN="center" CELLPADDING="4"> +<TR> +<TD><CODE>Array</CODE></TD> +<TD><CODE>all</CODE></TD> +<TD><CODE>as</CODE></TD> +<TD><CODE>branch</CODE></TD> +</TR> +<TR> +<TD><CODE>case</CODE></TD> +<TD><CODE>do</CODE></TD> +<TD><CODE>exports</CODE></TD> +<TD><CODE>extern</CODE></TD> +</TR> +<TR> +<TD><CODE>import</CODE></TD> +<TD><CODE>in</CODE></TD> +<TD><CODE>let</CODE></TD> +<TD><CODE>module</CODE></TD> +</TR> +<TR> +<TD><CODE>of</CODE></TD> +<TD><CODE>type</CODE></TD> +<TD><CODE>where</CODE></TD> +</TR> +</TABLE> + +<P> +The symbols used in Pec are the following: +</P> + +<TABLE ALIGN="center" CELLPADDING="4"> +<TR> +<TD>{</TD> +<TD>}</TD> +<TD>(</TD> +<TD>)</TD> +</TR> +<TR> +<TD>.</TD> +<TD>..</TD> +<TD>::</TD> +<TD>=</TD> +</TR> +<TR> +<TD><-</TD> +<TD>[</TD> +<TD>]</TD> +<TD>@</TD> +</TR> +<TR> +<TD>-></TD> +<TD>|</TD> +<TD>#</TD> +<TD>,</TD> +</TR> +<TR> +<TD>;</TD> +<TD></TD> +<TD></TD> +</TR> +</TABLE> + +<H3>Comments</H3> + +<P> +Single-line comments begin with //.Multiple-line comments are enclosed with /* and */. +</P> + +<H2>The syntactic structure of Pec</H2> + +<P> +Non-terminals are enclosed between < and >. +The symbols -> (production), <B>|</B> (union) +and <B>eps</B> (empty rule) belong to the BNF notation. +All other symbols are terminals. +</P> + +<TABLE ALIGN="center" CELLPADDING="4"> +<TR> +<TD><I>Module</I></TD> +<TD>-></TD> +<TD><CODE>module</CODE> <I>Modid</I> <CODE>exports</CODE> <I>ExportDecl</I> <CODE>where</CODE> <CODE>{</CODE> <I>[TopDecl]</I> <CODE>}</CODE></TD> +</TR> +<TR> +<TD><I>ExportDecl</I></TD> +<TD>-></TD> +<TD><CODE>all</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>(</CODE> <I>[Export]</I> <CODE>)</CODE></TD> +</TR> +<TR> +<TD><I>Export</I></TD> +<TD>-></TD> +<TD><I>Con</I> <I>Spec</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Var</I></TD> +</TR> +<TR> +<TD><I>Spec</I></TD> +<TD>-></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>(</CODE> <CODE>.</CODE> <CODE>)</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>(</CODE> <CODE>..</CODE> <CODE>)</CODE></TD> +</TR> +<TR> +<TD><I>TopDecl</I></TD> +<TD>-></TD> +<TD><CODE>import</CODE> <I>Modid</I> <I>AsSpec</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>extern</CODE> <I>ExtNm</I> <I>Var</I> <CODE>::</CODE> <I>Type</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>type</CODE> <I>Con</I> <I>[TyVar]</I> <CODE>=</CODE> <I>TyDecl</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Var</I> <CODE>::</CODE> <I>Type</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Var</I> <CODE>=</CODE> <I>Exp</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Var</I> <I>[Exp0]</I> <CODE>=</CODE> <I>Exp</I></TD> +</TR> +<TR> +<TD><I>AsSpec</I></TD> +<TD>-></TD> +<TD><CODE>as</CODE> <I>Con</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD><I>ExtNm</I></TD> +<TD>-></TD> +<TD><I>String</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD><I>Exp</I></TD> +<TD>-></TD> +<TD><CODE>do</CODE> <CODE>{</CODE> <I>[Exp5]</I> <CODE>}</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp5</I></TD> +</TR> +<TR> +<TD><I>Exp5</I></TD> +<TD>-></TD> +<TD><I>Exp4</I> <CODE>=</CODE> <I>Exp</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>let</CODE> <I>Exp4</I> <CODE>=</CODE> <I>Exp</I> <CODE>in</CODE> <I>Exp</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp4</I> <CODE><-</CODE> <I>Exp</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>case</CODE> <I>Exp</I> <CODE>of</CODE> <CODE>{</CODE> <I>[CaseAlt]</I> <CODE>}</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>branch</CODE> <CODE>of</CODE> <CODE>{</CODE> <I>[BranchAlt]</I> <CODE>}</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp4</I></TD> +</TR> +<TR> +<TD><I>Exp4</I></TD> +<TD>-></TD> +<TD><I>Exp3</I> <I>USym</I> <I>Exp3</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp3</I></TD> +</TR> +<TR> +<TD><I>Exp3</I></TD> +<TD>-></TD> +<TD><I>Exp3</I> <I>Exp2</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp2</I></TD> +</TR> +<TR> +<TD><I>Exp2</I></TD> +<TD>-></TD> +<TD><I>UnOp</I> <I>Exp1</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp1</I></TD> +</TR> +<TR> +<TD><I>Exp1</I></TD> +<TD>-></TD> +<TD><I>Exp1</I> <CODE>[</CODE> <I>Exp</I> <CODE>]</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp1</I> <CODE>.</CODE> <I>Field</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp0</I></TD> +</TR> +<TR> +<TD><I>Exp0</I></TD> +<TD>-></TD> +<TD><CODE>Array</CODE> <CODE>[</CODE> <I>[Exp]</I> <CODE>]</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>{</CODE> <I>[FieldD]</I> <CODE>}</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>(</CODE> <I>[Exp]</I> <CODE>)</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>(</CODE> <I>Exp</I> <CODE>::</CODE> <I>Type</I> <CODE>)</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Count</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Var</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Lit</I></TD> +</TR> +<TR> +<TD><I>UnOp</I></TD> +<TD>-></TD> +<TD><CODE>@</CODE></TD> +</TR> +<TR> +<TD><I>CaseAlt</I></TD> +<TD>-></TD> +<TD><I>CasePat</I> <CODE>-></CODE> <I>Exp</I></TD> +</TR> +<TR> +<TD><I>CasePat</I></TD> +<TD>-></TD> +<TD><I>Con</I> <I>Var</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Lit</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Var</I></TD> +</TR> +<TR> +<TD><I>BranchAlt</I></TD> +<TD>-></TD> +<TD><CODE>|</CODE> <I>BranchPat</I> <CODE>-></CODE> <I>Exp</I></TD> +</TR> +<TR> +<TD><I>BranchPat</I></TD> +<TD>-></TD> +<TD><I>Exp4</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD><I>Type</I></TD> +<TD>-></TD> +<TD><I>Type2</I> <CODE>-></CODE> <I>Type</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Type2</I></TD> +</TR> +<TR> +<TD><I>Type2</I></TD> +<TD>-></TD> +<TD><CODE>Array</CODE> <I>Type1</I> <I>Type1</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Con</I> <I>[Type1]</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Type1</I></TD> +</TR> +<TR> +<TD><I>Type1</I></TD> +<TD>-></TD> +<TD><I>Type0</I></TD> +</TR> +<TR> +<TD><I>Type0</I></TD> +<TD>-></TD> +<TD><CODE>(</CODE> <I>[Type]</I> <CODE>)</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Count</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>TyVar</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Con</I></TD> +</TR> +<TR> +<TD><I>TyDecl</I></TD> +<TD>-></TD> +<TD><CODE>{</CODE> <I>[FieldT]</I> <CODE>}</CODE></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>|</CODE> <I>[ConC]</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Type</I></TD> +</TR> +<TR> +<TD><I>ConC</I></TD> +<TD>-></TD> +<TD><I>Con</I> <I>[Type0]</I></TD> +</TR> +<TR> +<TD><I>FieldT</I></TD> +<TD>-></TD> +<TD><I>Field</I> <CODE>::</CODE> <I>Type</I></TD> +</TR> +<TR> +<TD><I>Lit</I></TD> +<TD>-></TD> +<TD><I>Char</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>String</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Number</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Frac</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Con</I></TD> +</TR> +<TR> +<TD><I>FieldD</I></TD> +<TD>-></TD> +<TD><I>Field</I> <CODE>=</CODE> <I>Exp</I></TD> +</TR> +<TR> +<TD><I>Var</I></TD> +<TD>-></TD> +<TD><I>Lident</I></TD> +</TR> +<TR> +<TD><I>Con</I></TD> +<TD>-></TD> +<TD><I>Uident</I></TD> +</TR> +<TR> +<TD><I>Modid</I></TD> +<TD>-></TD> +<TD><I>Uident</I></TD> +</TR> +<TR> +<TD><I>Field</I></TD> +<TD>-></TD> +<TD><I>Lident</I></TD> +</TR> +<TR> +<TD><I>TyVar</I></TD> +<TD>-></TD> +<TD><I>Lident</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><CODE>#</CODE> <I>Lident</I></TD> +</TR> +<TR> +<TD><I>[Exp]</I></TD> +<TD>-></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp</I> <CODE>,</CODE> <I>[Exp]</I></TD> +</TR> +<TR> +<TD><I>[FieldT]</I></TD> +<TD>-></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>FieldT</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>FieldT</I> <CODE>,</CODE> <I>[FieldT]</I></TD> +</TR> +<TR> +<TD><I>[TyVar]</I></TD> +<TD>-></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>TyVar</I> <I>[TyVar]</I></TD> +</TR> +<TR> +<TD><I>[Type]</I></TD> +<TD>-></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Type</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Type</I> <CODE>,</CODE> <I>[Type]</I></TD> +</TR> +<TR> +<TD><I>[Export]</I></TD> +<TD>-></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Export</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Export</I> <CODE>,</CODE> <I>[Export]</I></TD> +</TR> +<TR> +<TD><I>[Type0]</I></TD> +<TD>-></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Type0</I> <I>[Type0]</I></TD> +</TR> +<TR> +<TD><I>[ConC]</I></TD> +<TD>-></TD> +<TD><I>ConC</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>ConC</I> <CODE>|</CODE> <I>[ConC]</I></TD> +</TR> +<TR> +<TD><I>[Exp0]</I></TD> +<TD>-></TD> +<TD><I>Exp0</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp0</I> <I>[Exp0]</I></TD> +</TR> +<TR> +<TD><I>[FieldD]</I></TD> +<TD>-></TD> +<TD><I>FieldD</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>FieldD</I> <CODE>,</CODE> <I>[FieldD]</I></TD> +</TR> +<TR> +<TD><I>[Type1]</I></TD> +<TD>-></TD> +<TD><I>Type1</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Type1</I> <I>[Type1]</I></TD> +</TR> +<TR> +<TD><I>[TopDecl]</I></TD> +<TD>-></TD> +<TD><B>eps</B></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>TopDecl</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>TopDecl</I> <CODE>;</CODE> <I>[TopDecl]</I></TD> +</TR> +<TR> +<TD><I>[CaseAlt]</I></TD> +<TD>-></TD> +<TD><I>CaseAlt</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>CaseAlt</I> <CODE>;</CODE> <I>[CaseAlt]</I></TD> +</TR> +<TR> +<TD><I>[BranchAlt]</I></TD> +<TD>-></TD> +<TD><I>BranchAlt</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>BranchAlt</I> <CODE>;</CODE> <I>[BranchAlt]</I></TD> +</TR> +<TR> +<TD><I>[Exp5]</I></TD> +<TD>-></TD> +<TD><I>Exp5</I></TD> +</TR> +<TR> +<TD></TD> +<TD ALIGN="center"><B>|</B></TD> +<TD><I>Exp5</I> <CODE>;</CODE> <I>[Exp5]</I></TD> +</TR> +</TABLE> + +<!-- html code generated by txt2tags 2.6 (http://txt2tags.org) --> +<!-- cmdline: txt2tags -t html Doc.txt --> +</BODY></HTML>
+ Language/Pec/ErrM.hs view
@@ -0,0 +1,26 @@+-- BNF Converter: Error Monad+-- Copyright (C) 2004 Author: Aarne Ranta++-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.+module Language.Pec.ErrM where++-- the Error monad: like Maybe type with error msgs++import Control.Monad (MonadPlus(..), liftM)++data Err a = Ok a | Bad String+ deriving (Read, Show, Eq, Ord)++instance Monad Err where+ return = Ok+ fail = Bad+ Ok a >>= f = f a+ Bad s >>= f = Bad s++instance Functor Err where+ fmap = liftM++instance MonadPlus Err where+ mzero = Bad "Err.mzero"+ mplus (Bad _) y = y+ mplus x _ = x
+ Language/Pec/Layout.hs view
@@ -0,0 +1,262 @@+module Language.Pec.Layout where++import Language.Pec.Lex+++import Data.Maybe (isNothing, fromJust)++-- Generated by the BNF Converter++-- local parameters++topLayout = False+layoutWords = ["where","do","of"]+layoutStopWords = []++-- layout separators++layoutOpen = "{"+layoutClose = "}"+layoutSep = ";"++-- | Replace layout syntax with explicit layout tokens.+resolveLayout :: Bool -- ^ Whether to use top-level layout.+ -> [Token] -> [Token]+resolveLayout tp = res Nothing [if tl then Implicit 1 else Explicit]+ where+ -- Do top-level layout if the function parameter and the grammar say so.+ tl = tp && topLayout++ res :: Maybe Token -- ^ The previous token, if any.+ -> [Block] -- ^ A stack of layout blocks.+ -> [Token] -> [Token]++ -- The stack should never be empty.+ res _ [] ts = error $ "Layout error: stack empty. Tokens: " ++ show ts++ res _ st (t0:ts)+ -- We found an open brace in the input,+ -- put an explicit layout block on the stack.+ -- This is done even if there was no layout word,+ -- to keep opening and closing braces.+ | isLayoutOpen t0 = moveAlong (Explicit:st) [t0] ts++ res _ st (t0:ts)+ -- Start a new layout block if the first token is a layout word+ | isLayout t0 =+ case ts of+ -- Explicit layout, just move on. The case above+ -- will push an explicit layout block.+ t1:_ | isLayoutOpen t1 -> moveAlong st [t0] ts+ -- at end of file, the start column doesn't matter+ _ -> let col = if null ts then column t0 else column (head ts)+ -- insert an open brace after the layout word+ b:ts' = addToken (nextPos t0) layoutOpen ts+ -- save the start column+ st' = Implicit col:st + in moveAlong st' [t0,b] ts'++ -- If we encounter a closing brace, exit the first explicit layout block.+ | isLayoutClose t0 = + let st' = drop 1 (dropWhile isImplicit st)+ in if null st' + then error $ "Layout error: Found " ++ layoutClose ++ " at (" + ++ show (line t0) ++ "," ++ show (column t0) + ++ ") without an explicit layout block."+ else moveAlong st' [t0] ts++ -- We are in an implicit layout block+ res pt st@(Implicit n:ns) (t0:ts)++ -- End of implicit block by a layout stop word+ | isStop t0 = + -- Exit the current block and all implicit blocks + -- more indented than the current token+ let (ebs,ns') = span (`moreIndent` column t0) ns+ moreIndent (Implicit x) y = x > y+ moreIndent Explicit _ = False+ -- the number of blocks exited+ b = 1 + length ebs+ bs = replicate b layoutClose+ -- Insert closing braces after the previous token.+ (ts1,ts2) = splitAt (1+b) $ addTokens (afterPrev pt) bs (t0:ts)+ in moveAlong ns' ts1 ts2++ -- End of an implicit layout block+ | newLine && column t0 < n = + -- Insert a closing brace after the previous token.+ let b:t0':ts' = addToken (afterPrev pt) layoutClose (t0:ts)+ -- Repeat, with the current block removed from the stack+ in moveAlong ns [b] (t0':ts')++ -- Encounted a new line in an implicit layout block.+ | newLine && column t0 == n = + -- Insert a semicolon after the previous token.+ -- unless we are the beginning of the file,+ -- or the previous token is a semicolon or open brace.+ if isNothing pt || isTokenIn [layoutSep,layoutOpen] (fromJust pt) + then moveAlong st [t0] ts+ else let b:t0':ts' = addToken (afterPrev pt) layoutSep (t0:ts)+ in moveAlong st [b,t0'] ts'+ where newLine = case pt of+ Nothing -> True+ Just t -> line t /= line t0++ -- Nothing to see here, move along.+ res _ st (t:ts) = moveAlong st [t] ts++ -- At EOF: skip explicit blocks.+ res (Just t) (Explicit:bs) [] | null bs = []+ | otherwise = res (Just t) bs []++ -- If we are using top-level layout, insert a semicolon after+ -- the last token, if there isn't one already+ res (Just t) [Implicit n] []+ | isTokenIn [layoutSep] t = []+ | otherwise = addToken (nextPos t) layoutSep []++ -- At EOF in an implicit, non-top-level block: close the block+ res (Just t) (Implicit n:bs) [] =+ let c = addToken (nextPos t) layoutClose []+ in moveAlong bs c []++ -- This should only happen if the input is empty.+ res Nothing st [] = []++ -- | Move on to the next token.+ moveAlong :: [Block] -- ^ The layout stack.+ -> [Token] -- ^ Any tokens just processed.+ -> [Token] -- ^ the rest of the tokens.+ -> [Token]+ moveAlong st [] ts = error $ "Layout error: moveAlong got [] as old tokens"+ moveAlong st ot ts = ot ++ res (Just $ last ot) st ts++data Block = Implicit Int -- ^ An implicit layout block with its start column.+ | Explicit + deriving Show++type Position = Posn++-- | Check if s block is implicit.+isImplicit :: Block -> Bool+isImplicit (Implicit _) = True+isImplicit _ = False++-- | Insert a number of tokens at the begninning of a list of tokens.+addTokens :: Position -- ^ Position of the first new token.+ -> [String] -- ^ Token symbols.+ -> [Token] -- ^ The rest of the tokens. These will have their+ -- positions updated to make room for the new tokens .+ -> [Token] +addTokens p ss ts = foldr (addToken p) ts ss++-- | Insert a new symbol token at the begninning of a list of tokens.+addToken :: Position -- ^ Position of the new token.+ -> String -- ^ Symbol in the new token.+ -> [Token] -- ^ The rest of the tokens. These will have their+ -- positions updated to make room for the new token.+ -> [Token]+addToken p s ts = sToken p s : map (incrGlobal p (length s)) ts++-- | Get the position immediately to the right of the given token.+-- If no token is given, gets the first position in the file.+afterPrev :: Maybe Token -> Position+afterPrev = maybe (Pn 0 1 1) nextPos++-- | Get the position immediately to the right of the given token.+nextPos :: Token -> Position +nextPos t = Pn (g + s) l (c + s + 1) + where Pn g l c = position t+ s = tokenLength t++-- | Add to the global and column positions of a token.+-- The column position is only changed if the token is on+-- the same line as the given position.+incrGlobal :: Position -- ^ If the token is on the same line+ -- as this position, update the column position.+ -> Int -- ^ Number of characters to add to the position.+ -> Token -> Token+incrGlobal (Pn _ l0 _) i (PT (Pn g l c) t) =+ if l /= l0 then PT (Pn (g + i) l c) t+ else PT (Pn (g + i) l (c + i)) t+incrGlobal _ _ p = error $ "cannot add token at " ++ show p++-- | Create a symbol token.+sToken :: Position -> String -> Token+sToken p s = PT p (TS s i)+ where+ i = case s of+ "#" -> 1+ "(" -> 2+ ")" -> 3+ "," -> 4+ "->" -> 5+ "." -> 6+ ".." -> 7+ "::" -> 8+ ";" -> 9+ "<-" -> 10+ "=" -> 11+ "@" -> 12+ "Array" -> 13+ "[" -> 14+ "]" -> 15+ "all" -> 16+ "as" -> 17+ "branch" -> 18+ "case" -> 19+ "do" -> 20+ "exports" -> 21+ "extern" -> 22+ "import" -> 23+ "in" -> 24+ "let" -> 25+ "module" -> 26+ "of" -> 27+ "type" -> 28+ "where" -> 29+ "{" -> 30+ "|" -> 31+ "}" -> 32+ _ -> error $ "not a reserved word: " ++ show s++-- | Get the position of a token.+position :: Token -> Position+position t = case t of+ PT p _ -> p+ Err p -> p++-- | Get the line number of a token.+line :: Token -> Int+line t = case position t of Pn _ l _ -> l++-- | Get the column number of a token.+column :: Token -> Int+column t = case position t of Pn _ _ c -> c++-- | Check if a token is one of the given symbols.+isTokenIn :: [String] -> Token -> Bool+isTokenIn ts t = case t of+ PT _ (TS r _) | elem r ts -> True+ _ -> False++-- | Check if a word is a layout start token.+isLayout :: Token -> Bool+isLayout = isTokenIn layoutWords++-- | Check if a token is a layout stop token.+isStop :: Token -> Bool+isStop = isTokenIn layoutStopWords++-- | Check if a token is the layout open token.+isLayoutOpen :: Token -> Bool+isLayoutOpen = isTokenIn [layoutOpen]++-- | Check if a token is the layout close token.+isLayoutClose :: Token -> Bool+isLayoutClose = isTokenIn [layoutClose]++-- | Get the number of characters in the token.+tokenLength :: Token -> Int+tokenLength t = length $ prToken t+
+ Language/Pec/Lex.x view
@@ -0,0 +1,156 @@+-- -*- haskell -*-+-- This Alex file was machine-generated by the BNF converter+{+{-# OPTIONS -fno-warn-incomplete-patterns #-}+module Language.Pec.Lex where++++}+++$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME+$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME+$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME+$d = [0-9] -- digit+$i = [$l $d _ '] -- identifier character+$u = [\0-\255] -- universal: any character++@rsyms = -- symbols and non-identifier-like reserved words+ \{ | \} | \( | \) | \. | \. \. | \: \: | \= | \< \- | \[ | \] | \@ | \- \> | \| | \# | \, | \;++:-+"//" [.]* ; -- Toss single line comments+"/*" ([$u # \*] | \* [$u # \/])* ("*")+ "/" ; ++$white+ ;+@rsyms { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }+\- ? $d + \. $d + (e \- ? $d +)? { tok (\p s -> PT p (eitherResIdent (T_Frac . share) s)) }+$c ($l | $d | \_)* { tok (\p s -> PT p (eitherResIdent (T_Uident . share) s)) }+($s | \_)($l | $d | \_)* { tok (\p s -> PT p (eitherResIdent (T_Lident . share) s)) }+(\! | \# | \$ | \% | \& | \* | \+ | \- | \. | \/ | \: | \< | \= | \> | \? | \@ | \\ | \^ | \| | \~)+ { tok (\p s -> PT p (eitherResIdent (T_USym . share) s)) }+\- ? $d + { tok (\p s -> PT p (eitherResIdent (T_Number . share) s)) }+\# $d + { tok (\p s -> PT p (eitherResIdent (T_Count . share) s)) }++$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }+\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }+\' ($u # [\' \\] | \\ [\\ \' n t]) \' { tok (\p s -> PT p (TC $ share s)) }++++{++tok f p s = f p s++share :: String -> String+share = id++data Tok =+ TS !String !Int -- reserved words and symbols+ | TL !String -- string literals+ | TI !String -- integer literals+ | TV !String -- identifiers+ | TD !String -- double precision float literals+ | TC !String -- character literals+ | T_Frac !String+ | T_Uident !String+ | T_Lident !String+ | T_USym !String+ | T_Number !String+ | T_Count !String++ deriving (Eq,Show,Ord)++data Token = + PT Posn Tok+ | Err Posn+ deriving (Eq,Show,Ord)++tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l+tokenPos _ = "end of file"++posLineCol (Pn _ l c) = (l,c)+mkPosToken t@(PT p _) = (posLineCol p, prToken t)++prToken t = case t of+ PT _ (TS s _) -> s+ PT _ (TL s) -> s+ PT _ (TI s) -> s+ PT _ (TV s) -> s+ PT _ (TD s) -> s+ PT _ (TC s) -> s+ PT _ (T_Frac s) -> s+ PT _ (T_Uident s) -> s+ PT _ (T_Lident s) -> s+ PT _ (T_USym s) -> s+ PT _ (T_Number s) -> s+ PT _ (T_Count s) -> s+++data BTree = N | B String Tok BTree BTree deriving (Show)++eitherResIdent :: (String -> Tok) -> String -> Tok+eitherResIdent tv s = treeFind resWords+ where+ treeFind N = tv s+ treeFind (B a t left right) | s < a = treeFind left+ | s > a = treeFind right+ | s == a = t++resWords = b "as" 17 (b ";" 9 (b "->" 5 (b ")" 3 (b "(" 2 (b "#" 1 N N) N) (b "," 4 N N)) (b ".." 7 (b "." 6 N N) (b "::" 8 N N))) (b "Array" 13 (b "=" 11 (b "<-" 10 N N) (b "@" 12 N N)) (b "]" 15 (b "[" 14 N N) (b "all" 16 N N)))) (b "let" 25 (b "exports" 21 (b "case" 19 (b "branch" 18 N N) (b "do" 20 N N)) (b "import" 23 (b "extern" 22 N N) (b "in" 24 N N))) (b "where" 29 (b "of" 27 (b "module" 26 N N) (b "type" 28 N N)) (b "|" 31 (b "{" 30 N N) (b "}" 32 N N))))+ where b s n = let bs = id s+ in B bs (TS bs n)++unescapeInitTail :: String -> String+unescapeInitTail = id . unesc . tail . id where+ unesc s = case s of+ '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs+ '\\':'n':cs -> '\n' : unesc cs+ '\\':'t':cs -> '\t' : unesc cs+ '"':[] -> []+ c:cs -> c : unesc cs+ _ -> []++-------------------------------------------------------------------+-- Alex wrapper code.+-- A modified "posn" wrapper.+-------------------------------------------------------------------++data Posn = Pn !Int !Int !Int+ deriving (Eq, Show,Ord)++alexStartPos :: Posn+alexStartPos = Pn 0 1 1++alexMove :: Posn -> Char -> Posn+alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1+alexMove (Pn a l c) _ = Pn (a+1) l (c+1)++type AlexInput = (Posn, -- current position,+ Char, -- previous char+ String) -- current input string++tokens :: String -> [Token]+tokens str = go (alexStartPos, '\n', str)+ where+ go :: AlexInput -> [Token]+ go inp@(pos, _, str) =+ case alexScan inp 0 of+ AlexEOF -> []+ AlexError (pos, _, _) -> [Err pos]+ AlexSkip inp' len -> go inp'+ AlexToken inp' len act -> act pos (take len str) : (go inp')++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (p, _, s) =+ case s of+ [] -> Nothing+ (c:s) ->+ let p' = alexMove p c+ in p' `seq` Just (c, (p', c, s))++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p, c, s) = c+}
+ Language/Pec/Par.hs view
@@ -0,0 +1,3137 @@+{-# OPTIONS_GHC -w #-}+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}+module Language.Pec.Par where+import Language.Pec.Abs+import Language.Pec.Lex+import Language.Pec.ErrM++-- parser produced by Happy Version 1.18.6++data HappyAbsSyn + = HappyTerminal (Token)+ | HappyErrorToken Int+ | HappyAbsSyn4 (String)+ | HappyAbsSyn5 (Char)+ | HappyAbsSyn6 (Frac)+ | HappyAbsSyn7 (Uident)+ | HappyAbsSyn8 (Lident)+ | HappyAbsSyn9 (USym)+ | HappyAbsSyn10 (Number)+ | HappyAbsSyn11 (Count)+ | HappyAbsSyn12 (Module)+ | HappyAbsSyn13 (ExportDecl)+ | HappyAbsSyn14 (Export)+ | HappyAbsSyn15 (Spec)+ | HappyAbsSyn16 (TopDecl)+ | HappyAbsSyn17 (AsSpec)+ | HappyAbsSyn18 (ExtNm)+ | HappyAbsSyn19 (Exp)+ | HappyAbsSyn26 (UnOp)+ | HappyAbsSyn27 (CaseAlt)+ | HappyAbsSyn28 (CasePat)+ | HappyAbsSyn29 (BranchAlt)+ | HappyAbsSyn30 (BranchPat)+ | HappyAbsSyn31 (Type)+ | HappyAbsSyn35 (TyDecl)+ | HappyAbsSyn36 (ConC)+ | HappyAbsSyn37 (FieldT)+ | HappyAbsSyn38 (Lit)+ | HappyAbsSyn39 (FieldD)+ | HappyAbsSyn40 (Var)+ | HappyAbsSyn41 (Con)+ | HappyAbsSyn42 (Modid)+ | HappyAbsSyn43 (Field)+ | HappyAbsSyn44 (TyVar)+ | HappyAbsSyn45 ([Exp])+ | HappyAbsSyn46 ([FieldT])+ | HappyAbsSyn47 ([TyVar])+ | HappyAbsSyn48 ([Type])+ | HappyAbsSyn49 ([Export])+ | HappyAbsSyn51 ([ConC])+ | HappyAbsSyn53 ([FieldD])+ | HappyAbsSyn55 ([TopDecl])+ | HappyAbsSyn56 ([CaseAlt])+ | HappyAbsSyn57 ([BranchAlt])++{- to allow type-synonyms as our monads (likely+ - with explicitly-specified bind and return)+ - in Haskell98, it seems that with+ - /type M a = .../, then /(HappyReduction M)/+ - is not allowed. But Happy is a+ - code-generator that can just substitute it.+type HappyReduction m = + Int + -> (Token)+ -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)+ -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)] + -> HappyStk HappyAbsSyn + -> [(Token)] -> m HappyAbsSyn+-}++action_0,+ action_1,+ action_2,+ action_3,+ action_4,+ action_5,+ action_6,+ action_7,+ action_8,+ action_9,+ action_10,+ action_11,+ action_12,+ action_13,+ action_14,+ action_15,+ action_16,+ action_17,+ action_18,+ action_19,+ action_20,+ action_21,+ action_22,+ action_23,+ action_24,+ action_25,+ action_26,+ action_27,+ action_28,+ action_29,+ action_30,+ action_31,+ action_32,+ action_33,+ action_34,+ action_35,+ action_36,+ action_37,+ action_38,+ action_39,+ action_40,+ action_41,+ action_42,+ action_43,+ action_44,+ action_45,+ action_46,+ action_47,+ action_48,+ action_49,+ action_50,+ action_51,+ action_52,+ action_53,+ action_54,+ action_55,+ action_56,+ action_57,+ action_58,+ action_59,+ action_60,+ action_61,+ action_62,+ action_63,+ action_64,+ action_65,+ action_66,+ action_67,+ action_68,+ action_69,+ action_70,+ action_71,+ action_72,+ action_73,+ action_74,+ action_75,+ action_76,+ action_77,+ action_78,+ action_79,+ action_80,+ action_81,+ action_82,+ action_83,+ action_84,+ action_85,+ action_86,+ action_87,+ action_88,+ action_89,+ action_90,+ action_91,+ action_92,+ action_93,+ action_94,+ action_95,+ action_96,+ action_97,+ action_98,+ action_99,+ action_100,+ action_101,+ action_102,+ action_103,+ action_104,+ action_105,+ action_106,+ action_107,+ action_108,+ action_109,+ action_110,+ action_111,+ action_112,+ action_113,+ action_114,+ action_115,+ action_116,+ action_117,+ action_118,+ action_119,+ action_120,+ action_121,+ action_122,+ action_123,+ action_124,+ action_125,+ action_126,+ action_127,+ action_128,+ action_129,+ action_130,+ action_131,+ action_132,+ action_133,+ action_134,+ action_135,+ action_136,+ action_137,+ action_138,+ action_139,+ action_140,+ action_141,+ action_142,+ action_143,+ action_144,+ action_145,+ action_146,+ action_147,+ action_148,+ action_149,+ action_150,+ action_151,+ action_152,+ action_153,+ action_154,+ action_155,+ action_156,+ action_157,+ action_158,+ action_159,+ action_160,+ action_161,+ action_162,+ action_163,+ action_164,+ action_165,+ action_166,+ action_167,+ action_168,+ action_169,+ action_170,+ action_171,+ action_172,+ action_173,+ action_174,+ action_175,+ action_176,+ action_177,+ action_178,+ action_179,+ action_180,+ action_181,+ action_182,+ action_183,+ action_184,+ action_185,+ action_186,+ action_187,+ action_188,+ action_189,+ action_190,+ action_191,+ action_192,+ action_193,+ action_194,+ action_195,+ action_196,+ action_197,+ action_198,+ action_199,+ action_200,+ action_201,+ action_202,+ action_203 :: () => Int -> ({-HappyReduction (Err) = -}+ Int + -> (Token)+ -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn)+ -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn)] + -> HappyStk HappyAbsSyn + -> [(Token)] -> (Err) HappyAbsSyn)++happyReduce_1,+ happyReduce_2,+ happyReduce_3,+ happyReduce_4,+ happyReduce_5,+ happyReduce_6,+ happyReduce_7,+ happyReduce_8,+ happyReduce_9,+ happyReduce_10,+ happyReduce_11,+ happyReduce_12,+ happyReduce_13,+ happyReduce_14,+ happyReduce_15,+ happyReduce_16,+ happyReduce_17,+ happyReduce_18,+ happyReduce_19,+ happyReduce_20,+ happyReduce_21,+ happyReduce_22,+ happyReduce_23,+ happyReduce_24,+ happyReduce_25,+ happyReduce_26,+ happyReduce_27,+ happyReduce_28,+ happyReduce_29,+ happyReduce_30,+ happyReduce_31,+ happyReduce_32,+ happyReduce_33,+ happyReduce_34,+ happyReduce_35,+ happyReduce_36,+ happyReduce_37,+ happyReduce_38,+ happyReduce_39,+ happyReduce_40,+ happyReduce_41,+ happyReduce_42,+ happyReduce_43,+ happyReduce_44,+ happyReduce_45,+ happyReduce_46,+ happyReduce_47,+ happyReduce_48,+ happyReduce_49,+ happyReduce_50,+ happyReduce_51,+ happyReduce_52,+ happyReduce_53,+ happyReduce_54,+ happyReduce_55,+ happyReduce_56,+ happyReduce_57,+ happyReduce_58,+ happyReduce_59,+ happyReduce_60,+ happyReduce_61,+ happyReduce_62,+ happyReduce_63,+ happyReduce_64,+ happyReduce_65,+ happyReduce_66,+ happyReduce_67,+ happyReduce_68,+ happyReduce_69,+ happyReduce_70,+ happyReduce_71,+ happyReduce_72,+ happyReduce_73,+ happyReduce_74,+ happyReduce_75,+ happyReduce_76,+ happyReduce_77,+ happyReduce_78,+ happyReduce_79,+ happyReduce_80,+ happyReduce_81,+ happyReduce_82,+ happyReduce_83,+ happyReduce_84,+ happyReduce_85,+ happyReduce_86,+ happyReduce_87,+ happyReduce_88,+ happyReduce_89,+ happyReduce_90,+ happyReduce_91,+ happyReduce_92,+ happyReduce_93,+ happyReduce_94,+ happyReduce_95,+ happyReduce_96,+ happyReduce_97,+ happyReduce_98,+ happyReduce_99,+ happyReduce_100,+ happyReduce_101,+ happyReduce_102,+ happyReduce_103,+ happyReduce_104,+ happyReduce_105,+ happyReduce_106,+ happyReduce_107,+ happyReduce_108,+ happyReduce_109,+ happyReduce_110,+ happyReduce_111,+ happyReduce_112,+ happyReduce_113,+ happyReduce_114,+ happyReduce_115,+ happyReduce_116,+ happyReduce_117,+ happyReduce_118 :: () => ({-HappyReduction (Err) = -}+ Int + -> (Token)+ -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn)+ -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> (Err) HappyAbsSyn)] + -> HappyStk HappyAbsSyn + -> [(Token)] -> (Err) HappyAbsSyn)++action_0 (84) = happyShift action_4+action_0 (12) = happyGoto action_3+action_0 _ = happyFail++action_1 (91) = happyShift action_2+action_1 _ = happyFail++action_2 _ = happyReduce_1++action_3 (100) = happyAccept+action_3 _ = happyFail++action_4 (94) = happyShift action_7+action_4 (7) = happyGoto action_5+action_4 (42) = happyGoto action_6+action_4 _ = happyFail++action_5 _ = happyReduce_82++action_6 (79) = happyShift action_8+action_6 _ = happyFail++action_7 _ = happyReduce_4++action_8 (60) = happyShift action_10+action_8 (74) = happyShift action_11+action_8 (13) = happyGoto action_9+action_8 _ = happyFail++action_9 (87) = happyShift action_19+action_9 _ = happyFail++action_10 (94) = happyShift action_7+action_10 (95) = happyShift action_18+action_10 (7) = happyGoto action_12+action_10 (8) = happyGoto action_13+action_10 (14) = happyGoto action_14+action_10 (40) = happyGoto action_15+action_10 (41) = happyGoto action_16+action_10 (49) = happyGoto action_17+action_10 _ = happyReduce_97++action_11 _ = happyReduce_10++action_12 _ = happyReduce_81++action_13 _ = happyReduce_80++action_14 (62) = happyShift action_24+action_14 _ = happyReduce_98++action_15 _ = happyReduce_13++action_16 (60) = happyShift action_23+action_16 (15) = happyGoto action_22+action_16 _ = happyReduce_14++action_17 (61) = happyShift action_21+action_17 _ = happyFail++action_18 _ = happyReduce_5++action_19 (88) = happyShift action_20+action_19 _ = happyFail++action_20 (80) = happyShift action_31+action_20 (81) = happyShift action_32+action_20 (86) = happyShift action_33+action_20 (95) = happyShift action_18+action_20 (8) = happyGoto action_13+action_20 (16) = happyGoto action_28+action_20 (40) = happyGoto action_29+action_20 (55) = happyGoto action_30+action_20 _ = happyReduce_110++action_21 _ = happyReduce_11++action_22 _ = happyReduce_12++action_23 (64) = happyShift action_26+action_23 (65) = happyShift action_27+action_23 _ = happyFail++action_24 (94) = happyShift action_7+action_24 (95) = happyShift action_18+action_24 (7) = happyGoto action_12+action_24 (8) = happyGoto action_13+action_24 (14) = happyGoto action_14+action_24 (40) = happyGoto action_15+action_24 (41) = happyGoto action_16+action_24 (49) = happyGoto action_25+action_24 _ = happyReduce_97++action_25 _ = happyReduce_99++action_26 (61) = happyShift action_60+action_26 _ = happyFail++action_27 (61) = happyShift action_59+action_27 _ = happyFail++action_28 (67) = happyShift action_58+action_28 _ = happyReduce_111++action_29 (60) = happyShift action_49+action_29 (66) = happyShift action_50+action_29 (69) = happyShift action_51+action_29 (71) = happyShift action_52+action_29 (88) = happyShift action_53+action_29 (91) = happyShift action_2+action_29 (92) = happyShift action_54+action_29 (93) = happyShift action_55+action_29 (94) = happyShift action_7+action_29 (95) = happyShift action_18+action_29 (97) = happyShift action_56+action_29 (98) = happyShift action_57+action_29 (4) = happyGoto action_39+action_29 (5) = happyGoto action_40+action_29 (6) = happyGoto action_41+action_29 (7) = happyGoto action_12+action_29 (8) = happyGoto action_13+action_29 (10) = happyGoto action_42+action_29 (11) = happyGoto action_43+action_29 (25) = happyGoto action_44+action_29 (38) = happyGoto action_45+action_29 (40) = happyGoto action_46+action_29 (41) = happyGoto action_47+action_29 (52) = happyGoto action_48+action_29 _ = happyFail++action_30 (90) = happyShift action_38+action_30 _ = happyFail++action_31 (91) = happyShift action_2+action_31 (4) = happyGoto action_36+action_31 (18) = happyGoto action_37+action_31 _ = happyReduce_26++action_32 (94) = happyShift action_7+action_32 (7) = happyGoto action_5+action_32 (42) = happyGoto action_35+action_32 _ = happyFail++action_33 (94) = happyShift action_7+action_33 (7) = happyGoto action_12+action_33 (41) = happyGoto action_34+action_33 _ = happyFail++action_34 (47) = happyGoto action_98+action_34 _ = happyReduce_92++action_35 (75) = happyShift action_97+action_35 (17) = happyGoto action_96+action_35 _ = happyReduce_24++action_36 _ = happyReduce_25++action_37 (95) = happyShift action_18+action_37 (8) = happyGoto action_13+action_37 (40) = happyGoto action_95+action_37 _ = happyFail++action_38 _ = happyReduce_9++action_39 _ = happyReduce_75++action_40 _ = happyReduce_74++action_41 _ = happyReduce_77++action_42 _ = happyReduce_76++action_43 _ = happyReduce_48++action_44 (60) = happyShift action_49+action_44 (71) = happyShift action_52+action_44 (88) = happyShift action_53+action_44 (91) = happyShift action_2+action_44 (92) = happyShift action_54+action_44 (93) = happyShift action_55+action_44 (94) = happyShift action_7+action_44 (95) = happyShift action_18+action_44 (97) = happyShift action_56+action_44 (98) = happyShift action_57+action_44 (4) = happyGoto action_39+action_44 (5) = happyGoto action_40+action_44 (6) = happyGoto action_41+action_44 (7) = happyGoto action_12+action_44 (8) = happyGoto action_13+action_44 (10) = happyGoto action_42+action_44 (11) = happyGoto action_43+action_44 (25) = happyGoto action_44+action_44 (38) = happyGoto action_45+action_44 (40) = happyGoto action_46+action_44 (41) = happyGoto action_47+action_44 (52) = happyGoto action_94+action_44 _ = happyReduce_104++action_45 _ = happyReduce_50++action_46 _ = happyReduce_49++action_47 _ = happyReduce_78++action_48 (69) = happyShift action_93+action_48 _ = happyFail++action_49 (60) = happyShift action_49+action_49 (70) = happyShift action_75+action_49 (71) = happyShift action_52+action_49 (76) = happyShift action_76+action_49 (77) = happyShift action_77+action_49 (78) = happyShift action_78+action_49 (83) = happyShift action_79+action_49 (88) = happyShift action_53+action_49 (91) = happyShift action_2+action_49 (92) = happyShift action_54+action_49 (93) = happyShift action_55+action_49 (94) = happyShift action_7+action_49 (95) = happyShift action_18+action_49 (97) = happyShift action_56+action_49 (98) = happyShift action_57+action_49 (4) = happyGoto action_39+action_49 (5) = happyGoto action_40+action_49 (6) = happyGoto action_41+action_49 (7) = happyGoto action_12+action_49 (8) = happyGoto action_13+action_49 (10) = happyGoto action_42+action_49 (11) = happyGoto action_43+action_49 (19) = happyGoto action_91+action_49 (20) = happyGoto action_68+action_49 (21) = happyGoto action_69+action_49 (22) = happyGoto action_70+action_49 (23) = happyGoto action_71+action_49 (24) = happyGoto action_72+action_49 (25) = happyGoto action_73+action_49 (26) = happyGoto action_74+action_49 (38) = happyGoto action_45+action_49 (40) = happyGoto action_46+action_49 (41) = happyGoto action_47+action_49 (45) = happyGoto action_92+action_49 _ = happyReduce_86++action_50 (59) = happyShift action_88+action_50 (60) = happyShift action_89+action_50 (71) = happyShift action_90+action_50 (94) = happyShift action_7+action_50 (95) = happyShift action_18+action_50 (98) = happyShift action_57+action_50 (7) = happyGoto action_12+action_50 (8) = happyGoto action_80+action_50 (11) = happyGoto action_81+action_50 (31) = happyGoto action_82+action_50 (32) = happyGoto action_83+action_50 (33) = happyGoto action_84+action_50 (34) = happyGoto action_85+action_50 (41) = happyGoto action_86+action_50 (44) = happyGoto action_87+action_50 _ = happyFail++action_51 (60) = happyShift action_49+action_51 (70) = happyShift action_75+action_51 (71) = happyShift action_52+action_51 (76) = happyShift action_76+action_51 (77) = happyShift action_77+action_51 (78) = happyShift action_78+action_51 (83) = happyShift action_79+action_51 (88) = happyShift action_53+action_51 (91) = happyShift action_2+action_51 (92) = happyShift action_54+action_51 (93) = happyShift action_55+action_51 (94) = happyShift action_7+action_51 (95) = happyShift action_18+action_51 (97) = happyShift action_56+action_51 (98) = happyShift action_57+action_51 (4) = happyGoto action_39+action_51 (5) = happyGoto action_40+action_51 (6) = happyGoto action_41+action_51 (7) = happyGoto action_12+action_51 (8) = happyGoto action_13+action_51 (10) = happyGoto action_42+action_51 (11) = happyGoto action_43+action_51 (19) = happyGoto action_67+action_51 (20) = happyGoto action_68+action_51 (21) = happyGoto action_69+action_51 (22) = happyGoto action_70+action_51 (23) = happyGoto action_71+action_51 (24) = happyGoto action_72+action_51 (25) = happyGoto action_73+action_51 (26) = happyGoto action_74+action_51 (38) = happyGoto action_45+action_51 (40) = happyGoto action_46+action_51 (41) = happyGoto action_47+action_51 _ = happyFail++action_52 (72) = happyShift action_66+action_52 _ = happyFail++action_53 (95) = happyShift action_18+action_53 (8) = happyGoto action_62+action_53 (39) = happyGoto action_63+action_53 (43) = happyGoto action_64+action_53 (53) = happyGoto action_65+action_53 _ = happyFail++action_54 _ = happyReduce_2++action_55 _ = happyReduce_3++action_56 _ = happyReduce_7++action_57 _ = happyReduce_8++action_58 (80) = happyShift action_31+action_58 (81) = happyShift action_32+action_58 (86) = happyShift action_33+action_58 (95) = happyShift action_18+action_58 (8) = happyGoto action_13+action_58 (16) = happyGoto action_28+action_58 (40) = happyGoto action_29+action_58 (55) = happyGoto action_61+action_58 _ = happyReduce_110++action_59 _ = happyReduce_16++action_60 _ = happyReduce_15++action_61 _ = happyReduce_112++action_62 _ = happyReduce_83++action_63 (62) = happyShift action_131+action_63 _ = happyReduce_106++action_64 (69) = happyShift action_130+action_64 _ = happyFail++action_65 (90) = happyShift action_129+action_65 _ = happyFail++action_66 (60) = happyShift action_49+action_66 (70) = happyShift action_75+action_66 (71) = happyShift action_52+action_66 (76) = happyShift action_76+action_66 (77) = happyShift action_77+action_66 (78) = happyShift action_78+action_66 (83) = happyShift action_79+action_66 (88) = happyShift action_53+action_66 (91) = happyShift action_2+action_66 (92) = happyShift action_54+action_66 (93) = happyShift action_55+action_66 (94) = happyShift action_7+action_66 (95) = happyShift action_18+action_66 (97) = happyShift action_56+action_66 (98) = happyShift action_57+action_66 (4) = happyGoto action_39+action_66 (5) = happyGoto action_40+action_66 (6) = happyGoto action_41+action_66 (7) = happyGoto action_12+action_66 (8) = happyGoto action_13+action_66 (10) = happyGoto action_42+action_66 (11) = happyGoto action_43+action_66 (19) = happyGoto action_127+action_66 (20) = happyGoto action_68+action_66 (21) = happyGoto action_69+action_66 (22) = happyGoto action_70+action_66 (23) = happyGoto action_71+action_66 (24) = happyGoto action_72+action_66 (25) = happyGoto action_73+action_66 (26) = happyGoto action_74+action_66 (38) = happyGoto action_45+action_66 (40) = happyGoto action_46+action_66 (41) = happyGoto action_47+action_66 (45) = happyGoto action_128+action_66 _ = happyReduce_86++action_67 _ = happyReduce_21++action_68 _ = happyReduce_28++action_69 (68) = happyShift action_125+action_69 (69) = happyShift action_126+action_69 _ = happyReduce_34++action_70 (60) = happyShift action_49+action_70 (70) = happyShift action_75+action_70 (71) = happyShift action_52+action_70 (88) = happyShift action_53+action_70 (91) = happyShift action_2+action_70 (92) = happyShift action_54+action_70 (93) = happyShift action_55+action_70 (94) = happyShift action_7+action_70 (95) = happyShift action_18+action_70 (96) = happyShift action_124+action_70 (97) = happyShift action_56+action_70 (98) = happyShift action_57+action_70 (4) = happyGoto action_39+action_70 (5) = happyGoto action_40+action_70 (6) = happyGoto action_41+action_70 (7) = happyGoto action_12+action_70 (8) = happyGoto action_13+action_70 (9) = happyGoto action_122+action_70 (10) = happyGoto action_42+action_70 (11) = happyGoto action_43+action_70 (23) = happyGoto action_123+action_70 (24) = happyGoto action_72+action_70 (25) = happyGoto action_73+action_70 (26) = happyGoto action_74+action_70 (38) = happyGoto action_45+action_70 (40) = happyGoto action_46+action_70 (41) = happyGoto action_47+action_70 _ = happyReduce_36++action_71 _ = happyReduce_38++action_72 (64) = happyShift action_120+action_72 (72) = happyShift action_121+action_72 _ = happyReduce_40++action_73 _ = happyReduce_43++action_74 (60) = happyShift action_49+action_74 (71) = happyShift action_52+action_74 (88) = happyShift action_53+action_74 (91) = happyShift action_2+action_74 (92) = happyShift action_54+action_74 (93) = happyShift action_55+action_74 (94) = happyShift action_7+action_74 (95) = happyShift action_18+action_74 (97) = happyShift action_56+action_74 (98) = happyShift action_57+action_74 (4) = happyGoto action_39+action_74 (5) = happyGoto action_40+action_74 (6) = happyGoto action_41+action_74 (7) = happyGoto action_12+action_74 (8) = happyGoto action_13+action_74 (10) = happyGoto action_42+action_74 (11) = happyGoto action_43+action_74 (24) = happyGoto action_119+action_74 (25) = happyGoto action_73+action_74 (38) = happyGoto action_45+action_74 (40) = happyGoto action_46+action_74 (41) = happyGoto action_47+action_74 _ = happyFail++action_75 _ = happyReduce_51++action_76 (85) = happyShift action_118+action_76 _ = happyFail++action_77 (60) = happyShift action_49+action_77 (70) = happyShift action_75+action_77 (71) = happyShift action_52+action_77 (76) = happyShift action_76+action_77 (77) = happyShift action_77+action_77 (78) = happyShift action_78+action_77 (83) = happyShift action_79+action_77 (88) = happyShift action_53+action_77 (91) = happyShift action_2+action_77 (92) = happyShift action_54+action_77 (93) = happyShift action_55+action_77 (94) = happyShift action_7+action_77 (95) = happyShift action_18+action_77 (97) = happyShift action_56+action_77 (98) = happyShift action_57+action_77 (4) = happyGoto action_39+action_77 (5) = happyGoto action_40+action_77 (6) = happyGoto action_41+action_77 (7) = happyGoto action_12+action_77 (8) = happyGoto action_13+action_77 (10) = happyGoto action_42+action_77 (11) = happyGoto action_43+action_77 (19) = happyGoto action_117+action_77 (20) = happyGoto action_68+action_77 (21) = happyGoto action_69+action_77 (22) = happyGoto action_70+action_77 (23) = happyGoto action_71+action_77 (24) = happyGoto action_72+action_77 (25) = happyGoto action_73+action_77 (26) = happyGoto action_74+action_77 (38) = happyGoto action_45+action_77 (40) = happyGoto action_46+action_77 (41) = happyGoto action_47+action_77 _ = happyFail++action_78 (88) = happyShift action_116+action_78 _ = happyFail++action_79 (60) = happyShift action_49+action_79 (70) = happyShift action_75+action_79 (71) = happyShift action_52+action_79 (88) = happyShift action_53+action_79 (91) = happyShift action_2+action_79 (92) = happyShift action_54+action_79 (93) = happyShift action_55+action_79 (94) = happyShift action_7+action_79 (95) = happyShift action_18+action_79 (97) = happyShift action_56+action_79 (98) = happyShift action_57+action_79 (4) = happyGoto action_39+action_79 (5) = happyGoto action_40+action_79 (6) = happyGoto action_41+action_79 (7) = happyGoto action_12+action_79 (8) = happyGoto action_13+action_79 (10) = happyGoto action_42+action_79 (11) = happyGoto action_43+action_79 (21) = happyGoto action_115+action_79 (22) = happyGoto action_70+action_79 (23) = happyGoto action_71+action_79 (24) = happyGoto action_72+action_79 (25) = happyGoto action_73+action_79 (26) = happyGoto action_74+action_79 (38) = happyGoto action_45+action_79 (40) = happyGoto action_46+action_79 (41) = happyGoto action_47+action_79 _ = happyFail++action_80 _ = happyReduce_84++action_81 _ = happyReduce_66++action_82 _ = happyReduce_20++action_83 (63) = happyShift action_114+action_83 _ = happyReduce_60++action_84 _ = happyReduce_63++action_85 _ = happyReduce_64++action_86 (59) = happyShift action_88+action_86 (60) = happyShift action_89+action_86 (94) = happyShift action_7+action_86 (95) = happyShift action_18+action_86 (98) = happyShift action_57+action_86 (7) = happyGoto action_12+action_86 (8) = happyGoto action_80+action_86 (11) = happyGoto action_81+action_86 (33) = happyGoto action_112+action_86 (34) = happyGoto action_85+action_86 (41) = happyGoto action_108+action_86 (44) = happyGoto action_87+action_86 (54) = happyGoto action_113+action_86 _ = happyReduce_68++action_87 _ = happyReduce_67++action_88 (95) = happyShift action_18+action_88 (8) = happyGoto action_111+action_88 _ = happyFail++action_89 (59) = happyShift action_88+action_89 (60) = happyShift action_89+action_89 (71) = happyShift action_90+action_89 (94) = happyShift action_7+action_89 (95) = happyShift action_18+action_89 (98) = happyShift action_57+action_89 (7) = happyGoto action_12+action_89 (8) = happyGoto action_80+action_89 (11) = happyGoto action_81+action_89 (31) = happyGoto action_109+action_89 (32) = happyGoto action_83+action_89 (33) = happyGoto action_84+action_89 (34) = happyGoto action_85+action_89 (41) = happyGoto action_86+action_89 (44) = happyGoto action_87+action_89 (48) = happyGoto action_110+action_89 _ = happyReduce_94++action_90 (59) = happyShift action_88+action_90 (60) = happyShift action_89+action_90 (94) = happyShift action_7+action_90 (95) = happyShift action_18+action_90 (98) = happyShift action_57+action_90 (7) = happyGoto action_12+action_90 (8) = happyGoto action_80+action_90 (11) = happyGoto action_81+action_90 (33) = happyGoto action_107+action_90 (34) = happyGoto action_85+action_90 (41) = happyGoto action_108+action_90 (44) = happyGoto action_87+action_90 _ = happyFail++action_91 (62) = happyShift action_105+action_91 (66) = happyShift action_106+action_91 _ = happyReduce_87++action_92 (61) = happyShift action_104+action_92 _ = happyFail++action_93 (60) = happyShift action_49+action_93 (70) = happyShift action_75+action_93 (71) = happyShift action_52+action_93 (76) = happyShift action_76+action_93 (77) = happyShift action_77+action_93 (78) = happyShift action_78+action_93 (83) = happyShift action_79+action_93 (88) = happyShift action_53+action_93 (91) = happyShift action_2+action_93 (92) = happyShift action_54+action_93 (93) = happyShift action_55+action_93 (94) = happyShift action_7+action_93 (95) = happyShift action_18+action_93 (97) = happyShift action_56+action_93 (98) = happyShift action_57+action_93 (4) = happyGoto action_39+action_93 (5) = happyGoto action_40+action_93 (6) = happyGoto action_41+action_93 (7) = happyGoto action_12+action_93 (8) = happyGoto action_13+action_93 (10) = happyGoto action_42+action_93 (11) = happyGoto action_43+action_93 (19) = happyGoto action_103+action_93 (20) = happyGoto action_68+action_93 (21) = happyGoto action_69+action_93 (22) = happyGoto action_70+action_93 (23) = happyGoto action_71+action_93 (24) = happyGoto action_72+action_93 (25) = happyGoto action_73+action_93 (26) = happyGoto action_74+action_93 (38) = happyGoto action_45+action_93 (40) = happyGoto action_46+action_93 (41) = happyGoto action_47+action_93 _ = happyFail++action_94 _ = happyReduce_105++action_95 (66) = happyShift action_102+action_95 _ = happyFail++action_96 _ = happyReduce_17++action_97 (94) = happyShift action_7+action_97 (7) = happyGoto action_12+action_97 (41) = happyGoto action_101+action_97 _ = happyFail++action_98 (59) = happyShift action_88+action_98 (69) = happyShift action_100+action_98 (95) = happyShift action_18+action_98 (8) = happyGoto action_80+action_98 (44) = happyGoto action_99+action_98 _ = happyFail++action_99 _ = happyReduce_93++action_100 (59) = happyShift action_88+action_100 (60) = happyShift action_89+action_100 (71) = happyShift action_90+action_100 (88) = happyShift action_155+action_100 (89) = happyShift action_156+action_100 (94) = happyShift action_7+action_100 (95) = happyShift action_18+action_100 (98) = happyShift action_57+action_100 (7) = happyGoto action_12+action_100 (8) = happyGoto action_80+action_100 (11) = happyGoto action_81+action_100 (31) = happyGoto action_153+action_100 (32) = happyGoto action_83+action_100 (33) = happyGoto action_84+action_100 (34) = happyGoto action_85+action_100 (35) = happyGoto action_154+action_100 (41) = happyGoto action_86+action_100 (44) = happyGoto action_87+action_100 _ = happyFail++action_101 _ = happyReduce_23++action_102 (59) = happyShift action_88+action_102 (60) = happyShift action_89+action_102 (71) = happyShift action_90+action_102 (94) = happyShift action_7+action_102 (95) = happyShift action_18+action_102 (98) = happyShift action_57+action_102 (7) = happyGoto action_12+action_102 (8) = happyGoto action_80+action_102 (11) = happyGoto action_81+action_102 (31) = happyGoto action_152+action_102 (32) = happyGoto action_83+action_102 (33) = happyGoto action_84+action_102 (34) = happyGoto action_85+action_102 (41) = happyGoto action_86+action_102 (44) = happyGoto action_87+action_102 _ = happyFail++action_103 _ = happyReduce_22++action_104 _ = happyReduce_46++action_105 (60) = happyShift action_49+action_105 (70) = happyShift action_75+action_105 (71) = happyShift action_52+action_105 (76) = happyShift action_76+action_105 (77) = happyShift action_77+action_105 (78) = happyShift action_78+action_105 (83) = happyShift action_79+action_105 (88) = happyShift action_53+action_105 (91) = happyShift action_2+action_105 (92) = happyShift action_54+action_105 (93) = happyShift action_55+action_105 (94) = happyShift action_7+action_105 (95) = happyShift action_18+action_105 (97) = happyShift action_56+action_105 (98) = happyShift action_57+action_105 (4) = happyGoto action_39+action_105 (5) = happyGoto action_40+action_105 (6) = happyGoto action_41+action_105 (7) = happyGoto action_12+action_105 (8) = happyGoto action_13+action_105 (10) = happyGoto action_42+action_105 (11) = happyGoto action_43+action_105 (19) = happyGoto action_127+action_105 (20) = happyGoto action_68+action_105 (21) = happyGoto action_69+action_105 (22) = happyGoto action_70+action_105 (23) = happyGoto action_71+action_105 (24) = happyGoto action_72+action_105 (25) = happyGoto action_73+action_105 (26) = happyGoto action_74+action_105 (38) = happyGoto action_45+action_105 (40) = happyGoto action_46+action_105 (41) = happyGoto action_47+action_105 (45) = happyGoto action_151+action_105 _ = happyReduce_86++action_106 (59) = happyShift action_88+action_106 (60) = happyShift action_89+action_106 (71) = happyShift action_90+action_106 (94) = happyShift action_7+action_106 (95) = happyShift action_18+action_106 (98) = happyShift action_57+action_106 (7) = happyGoto action_12+action_106 (8) = happyGoto action_80+action_106 (11) = happyGoto action_81+action_106 (31) = happyGoto action_150+action_106 (32) = happyGoto action_83+action_106 (33) = happyGoto action_84+action_106 (34) = happyGoto action_85+action_106 (41) = happyGoto action_86+action_106 (44) = happyGoto action_87+action_106 _ = happyFail++action_107 (59) = happyShift action_88+action_107 (60) = happyShift action_89+action_107 (94) = happyShift action_7+action_107 (95) = happyShift action_18+action_107 (98) = happyShift action_57+action_107 (7) = happyGoto action_12+action_107 (8) = happyGoto action_80+action_107 (11) = happyGoto action_81+action_107 (33) = happyGoto action_149+action_107 (34) = happyGoto action_85+action_107 (41) = happyGoto action_108+action_107 (44) = happyGoto action_87+action_107 _ = happyFail++action_108 _ = happyReduce_68++action_109 (62) = happyShift action_148+action_109 _ = happyReduce_95++action_110 (61) = happyShift action_147+action_110 _ = happyFail++action_111 _ = happyReduce_85++action_112 (59) = happyShift action_88+action_112 (60) = happyShift action_89+action_112 (94) = happyShift action_7+action_112 (95) = happyShift action_18+action_112 (98) = happyShift action_57+action_112 (7) = happyGoto action_12+action_112 (8) = happyGoto action_80+action_112 (11) = happyGoto action_81+action_112 (33) = happyGoto action_112+action_112 (34) = happyGoto action_85+action_112 (41) = happyGoto action_108+action_112 (44) = happyGoto action_87+action_112 (54) = happyGoto action_146+action_112 _ = happyReduce_108++action_113 _ = happyReduce_62++action_114 (59) = happyShift action_88+action_114 (60) = happyShift action_89+action_114 (71) = happyShift action_90+action_114 (94) = happyShift action_7+action_114 (95) = happyShift action_18+action_114 (98) = happyShift action_57+action_114 (7) = happyGoto action_12+action_114 (8) = happyGoto action_80+action_114 (11) = happyGoto action_81+action_114 (31) = happyGoto action_145+action_114 (32) = happyGoto action_83+action_114 (33) = happyGoto action_84+action_114 (34) = happyGoto action_85+action_114 (41) = happyGoto action_86+action_114 (44) = happyGoto action_87+action_114 _ = happyFail++action_115 (69) = happyShift action_144+action_115 _ = happyFail++action_116 (60) = happyShift action_49+action_116 (70) = happyShift action_75+action_116 (71) = happyShift action_52+action_116 (76) = happyShift action_76+action_116 (77) = happyShift action_77+action_116 (83) = happyShift action_79+action_116 (88) = happyShift action_53+action_116 (91) = happyShift action_2+action_116 (92) = happyShift action_54+action_116 (93) = happyShift action_55+action_116 (94) = happyShift action_7+action_116 (95) = happyShift action_18+action_116 (97) = happyShift action_56+action_116 (98) = happyShift action_57+action_116 (4) = happyGoto action_39+action_116 (5) = happyGoto action_40+action_116 (6) = happyGoto action_41+action_116 (7) = happyGoto action_12+action_116 (8) = happyGoto action_13+action_116 (10) = happyGoto action_42+action_116 (11) = happyGoto action_43+action_116 (20) = happyGoto action_142+action_116 (21) = happyGoto action_69+action_116 (22) = happyGoto action_70+action_116 (23) = happyGoto action_71+action_116 (24) = happyGoto action_72+action_116 (25) = happyGoto action_73+action_116 (26) = happyGoto action_74+action_116 (38) = happyGoto action_45+action_116 (40) = happyGoto action_46+action_116 (41) = happyGoto action_47+action_116 (58) = happyGoto action_143+action_116 _ = happyFail++action_117 (85) = happyShift action_141+action_117 _ = happyFail++action_118 (88) = happyShift action_140+action_118 _ = happyFail++action_119 (64) = happyShift action_120+action_119 (72) = happyShift action_121+action_119 _ = happyReduce_39++action_120 (95) = happyShift action_18+action_120 (8) = happyGoto action_62+action_120 (43) = happyGoto action_139+action_120 _ = happyFail++action_121 (60) = happyShift action_49+action_121 (70) = happyShift action_75+action_121 (71) = happyShift action_52+action_121 (76) = happyShift action_76+action_121 (77) = happyShift action_77+action_121 (78) = happyShift action_78+action_121 (83) = happyShift action_79+action_121 (88) = happyShift action_53+action_121 (91) = happyShift action_2+action_121 (92) = happyShift action_54+action_121 (93) = happyShift action_55+action_121 (94) = happyShift action_7+action_121 (95) = happyShift action_18+action_121 (97) = happyShift action_56+action_121 (98) = happyShift action_57+action_121 (4) = happyGoto action_39+action_121 (5) = happyGoto action_40+action_121 (6) = happyGoto action_41+action_121 (7) = happyGoto action_12+action_121 (8) = happyGoto action_13+action_121 (10) = happyGoto action_42+action_121 (11) = happyGoto action_43+action_121 (19) = happyGoto action_138+action_121 (20) = happyGoto action_68+action_121 (21) = happyGoto action_69+action_121 (22) = happyGoto action_70+action_121 (23) = happyGoto action_71+action_121 (24) = happyGoto action_72+action_121 (25) = happyGoto action_73+action_121 (26) = happyGoto action_74+action_121 (38) = happyGoto action_45+action_121 (40) = happyGoto action_46+action_121 (41) = happyGoto action_47+action_121 _ = happyFail++action_122 (60) = happyShift action_49+action_122 (70) = happyShift action_75+action_122 (71) = happyShift action_52+action_122 (88) = happyShift action_53+action_122 (91) = happyShift action_2+action_122 (92) = happyShift action_54+action_122 (93) = happyShift action_55+action_122 (94) = happyShift action_7+action_122 (95) = happyShift action_18+action_122 (97) = happyShift action_56+action_122 (98) = happyShift action_57+action_122 (4) = happyGoto action_39+action_122 (5) = happyGoto action_40+action_122 (6) = happyGoto action_41+action_122 (7) = happyGoto action_12+action_122 (8) = happyGoto action_13+action_122 (10) = happyGoto action_42+action_122 (11) = happyGoto action_43+action_122 (22) = happyGoto action_137+action_122 (23) = happyGoto action_71+action_122 (24) = happyGoto action_72+action_122 (25) = happyGoto action_73+action_122 (26) = happyGoto action_74+action_122 (38) = happyGoto action_45+action_122 (40) = happyGoto action_46+action_122 (41) = happyGoto action_47+action_122 _ = happyFail++action_123 _ = happyReduce_37++action_124 _ = happyReduce_6++action_125 (60) = happyShift action_49+action_125 (70) = happyShift action_75+action_125 (71) = happyShift action_52+action_125 (76) = happyShift action_76+action_125 (77) = happyShift action_77+action_125 (78) = happyShift action_78+action_125 (83) = happyShift action_79+action_125 (88) = happyShift action_53+action_125 (91) = happyShift action_2+action_125 (92) = happyShift action_54+action_125 (93) = happyShift action_55+action_125 (94) = happyShift action_7+action_125 (95) = happyShift action_18+action_125 (97) = happyShift action_56+action_125 (98) = happyShift action_57+action_125 (4) = happyGoto action_39+action_125 (5) = happyGoto action_40+action_125 (6) = happyGoto action_41+action_125 (7) = happyGoto action_12+action_125 (8) = happyGoto action_13+action_125 (10) = happyGoto action_42+action_125 (11) = happyGoto action_43+action_125 (19) = happyGoto action_136+action_125 (20) = happyGoto action_68+action_125 (21) = happyGoto action_69+action_125 (22) = happyGoto action_70+action_125 (23) = happyGoto action_71+action_125 (24) = happyGoto action_72+action_125 (25) = happyGoto action_73+action_125 (26) = happyGoto action_74+action_125 (38) = happyGoto action_45+action_125 (40) = happyGoto action_46+action_125 (41) = happyGoto action_47+action_125 _ = happyFail++action_126 (60) = happyShift action_49+action_126 (70) = happyShift action_75+action_126 (71) = happyShift action_52+action_126 (76) = happyShift action_76+action_126 (77) = happyShift action_77+action_126 (78) = happyShift action_78+action_126 (83) = happyShift action_79+action_126 (88) = happyShift action_53+action_126 (91) = happyShift action_2+action_126 (92) = happyShift action_54+action_126 (93) = happyShift action_55+action_126 (94) = happyShift action_7+action_126 (95) = happyShift action_18+action_126 (97) = happyShift action_56+action_126 (98) = happyShift action_57+action_126 (4) = happyGoto action_39+action_126 (5) = happyGoto action_40+action_126 (6) = happyGoto action_41+action_126 (7) = happyGoto action_12+action_126 (8) = happyGoto action_13+action_126 (10) = happyGoto action_42+action_126 (11) = happyGoto action_43+action_126 (19) = happyGoto action_135+action_126 (20) = happyGoto action_68+action_126 (21) = happyGoto action_69+action_126 (22) = happyGoto action_70+action_126 (23) = happyGoto action_71+action_126 (24) = happyGoto action_72+action_126 (25) = happyGoto action_73+action_126 (26) = happyGoto action_74+action_126 (38) = happyGoto action_45+action_126 (40) = happyGoto action_46+action_126 (41) = happyGoto action_47+action_126 _ = happyFail++action_127 (62) = happyShift action_105+action_127 _ = happyReduce_87++action_128 (73) = happyShift action_134+action_128 _ = happyFail++action_129 _ = happyReduce_45++action_130 (60) = happyShift action_49+action_130 (70) = happyShift action_75+action_130 (71) = happyShift action_52+action_130 (76) = happyShift action_76+action_130 (77) = happyShift action_77+action_130 (78) = happyShift action_78+action_130 (83) = happyShift action_79+action_130 (88) = happyShift action_53+action_130 (91) = happyShift action_2+action_130 (92) = happyShift action_54+action_130 (93) = happyShift action_55+action_130 (94) = happyShift action_7+action_130 (95) = happyShift action_18+action_130 (97) = happyShift action_56+action_130 (98) = happyShift action_57+action_130 (4) = happyGoto action_39+action_130 (5) = happyGoto action_40+action_130 (6) = happyGoto action_41+action_130 (7) = happyGoto action_12+action_130 (8) = happyGoto action_13+action_130 (10) = happyGoto action_42+action_130 (11) = happyGoto action_43+action_130 (19) = happyGoto action_133+action_130 (20) = happyGoto action_68+action_130 (21) = happyGoto action_69+action_130 (22) = happyGoto action_70+action_130 (23) = happyGoto action_71+action_130 (24) = happyGoto action_72+action_130 (25) = happyGoto action_73+action_130 (26) = happyGoto action_74+action_130 (38) = happyGoto action_45+action_130 (40) = happyGoto action_46+action_130 (41) = happyGoto action_47+action_130 _ = happyFail++action_131 (95) = happyShift action_18+action_131 (8) = happyGoto action_62+action_131 (39) = happyGoto action_63+action_131 (43) = happyGoto action_64+action_131 (53) = happyGoto action_132+action_131 _ = happyFail++action_132 _ = happyReduce_107++action_133 _ = happyReduce_79++action_134 _ = happyReduce_44++action_135 _ = happyReduce_29++action_136 _ = happyReduce_31++action_137 (60) = happyShift action_49+action_137 (70) = happyShift action_75+action_137 (71) = happyShift action_52+action_137 (88) = happyShift action_53+action_137 (91) = happyShift action_2+action_137 (92) = happyShift action_54+action_137 (93) = happyShift action_55+action_137 (94) = happyShift action_7+action_137 (95) = happyShift action_18+action_137 (97) = happyShift action_56+action_137 (98) = happyShift action_57+action_137 (4) = happyGoto action_39+action_137 (5) = happyGoto action_40+action_137 (6) = happyGoto action_41+action_137 (7) = happyGoto action_12+action_137 (8) = happyGoto action_13+action_137 (10) = happyGoto action_42+action_137 (11) = happyGoto action_43+action_137 (23) = happyGoto action_123+action_137 (24) = happyGoto action_72+action_137 (25) = happyGoto action_73+action_137 (26) = happyGoto action_74+action_137 (38) = happyGoto action_45+action_137 (40) = happyGoto action_46+action_137 (41) = happyGoto action_47+action_137 _ = happyReduce_35++action_138 (73) = happyShift action_172+action_138 _ = happyFail++action_139 _ = happyReduce_42++action_140 (89) = happyShift action_171+action_140 (29) = happyGoto action_169+action_140 (57) = happyGoto action_170+action_140 _ = happyFail++action_141 (88) = happyShift action_168+action_141 _ = happyFail++action_142 (67) = happyShift action_167+action_142 _ = happyReduce_117++action_143 (90) = happyShift action_166+action_143 _ = happyFail++action_144 (60) = happyShift action_49+action_144 (70) = happyShift action_75+action_144 (71) = happyShift action_52+action_144 (76) = happyShift action_76+action_144 (77) = happyShift action_77+action_144 (78) = happyShift action_78+action_144 (83) = happyShift action_79+action_144 (88) = happyShift action_53+action_144 (91) = happyShift action_2+action_144 (92) = happyShift action_54+action_144 (93) = happyShift action_55+action_144 (94) = happyShift action_7+action_144 (95) = happyShift action_18+action_144 (97) = happyShift action_56+action_144 (98) = happyShift action_57+action_144 (4) = happyGoto action_39+action_144 (5) = happyGoto action_40+action_144 (6) = happyGoto action_41+action_144 (7) = happyGoto action_12+action_144 (8) = happyGoto action_13+action_144 (10) = happyGoto action_42+action_144 (11) = happyGoto action_43+action_144 (19) = happyGoto action_165+action_144 (20) = happyGoto action_68+action_144 (21) = happyGoto action_69+action_144 (22) = happyGoto action_70+action_144 (23) = happyGoto action_71+action_144 (24) = happyGoto action_72+action_144 (25) = happyGoto action_73+action_144 (26) = happyGoto action_74+action_144 (38) = happyGoto action_45+action_144 (40) = happyGoto action_46+action_144 (41) = happyGoto action_47+action_144 _ = happyFail++action_145 _ = happyReduce_59++action_146 _ = happyReduce_109++action_147 _ = happyReduce_65++action_148 (59) = happyShift action_88+action_148 (60) = happyShift action_89+action_148 (71) = happyShift action_90+action_148 (94) = happyShift action_7+action_148 (95) = happyShift action_18+action_148 (98) = happyShift action_57+action_148 (7) = happyGoto action_12+action_148 (8) = happyGoto action_80+action_148 (11) = happyGoto action_81+action_148 (31) = happyGoto action_109+action_148 (32) = happyGoto action_83+action_148 (33) = happyGoto action_84+action_148 (34) = happyGoto action_85+action_148 (41) = happyGoto action_86+action_148 (44) = happyGoto action_87+action_148 (48) = happyGoto action_164+action_148 _ = happyReduce_94++action_149 _ = happyReduce_61++action_150 (61) = happyShift action_163+action_150 _ = happyFail++action_151 _ = happyReduce_88++action_152 _ = happyReduce_18++action_153 _ = happyReduce_71++action_154 _ = happyReduce_19++action_155 (95) = happyShift action_18+action_155 (8) = happyGoto action_62+action_155 (37) = happyGoto action_160+action_155 (43) = happyGoto action_161+action_155 (46) = happyGoto action_162+action_155 _ = happyReduce_89++action_156 (94) = happyShift action_7+action_156 (7) = happyGoto action_12+action_156 (36) = happyGoto action_157+action_156 (41) = happyGoto action_158+action_156 (51) = happyGoto action_159+action_156 _ = happyFail++action_157 (89) = happyShift action_189+action_157 _ = happyReduce_102++action_158 (50) = happyGoto action_188+action_158 _ = happyReduce_100++action_159 _ = happyReduce_70++action_160 (62) = happyShift action_187+action_160 _ = happyReduce_90++action_161 (66) = happyShift action_186+action_161 _ = happyFail++action_162 (90) = happyShift action_185+action_162 _ = happyFail++action_163 _ = happyReduce_47++action_164 _ = happyReduce_96++action_165 (82) = happyShift action_184+action_165 _ = happyFail++action_166 _ = happyReduce_27++action_167 (60) = happyShift action_49+action_167 (70) = happyShift action_75+action_167 (71) = happyShift action_52+action_167 (76) = happyShift action_76+action_167 (77) = happyShift action_77+action_167 (83) = happyShift action_79+action_167 (88) = happyShift action_53+action_167 (91) = happyShift action_2+action_167 (92) = happyShift action_54+action_167 (93) = happyShift action_55+action_167 (94) = happyShift action_7+action_167 (95) = happyShift action_18+action_167 (97) = happyShift action_56+action_167 (98) = happyShift action_57+action_167 (4) = happyGoto action_39+action_167 (5) = happyGoto action_40+action_167 (6) = happyGoto action_41+action_167 (7) = happyGoto action_12+action_167 (8) = happyGoto action_13+action_167 (10) = happyGoto action_42+action_167 (11) = happyGoto action_43+action_167 (20) = happyGoto action_142+action_167 (21) = happyGoto action_69+action_167 (22) = happyGoto action_70+action_167 (23) = happyGoto action_71+action_167 (24) = happyGoto action_72+action_167 (25) = happyGoto action_73+action_167 (26) = happyGoto action_74+action_167 (38) = happyGoto action_45+action_167 (40) = happyGoto action_46+action_167 (41) = happyGoto action_47+action_167 (58) = happyGoto action_183+action_167 _ = happyFail++action_168 (91) = happyShift action_2+action_168 (92) = happyShift action_54+action_168 (93) = happyShift action_55+action_168 (94) = happyShift action_7+action_168 (95) = happyShift action_18+action_168 (97) = happyShift action_56+action_168 (4) = happyGoto action_39+action_168 (5) = happyGoto action_40+action_168 (6) = happyGoto action_41+action_168 (7) = happyGoto action_12+action_168 (8) = happyGoto action_13+action_168 (10) = happyGoto action_42+action_168 (27) = happyGoto action_177+action_168 (28) = happyGoto action_178+action_168 (38) = happyGoto action_179+action_168 (40) = happyGoto action_180+action_168 (41) = happyGoto action_181+action_168 (56) = happyGoto action_182+action_168 _ = happyFail++action_169 (67) = happyShift action_176+action_169 _ = happyReduce_115++action_170 (90) = happyShift action_175+action_170 _ = happyFail++action_171 (60) = happyShift action_49+action_171 (70) = happyShift action_75+action_171 (71) = happyShift action_52+action_171 (88) = happyShift action_53+action_171 (91) = happyShift action_2+action_171 (92) = happyShift action_54+action_171 (93) = happyShift action_55+action_171 (94) = happyShift action_7+action_171 (95) = happyShift action_18+action_171 (97) = happyShift action_56+action_171 (98) = happyShift action_57+action_171 (4) = happyGoto action_39+action_171 (5) = happyGoto action_40+action_171 (6) = happyGoto action_41+action_171 (7) = happyGoto action_12+action_171 (8) = happyGoto action_13+action_171 (10) = happyGoto action_42+action_171 (11) = happyGoto action_43+action_171 (21) = happyGoto action_173+action_171 (22) = happyGoto action_70+action_171 (23) = happyGoto action_71+action_171 (24) = happyGoto action_72+action_171 (25) = happyGoto action_73+action_171 (26) = happyGoto action_74+action_171 (30) = happyGoto action_174+action_171 (38) = happyGoto action_45+action_171 (40) = happyGoto action_46+action_171 (41) = happyGoto action_47+action_171 _ = happyReduce_58++action_172 _ = happyReduce_41++action_173 _ = happyReduce_57++action_174 (63) = happyShift action_200+action_174 _ = happyFail++action_175 _ = happyReduce_33++action_176 (89) = happyShift action_171+action_176 (29) = happyGoto action_169+action_176 (57) = happyGoto action_199+action_176 _ = happyFail++action_177 (67) = happyShift action_198+action_177 _ = happyReduce_113++action_178 (63) = happyShift action_197+action_178 _ = happyFail++action_179 _ = happyReduce_54++action_180 _ = happyReduce_55++action_181 (95) = happyShift action_18+action_181 (8) = happyGoto action_13+action_181 (40) = happyGoto action_196+action_181 _ = happyReduce_78++action_182 (90) = happyShift action_195+action_182 _ = happyFail++action_183 _ = happyReduce_118++action_184 (60) = happyShift action_49+action_184 (70) = happyShift action_75+action_184 (71) = happyShift action_52+action_184 (76) = happyShift action_76+action_184 (77) = happyShift action_77+action_184 (78) = happyShift action_78+action_184 (83) = happyShift action_79+action_184 (88) = happyShift action_53+action_184 (91) = happyShift action_2+action_184 (92) = happyShift action_54+action_184 (93) = happyShift action_55+action_184 (94) = happyShift action_7+action_184 (95) = happyShift action_18+action_184 (97) = happyShift action_56+action_184 (98) = happyShift action_57+action_184 (4) = happyGoto action_39+action_184 (5) = happyGoto action_40+action_184 (6) = happyGoto action_41+action_184 (7) = happyGoto action_12+action_184 (8) = happyGoto action_13+action_184 (10) = happyGoto action_42+action_184 (11) = happyGoto action_43+action_184 (19) = happyGoto action_194+action_184 (20) = happyGoto action_68+action_184 (21) = happyGoto action_69+action_184 (22) = happyGoto action_70+action_184 (23) = happyGoto action_71+action_184 (24) = happyGoto action_72+action_184 (25) = happyGoto action_73+action_184 (26) = happyGoto action_74+action_184 (38) = happyGoto action_45+action_184 (40) = happyGoto action_46+action_184 (41) = happyGoto action_47+action_184 _ = happyFail++action_185 _ = happyReduce_69++action_186 (59) = happyShift action_88+action_186 (60) = happyShift action_89+action_186 (71) = happyShift action_90+action_186 (94) = happyShift action_7+action_186 (95) = happyShift action_18+action_186 (98) = happyShift action_57+action_186 (7) = happyGoto action_12+action_186 (8) = happyGoto action_80+action_186 (11) = happyGoto action_81+action_186 (31) = happyGoto action_193+action_186 (32) = happyGoto action_83+action_186 (33) = happyGoto action_84+action_186 (34) = happyGoto action_85+action_186 (41) = happyGoto action_86+action_186 (44) = happyGoto action_87+action_186 _ = happyFail++action_187 (95) = happyShift action_18+action_187 (8) = happyGoto action_62+action_187 (37) = happyGoto action_160+action_187 (43) = happyGoto action_161+action_187 (46) = happyGoto action_192+action_187 _ = happyReduce_89++action_188 (59) = happyShift action_88+action_188 (60) = happyShift action_89+action_188 (94) = happyShift action_7+action_188 (95) = happyShift action_18+action_188 (98) = happyShift action_57+action_188 (7) = happyGoto action_12+action_188 (8) = happyGoto action_80+action_188 (11) = happyGoto action_81+action_188 (34) = happyGoto action_191+action_188 (41) = happyGoto action_108+action_188 (44) = happyGoto action_87+action_188 _ = happyReduce_72++action_189 (94) = happyShift action_7+action_189 (7) = happyGoto action_12+action_189 (36) = happyGoto action_157+action_189 (41) = happyGoto action_158+action_189 (51) = happyGoto action_190+action_189 _ = happyFail++action_190 _ = happyReduce_103++action_191 _ = happyReduce_101++action_192 _ = happyReduce_91++action_193 _ = happyReduce_73++action_194 _ = happyReduce_30++action_195 _ = happyReduce_32++action_196 _ = happyReduce_53++action_197 (60) = happyShift action_49+action_197 (70) = happyShift action_75+action_197 (71) = happyShift action_52+action_197 (76) = happyShift action_76+action_197 (77) = happyShift action_77+action_197 (78) = happyShift action_78+action_197 (83) = happyShift action_79+action_197 (88) = happyShift action_53+action_197 (91) = happyShift action_2+action_197 (92) = happyShift action_54+action_197 (93) = happyShift action_55+action_197 (94) = happyShift action_7+action_197 (95) = happyShift action_18+action_197 (97) = happyShift action_56+action_197 (98) = happyShift action_57+action_197 (4) = happyGoto action_39+action_197 (5) = happyGoto action_40+action_197 (6) = happyGoto action_41+action_197 (7) = happyGoto action_12+action_197 (8) = happyGoto action_13+action_197 (10) = happyGoto action_42+action_197 (11) = happyGoto action_43+action_197 (19) = happyGoto action_203+action_197 (20) = happyGoto action_68+action_197 (21) = happyGoto action_69+action_197 (22) = happyGoto action_70+action_197 (23) = happyGoto action_71+action_197 (24) = happyGoto action_72+action_197 (25) = happyGoto action_73+action_197 (26) = happyGoto action_74+action_197 (38) = happyGoto action_45+action_197 (40) = happyGoto action_46+action_197 (41) = happyGoto action_47+action_197 _ = happyFail++action_198 (91) = happyShift action_2+action_198 (92) = happyShift action_54+action_198 (93) = happyShift action_55+action_198 (94) = happyShift action_7+action_198 (95) = happyShift action_18+action_198 (97) = happyShift action_56+action_198 (4) = happyGoto action_39+action_198 (5) = happyGoto action_40+action_198 (6) = happyGoto action_41+action_198 (7) = happyGoto action_12+action_198 (8) = happyGoto action_13+action_198 (10) = happyGoto action_42+action_198 (27) = happyGoto action_177+action_198 (28) = happyGoto action_178+action_198 (38) = happyGoto action_179+action_198 (40) = happyGoto action_180+action_198 (41) = happyGoto action_181+action_198 (56) = happyGoto action_202+action_198 _ = happyFail++action_199 _ = happyReduce_116++action_200 (60) = happyShift action_49+action_200 (70) = happyShift action_75+action_200 (71) = happyShift action_52+action_200 (76) = happyShift action_76+action_200 (77) = happyShift action_77+action_200 (78) = happyShift action_78+action_200 (83) = happyShift action_79+action_200 (88) = happyShift action_53+action_200 (91) = happyShift action_2+action_200 (92) = happyShift action_54+action_200 (93) = happyShift action_55+action_200 (94) = happyShift action_7+action_200 (95) = happyShift action_18+action_200 (97) = happyShift action_56+action_200 (98) = happyShift action_57+action_200 (4) = happyGoto action_39+action_200 (5) = happyGoto action_40+action_200 (6) = happyGoto action_41+action_200 (7) = happyGoto action_12+action_200 (8) = happyGoto action_13+action_200 (10) = happyGoto action_42+action_200 (11) = happyGoto action_43+action_200 (19) = happyGoto action_201+action_200 (20) = happyGoto action_68+action_200 (21) = happyGoto action_69+action_200 (22) = happyGoto action_70+action_200 (23) = happyGoto action_71+action_200 (24) = happyGoto action_72+action_200 (25) = happyGoto action_73+action_200 (26) = happyGoto action_74+action_200 (38) = happyGoto action_45+action_200 (40) = happyGoto action_46+action_200 (41) = happyGoto action_47+action_200 _ = happyFail++action_201 _ = happyReduce_56++action_202 _ = happyReduce_114++action_203 _ = happyReduce_52++happyReduce_1 = happySpecReduce_1 4 happyReduction_1+happyReduction_1 (HappyTerminal (PT _ (TL happy_var_1)))+ = HappyAbsSyn4+ (happy_var_1+ )+happyReduction_1 _ = notHappyAtAll ++happyReduce_2 = happySpecReduce_1 5 happyReduction_2+happyReduction_2 (HappyTerminal (PT _ (TC happy_var_1)))+ = HappyAbsSyn5+ ((read ( happy_var_1)) :: Char+ )+happyReduction_2 _ = notHappyAtAll ++happyReduce_3 = happySpecReduce_1 6 happyReduction_3+happyReduction_3 (HappyTerminal (PT _ (T_Frac happy_var_1)))+ = HappyAbsSyn6+ (Frac (happy_var_1)+ )+happyReduction_3 _ = notHappyAtAll ++happyReduce_4 = happySpecReduce_1 7 happyReduction_4+happyReduction_4 (HappyTerminal (PT _ (T_Uident happy_var_1)))+ = HappyAbsSyn7+ (Uident (happy_var_1)+ )+happyReduction_4 _ = notHappyAtAll ++happyReduce_5 = happySpecReduce_1 8 happyReduction_5+happyReduction_5 (HappyTerminal (PT _ (T_Lident happy_var_1)))+ = HappyAbsSyn8+ (Lident (happy_var_1)+ )+happyReduction_5 _ = notHappyAtAll ++happyReduce_6 = happySpecReduce_1 9 happyReduction_6+happyReduction_6 (HappyTerminal (PT _ (T_USym happy_var_1)))+ = HappyAbsSyn9+ (USym (happy_var_1)+ )+happyReduction_6 _ = notHappyAtAll ++happyReduce_7 = happySpecReduce_1 10 happyReduction_7+happyReduction_7 (HappyTerminal (PT _ (T_Number happy_var_1)))+ = HappyAbsSyn10+ (Number (happy_var_1)+ )+happyReduction_7 _ = notHappyAtAll ++happyReduce_8 = happySpecReduce_1 11 happyReduction_8+happyReduction_8 (HappyTerminal (PT _ (T_Count happy_var_1)))+ = HappyAbsSyn11+ (Count (happy_var_1)+ )+happyReduction_8 _ = notHappyAtAll ++happyReduce_9 = happyReduce 8 12 happyReduction_9+happyReduction_9 (_ `HappyStk`+ (HappyAbsSyn55 happy_var_7) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn13 happy_var_4) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn42 happy_var_2) `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn12+ (Module happy_var_2 happy_var_4 happy_var_7+ ) `HappyStk` happyRest++happyReduce_10 = happySpecReduce_1 13 happyReduction_10+happyReduction_10 _+ = HappyAbsSyn13+ (ExpAllD+ )++happyReduce_11 = happySpecReduce_3 13 happyReduction_11+happyReduction_11 _+ (HappyAbsSyn49 happy_var_2)+ _+ = HappyAbsSyn13+ (ExpListD happy_var_2+ )+happyReduction_11 _ _ _ = notHappyAtAll ++happyReduce_12 = happySpecReduce_2 14 happyReduction_12+happyReduction_12 (HappyAbsSyn15 happy_var_2)+ (HappyAbsSyn41 happy_var_1)+ = HappyAbsSyn14+ (TypeEx happy_var_1 happy_var_2+ )+happyReduction_12 _ _ = notHappyAtAll ++happyReduce_13 = happySpecReduce_1 14 happyReduction_13+happyReduction_13 (HappyAbsSyn40 happy_var_1)+ = HappyAbsSyn14+ (VarEx happy_var_1+ )+happyReduction_13 _ = notHappyAtAll ++happyReduce_14 = happySpecReduce_0 15 happyReduction_14+happyReduction_14 = HappyAbsSyn15+ (Neither+ )++happyReduce_15 = happySpecReduce_3 15 happyReduction_15+happyReduction_15 _+ _+ _+ = HappyAbsSyn15+ (Decon+ )++happyReduce_16 = happySpecReduce_3 15 happyReduction_16+happyReduction_16 _+ _+ _+ = HappyAbsSyn15+ (Both+ )++happyReduce_17 = happySpecReduce_3 16 happyReduction_17+happyReduction_17 (HappyAbsSyn17 happy_var_3)+ (HappyAbsSyn42 happy_var_2)+ _+ = HappyAbsSyn16+ (ImportD happy_var_2 happy_var_3+ )+happyReduction_17 _ _ _ = notHappyAtAll ++happyReduce_18 = happyReduce 5 16 happyReduction_18+happyReduction_18 ((HappyAbsSyn31 happy_var_5) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn40 happy_var_3) `HappyStk`+ (HappyAbsSyn18 happy_var_2) `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn16+ (ExternD happy_var_2 happy_var_3 happy_var_5+ ) `HappyStk` happyRest++happyReduce_19 = happyReduce 5 16 happyReduction_19+happyReduction_19 ((HappyAbsSyn35 happy_var_5) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn47 happy_var_3) `HappyStk`+ (HappyAbsSyn41 happy_var_2) `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn16+ (TypeD happy_var_2 (reverse happy_var_3) happy_var_5+ ) `HappyStk` happyRest++happyReduce_20 = happySpecReduce_3 16 happyReduction_20+happyReduction_20 (HappyAbsSyn31 happy_var_3)+ _+ (HappyAbsSyn40 happy_var_1)+ = HappyAbsSyn16+ (AscribeD happy_var_1 happy_var_3+ )+happyReduction_20 _ _ _ = notHappyAtAll ++happyReduce_21 = happySpecReduce_3 16 happyReduction_21+happyReduction_21 (HappyAbsSyn19 happy_var_3)+ _+ (HappyAbsSyn40 happy_var_1)+ = HappyAbsSyn16+ (VarD happy_var_1 happy_var_3+ )+happyReduction_21 _ _ _ = notHappyAtAll ++happyReduce_22 = happyReduce 4 16 happyReduction_22+happyReduction_22 ((HappyAbsSyn19 happy_var_4) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn45 happy_var_2) `HappyStk`+ (HappyAbsSyn40 happy_var_1) `HappyStk`+ happyRest)+ = HappyAbsSyn16+ (ProcD happy_var_1 happy_var_2 happy_var_4+ ) `HappyStk` happyRest++happyReduce_23 = happySpecReduce_2 17 happyReduction_23+happyReduction_23 (HappyAbsSyn41 happy_var_2)+ _+ = HappyAbsSyn17+ (AsAS happy_var_2+ )+happyReduction_23 _ _ = notHappyAtAll ++happyReduce_24 = happySpecReduce_0 17 happyReduction_24+happyReduction_24 = HappyAbsSyn17+ (EmptyAS+ )++happyReduce_25 = happySpecReduce_1 18 happyReduction_25+happyReduction_25 (HappyAbsSyn4 happy_var_1)+ = HappyAbsSyn18+ (SomeNm happy_var_1+ )+happyReduction_25 _ = notHappyAtAll ++happyReduce_26 = happySpecReduce_0 18 happyReduction_26+happyReduction_26 = HappyAbsSyn18+ (NoneNm+ )++happyReduce_27 = happyReduce 4 19 happyReduction_27+happyReduction_27 (_ `HappyStk`+ (HappyAbsSyn45 happy_var_3) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn19+ (BlockE happy_var_3+ ) `HappyStk` happyRest++happyReduce_28 = happySpecReduce_1 19 happyReduction_28+happyReduction_28 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (happy_var_1+ )+happyReduction_28 _ = notHappyAtAll ++happyReduce_29 = happySpecReduce_3 20 happyReduction_29+happyReduction_29 (HappyAbsSyn19 happy_var_3)+ _+ (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (LetS happy_var_1 happy_var_3+ )+happyReduction_29 _ _ _ = notHappyAtAll ++happyReduce_30 = happyReduce 6 20 happyReduction_30+happyReduction_30 ((HappyAbsSyn19 happy_var_6) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn19 happy_var_4) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn19 happy_var_2) `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn19+ (LetE happy_var_2 happy_var_4 happy_var_6+ ) `HappyStk` happyRest++happyReduce_31 = happySpecReduce_3 20 happyReduction_31+happyReduction_31 (HappyAbsSyn19 happy_var_3)+ _+ (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (StoreE happy_var_1 happy_var_3+ )+happyReduction_31 _ _ _ = notHappyAtAll ++happyReduce_32 = happyReduce 6 20 happyReduction_32+happyReduction_32 (_ `HappyStk`+ (HappyAbsSyn56 happy_var_5) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn19 happy_var_2) `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn19+ (CaseE happy_var_2 happy_var_5+ ) `HappyStk` happyRest++happyReduce_33 = happyReduce 5 20 happyReduction_33+happyReduction_33 (_ `HappyStk`+ (HappyAbsSyn57 happy_var_4) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn19+ (BranchE happy_var_4+ ) `HappyStk` happyRest++happyReduce_34 = happySpecReduce_1 20 happyReduction_34+happyReduction_34 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (happy_var_1+ )+happyReduction_34 _ = notHappyAtAll ++happyReduce_35 = happySpecReduce_3 21 happyReduction_35+happyReduction_35 (HappyAbsSyn19 happy_var_3)+ (HappyAbsSyn9 happy_var_2)+ (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (BinOpE happy_var_1 happy_var_2 happy_var_3+ )+happyReduction_35 _ _ _ = notHappyAtAll ++happyReduce_36 = happySpecReduce_1 21 happyReduction_36+happyReduction_36 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (happy_var_1+ )+happyReduction_36 _ = notHappyAtAll ++happyReduce_37 = happySpecReduce_2 22 happyReduction_37+happyReduction_37 (HappyAbsSyn19 happy_var_2)+ (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (AppE happy_var_1 happy_var_2+ )+happyReduction_37 _ _ = notHappyAtAll ++happyReduce_38 = happySpecReduce_1 22 happyReduction_38+happyReduction_38 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (happy_var_1+ )+happyReduction_38 _ = notHappyAtAll ++happyReduce_39 = happySpecReduce_2 23 happyReduction_39+happyReduction_39 (HappyAbsSyn19 happy_var_2)+ (HappyAbsSyn26 happy_var_1)+ = HappyAbsSyn19+ (UnOpE happy_var_1 happy_var_2+ )+happyReduction_39 _ _ = notHappyAtAll ++happyReduce_40 = happySpecReduce_1 23 happyReduction_40+happyReduction_40 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (happy_var_1+ )+happyReduction_40 _ = notHappyAtAll ++happyReduce_41 = happyReduce 4 24 happyReduction_41+happyReduction_41 (_ `HappyStk`+ (HappyAbsSyn19 happy_var_3) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn19 happy_var_1) `HappyStk`+ happyRest)+ = HappyAbsSyn19+ (IdxE happy_var_1 happy_var_3+ ) `HappyStk` happyRest++happyReduce_42 = happySpecReduce_3 24 happyReduction_42+happyReduction_42 (HappyAbsSyn43 happy_var_3)+ _+ (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (FldE happy_var_1 happy_var_3+ )+happyReduction_42 _ _ _ = notHappyAtAll ++happyReduce_43 = happySpecReduce_1 24 happyReduction_43+happyReduction_43 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn19+ (happy_var_1+ )+happyReduction_43 _ = notHappyAtAll ++happyReduce_44 = happyReduce 4 25 happyReduction_44+happyReduction_44 (_ `HappyStk`+ (HappyAbsSyn45 happy_var_3) `HappyStk`+ _ `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn19+ (ArrayE happy_var_3+ ) `HappyStk` happyRest++happyReduce_45 = happySpecReduce_3 25 happyReduction_45+happyReduction_45 _+ (HappyAbsSyn53 happy_var_2)+ _+ = HappyAbsSyn19+ (RecordE happy_var_2+ )+happyReduction_45 _ _ _ = notHappyAtAll ++happyReduce_46 = happySpecReduce_3 25 happyReduction_46+happyReduction_46 _+ (HappyAbsSyn45 happy_var_2)+ _+ = HappyAbsSyn19+ (TupleE happy_var_2+ )+happyReduction_46 _ _ _ = notHappyAtAll ++happyReduce_47 = happyReduce 5 25 happyReduction_47+happyReduction_47 (_ `HappyStk`+ (HappyAbsSyn31 happy_var_4) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn19 happy_var_2) `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn19+ (AscribeE happy_var_2 happy_var_4+ ) `HappyStk` happyRest++happyReduce_48 = happySpecReduce_1 25 happyReduction_48+happyReduction_48 (HappyAbsSyn11 happy_var_1)+ = HappyAbsSyn19+ (CountE happy_var_1+ )+happyReduction_48 _ = notHappyAtAll ++happyReduce_49 = happySpecReduce_1 25 happyReduction_49+happyReduction_49 (HappyAbsSyn40 happy_var_1)+ = HappyAbsSyn19+ (VarE happy_var_1+ )+happyReduction_49 _ = notHappyAtAll ++happyReduce_50 = happySpecReduce_1 25 happyReduction_50+happyReduction_50 (HappyAbsSyn38 happy_var_1)+ = HappyAbsSyn19+ (LitE happy_var_1+ )+happyReduction_50 _ = notHappyAtAll ++happyReduce_51 = happySpecReduce_1 26 happyReduction_51+happyReduction_51 _+ = HappyAbsSyn26+ (Load+ )++happyReduce_52 = happySpecReduce_3 27 happyReduction_52+happyReduction_52 (HappyAbsSyn19 happy_var_3)+ _+ (HappyAbsSyn28 happy_var_1)+ = HappyAbsSyn27+ (CaseAlt happy_var_1 happy_var_3+ )+happyReduction_52 _ _ _ = notHappyAtAll ++happyReduce_53 = happySpecReduce_2 28 happyReduction_53+happyReduction_53 (HappyAbsSyn40 happy_var_2)+ (HappyAbsSyn41 happy_var_1)+ = HappyAbsSyn28+ (ConP happy_var_1 happy_var_2+ )+happyReduction_53 _ _ = notHappyAtAll ++happyReduce_54 = happySpecReduce_1 28 happyReduction_54+happyReduction_54 (HappyAbsSyn38 happy_var_1)+ = HappyAbsSyn28+ (LitP happy_var_1+ )+happyReduction_54 _ = notHappyAtAll ++happyReduce_55 = happySpecReduce_1 28 happyReduction_55+happyReduction_55 (HappyAbsSyn40 happy_var_1)+ = HappyAbsSyn28+ (VarP happy_var_1+ )+happyReduction_55 _ = notHappyAtAll ++happyReduce_56 = happyReduce 4 29 happyReduction_56+happyReduction_56 ((HappyAbsSyn19 happy_var_4) `HappyStk`+ _ `HappyStk`+ (HappyAbsSyn30 happy_var_2) `HappyStk`+ _ `HappyStk`+ happyRest)+ = HappyAbsSyn29+ (BranchAlt happy_var_2 happy_var_4+ ) `HappyStk` happyRest++happyReduce_57 = happySpecReduce_1 30 happyReduction_57+happyReduction_57 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn30+ (BoolBP happy_var_1+ )+happyReduction_57 _ = notHappyAtAll ++happyReduce_58 = happySpecReduce_0 30 happyReduction_58+happyReduction_58 = HappyAbsSyn30+ (DefaultBP+ )++happyReduce_59 = happySpecReduce_3 31 happyReduction_59+happyReduction_59 (HappyAbsSyn31 happy_var_3)+ _+ (HappyAbsSyn31 happy_var_1)+ = HappyAbsSyn31+ (TyFun happy_var_1 happy_var_3+ )+happyReduction_59 _ _ _ = notHappyAtAll ++happyReduce_60 = happySpecReduce_1 31 happyReduction_60+happyReduction_60 (HappyAbsSyn31 happy_var_1)+ = HappyAbsSyn31+ (happy_var_1+ )+happyReduction_60 _ = notHappyAtAll ++happyReduce_61 = happySpecReduce_3 32 happyReduction_61+happyReduction_61 (HappyAbsSyn31 happy_var_3)+ (HappyAbsSyn31 happy_var_2)+ _+ = HappyAbsSyn31+ (TyArray happy_var_2 happy_var_3+ )+happyReduction_61 _ _ _ = notHappyAtAll ++happyReduce_62 = happySpecReduce_2 32 happyReduction_62+happyReduction_62 (HappyAbsSyn48 happy_var_2)+ (HappyAbsSyn41 happy_var_1)+ = HappyAbsSyn31+ (TyConstr happy_var_1 happy_var_2+ )+happyReduction_62 _ _ = notHappyAtAll ++happyReduce_63 = happySpecReduce_1 32 happyReduction_63+happyReduction_63 (HappyAbsSyn31 happy_var_1)+ = HappyAbsSyn31+ (happy_var_1+ )+happyReduction_63 _ = notHappyAtAll ++happyReduce_64 = happySpecReduce_1 33 happyReduction_64+happyReduction_64 (HappyAbsSyn31 happy_var_1)+ = HappyAbsSyn31+ (happy_var_1+ )+happyReduction_64 _ = notHappyAtAll ++happyReduce_65 = happySpecReduce_3 34 happyReduction_65+happyReduction_65 _+ (HappyAbsSyn48 happy_var_2)+ _+ = HappyAbsSyn31+ (TyTuple happy_var_2+ )+happyReduction_65 _ _ _ = notHappyAtAll ++happyReduce_66 = happySpecReduce_1 34 happyReduction_66+happyReduction_66 (HappyAbsSyn11 happy_var_1)+ = HappyAbsSyn31+ (TyCount happy_var_1+ )+happyReduction_66 _ = notHappyAtAll ++happyReduce_67 = happySpecReduce_1 34 happyReduction_67+happyReduction_67 (HappyAbsSyn44 happy_var_1)+ = HappyAbsSyn31+ (TyVarT happy_var_1+ )+happyReduction_67 _ = notHappyAtAll ++happyReduce_68 = happySpecReduce_1 34 happyReduction_68+happyReduction_68 (HappyAbsSyn41 happy_var_1)+ = HappyAbsSyn31+ (TyConstr0 happy_var_1+ )+happyReduction_68 _ = notHappyAtAll ++happyReduce_69 = happySpecReduce_3 35 happyReduction_69+happyReduction_69 _+ (HappyAbsSyn46 happy_var_2)+ _+ = HappyAbsSyn35+ (TyRecord happy_var_2+ )+happyReduction_69 _ _ _ = notHappyAtAll ++happyReduce_70 = happySpecReduce_2 35 happyReduction_70+happyReduction_70 (HappyAbsSyn51 happy_var_2)+ _+ = HappyAbsSyn35+ (TyTagged happy_var_2+ )+happyReduction_70 _ _ = notHappyAtAll ++happyReduce_71 = happySpecReduce_1 35 happyReduction_71+happyReduction_71 (HappyAbsSyn31 happy_var_1)+ = HappyAbsSyn35+ (TySyn happy_var_1+ )+happyReduction_71 _ = notHappyAtAll ++happyReduce_72 = happySpecReduce_2 36 happyReduction_72+happyReduction_72 (HappyAbsSyn48 happy_var_2)+ (HappyAbsSyn41 happy_var_1)+ = HappyAbsSyn36+ (ConC happy_var_1 (reverse happy_var_2)+ )+happyReduction_72 _ _ = notHappyAtAll ++happyReduce_73 = happySpecReduce_3 37 happyReduction_73+happyReduction_73 (HappyAbsSyn31 happy_var_3)+ _+ (HappyAbsSyn43 happy_var_1)+ = HappyAbsSyn37+ (FieldT happy_var_1 happy_var_3+ )+happyReduction_73 _ _ _ = notHappyAtAll ++happyReduce_74 = happySpecReduce_1 38 happyReduction_74+happyReduction_74 (HappyAbsSyn5 happy_var_1)+ = HappyAbsSyn38+ (CharL happy_var_1+ )+happyReduction_74 _ = notHappyAtAll ++happyReduce_75 = happySpecReduce_1 38 happyReduction_75+happyReduction_75 (HappyAbsSyn4 happy_var_1)+ = HappyAbsSyn38+ (StringL happy_var_1+ )+happyReduction_75 _ = notHappyAtAll ++happyReduce_76 = happySpecReduce_1 38 happyReduction_76+happyReduction_76 (HappyAbsSyn10 happy_var_1)+ = HappyAbsSyn38+ (IntL happy_var_1+ )+happyReduction_76 _ = notHappyAtAll ++happyReduce_77 = happySpecReduce_1 38 happyReduction_77+happyReduction_77 (HappyAbsSyn6 happy_var_1)+ = HappyAbsSyn38+ (FracL happy_var_1+ )+happyReduction_77 _ = notHappyAtAll ++happyReduce_78 = happySpecReduce_1 38 happyReduction_78+happyReduction_78 (HappyAbsSyn41 happy_var_1)+ = HappyAbsSyn38+ (EnumL happy_var_1+ )+happyReduction_78 _ = notHappyAtAll ++happyReduce_79 = happySpecReduce_3 39 happyReduction_79+happyReduction_79 (HappyAbsSyn19 happy_var_3)+ _+ (HappyAbsSyn43 happy_var_1)+ = HappyAbsSyn39+ (FieldD happy_var_1 happy_var_3+ )+happyReduction_79 _ _ _ = notHappyAtAll ++happyReduce_80 = happySpecReduce_1 40 happyReduction_80+happyReduction_80 (HappyAbsSyn8 happy_var_1)+ = HappyAbsSyn40+ (Var happy_var_1+ )+happyReduction_80 _ = notHappyAtAll ++happyReduce_81 = happySpecReduce_1 41 happyReduction_81+happyReduction_81 (HappyAbsSyn7 happy_var_1)+ = HappyAbsSyn41+ (Con happy_var_1+ )+happyReduction_81 _ = notHappyAtAll ++happyReduce_82 = happySpecReduce_1 42 happyReduction_82+happyReduction_82 (HappyAbsSyn7 happy_var_1)+ = HappyAbsSyn42+ (Modid happy_var_1+ )+happyReduction_82 _ = notHappyAtAll ++happyReduce_83 = happySpecReduce_1 43 happyReduction_83+happyReduction_83 (HappyAbsSyn8 happy_var_1)+ = HappyAbsSyn43+ (Field happy_var_1+ )+happyReduction_83 _ = notHappyAtAll ++happyReduce_84 = happySpecReduce_1 44 happyReduction_84+happyReduction_84 (HappyAbsSyn8 happy_var_1)+ = HappyAbsSyn44+ (VarTV happy_var_1+ )+happyReduction_84 _ = notHappyAtAll ++happyReduce_85 = happySpecReduce_2 44 happyReduction_85+happyReduction_85 (HappyAbsSyn8 happy_var_2)+ _+ = HappyAbsSyn44+ (CntTV happy_var_2+ )+happyReduction_85 _ _ = notHappyAtAll ++happyReduce_86 = happySpecReduce_0 45 happyReduction_86+happyReduction_86 = HappyAbsSyn45+ ([]+ )++happyReduce_87 = happySpecReduce_1 45 happyReduction_87+happyReduction_87 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn45+ ((:[]) happy_var_1+ )+happyReduction_87 _ = notHappyAtAll ++happyReduce_88 = happySpecReduce_3 45 happyReduction_88+happyReduction_88 (HappyAbsSyn45 happy_var_3)+ _+ (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn45+ ((:) happy_var_1 happy_var_3+ )+happyReduction_88 _ _ _ = notHappyAtAll ++happyReduce_89 = happySpecReduce_0 46 happyReduction_89+happyReduction_89 = HappyAbsSyn46+ ([]+ )++happyReduce_90 = happySpecReduce_1 46 happyReduction_90+happyReduction_90 (HappyAbsSyn37 happy_var_1)+ = HappyAbsSyn46+ ((:[]) happy_var_1+ )+happyReduction_90 _ = notHappyAtAll ++happyReduce_91 = happySpecReduce_3 46 happyReduction_91+happyReduction_91 (HappyAbsSyn46 happy_var_3)+ _+ (HappyAbsSyn37 happy_var_1)+ = HappyAbsSyn46+ ((:) happy_var_1 happy_var_3+ )+happyReduction_91 _ _ _ = notHappyAtAll ++happyReduce_92 = happySpecReduce_0 47 happyReduction_92+happyReduction_92 = HappyAbsSyn47+ ([]+ )++happyReduce_93 = happySpecReduce_2 47 happyReduction_93+happyReduction_93 (HappyAbsSyn44 happy_var_2)+ (HappyAbsSyn47 happy_var_1)+ = HappyAbsSyn47+ (flip (:) happy_var_1 happy_var_2+ )+happyReduction_93 _ _ = notHappyAtAll ++happyReduce_94 = happySpecReduce_0 48 happyReduction_94+happyReduction_94 = HappyAbsSyn48+ ([]+ )++happyReduce_95 = happySpecReduce_1 48 happyReduction_95+happyReduction_95 (HappyAbsSyn31 happy_var_1)+ = HappyAbsSyn48+ ((:[]) happy_var_1+ )+happyReduction_95 _ = notHappyAtAll ++happyReduce_96 = happySpecReduce_3 48 happyReduction_96+happyReduction_96 (HappyAbsSyn48 happy_var_3)+ _+ (HappyAbsSyn31 happy_var_1)+ = HappyAbsSyn48+ ((:) happy_var_1 happy_var_3+ )+happyReduction_96 _ _ _ = notHappyAtAll ++happyReduce_97 = happySpecReduce_0 49 happyReduction_97+happyReduction_97 = HappyAbsSyn49+ ([]+ )++happyReduce_98 = happySpecReduce_1 49 happyReduction_98+happyReduction_98 (HappyAbsSyn14 happy_var_1)+ = HappyAbsSyn49+ ((:[]) happy_var_1+ )+happyReduction_98 _ = notHappyAtAll ++happyReduce_99 = happySpecReduce_3 49 happyReduction_99+happyReduction_99 (HappyAbsSyn49 happy_var_3)+ _+ (HappyAbsSyn14 happy_var_1)+ = HappyAbsSyn49+ ((:) happy_var_1 happy_var_3+ )+happyReduction_99 _ _ _ = notHappyAtAll ++happyReduce_100 = happySpecReduce_0 50 happyReduction_100+happyReduction_100 = HappyAbsSyn48+ ([]+ )++happyReduce_101 = happySpecReduce_2 50 happyReduction_101+happyReduction_101 (HappyAbsSyn31 happy_var_2)+ (HappyAbsSyn48 happy_var_1)+ = HappyAbsSyn48+ (flip (:) happy_var_1 happy_var_2+ )+happyReduction_101 _ _ = notHappyAtAll ++happyReduce_102 = happySpecReduce_1 51 happyReduction_102+happyReduction_102 (HappyAbsSyn36 happy_var_1)+ = HappyAbsSyn51+ ((:[]) happy_var_1+ )+happyReduction_102 _ = notHappyAtAll ++happyReduce_103 = happySpecReduce_3 51 happyReduction_103+happyReduction_103 (HappyAbsSyn51 happy_var_3)+ _+ (HappyAbsSyn36 happy_var_1)+ = HappyAbsSyn51+ ((:) happy_var_1 happy_var_3+ )+happyReduction_103 _ _ _ = notHappyAtAll ++happyReduce_104 = happySpecReduce_1 52 happyReduction_104+happyReduction_104 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn45+ ((:[]) happy_var_1+ )+happyReduction_104 _ = notHappyAtAll ++happyReduce_105 = happySpecReduce_2 52 happyReduction_105+happyReduction_105 (HappyAbsSyn45 happy_var_2)+ (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn45+ ((:) happy_var_1 happy_var_2+ )+happyReduction_105 _ _ = notHappyAtAll ++happyReduce_106 = happySpecReduce_1 53 happyReduction_106+happyReduction_106 (HappyAbsSyn39 happy_var_1)+ = HappyAbsSyn53+ ((:[]) happy_var_1+ )+happyReduction_106 _ = notHappyAtAll ++happyReduce_107 = happySpecReduce_3 53 happyReduction_107+happyReduction_107 (HappyAbsSyn53 happy_var_3)+ _+ (HappyAbsSyn39 happy_var_1)+ = HappyAbsSyn53+ ((:) happy_var_1 happy_var_3+ )+happyReduction_107 _ _ _ = notHappyAtAll ++happyReduce_108 = happySpecReduce_1 54 happyReduction_108+happyReduction_108 (HappyAbsSyn31 happy_var_1)+ = HappyAbsSyn48+ ((:[]) happy_var_1+ )+happyReduction_108 _ = notHappyAtAll ++happyReduce_109 = happySpecReduce_2 54 happyReduction_109+happyReduction_109 (HappyAbsSyn48 happy_var_2)+ (HappyAbsSyn31 happy_var_1)+ = HappyAbsSyn48+ ((:) happy_var_1 happy_var_2+ )+happyReduction_109 _ _ = notHappyAtAll ++happyReduce_110 = happySpecReduce_0 55 happyReduction_110+happyReduction_110 = HappyAbsSyn55+ ([]+ )++happyReduce_111 = happySpecReduce_1 55 happyReduction_111+happyReduction_111 (HappyAbsSyn16 happy_var_1)+ = HappyAbsSyn55+ ((:[]) happy_var_1+ )+happyReduction_111 _ = notHappyAtAll ++happyReduce_112 = happySpecReduce_3 55 happyReduction_112+happyReduction_112 (HappyAbsSyn55 happy_var_3)+ _+ (HappyAbsSyn16 happy_var_1)+ = HappyAbsSyn55+ ((:) happy_var_1 happy_var_3+ )+happyReduction_112 _ _ _ = notHappyAtAll ++happyReduce_113 = happySpecReduce_1 56 happyReduction_113+happyReduction_113 (HappyAbsSyn27 happy_var_1)+ = HappyAbsSyn56+ ((:[]) happy_var_1+ )+happyReduction_113 _ = notHappyAtAll ++happyReduce_114 = happySpecReduce_3 56 happyReduction_114+happyReduction_114 (HappyAbsSyn56 happy_var_3)+ _+ (HappyAbsSyn27 happy_var_1)+ = HappyAbsSyn56+ ((:) happy_var_1 happy_var_3+ )+happyReduction_114 _ _ _ = notHappyAtAll ++happyReduce_115 = happySpecReduce_1 57 happyReduction_115+happyReduction_115 (HappyAbsSyn29 happy_var_1)+ = HappyAbsSyn57+ ((:[]) happy_var_1+ )+happyReduction_115 _ = notHappyAtAll ++happyReduce_116 = happySpecReduce_3 57 happyReduction_116+happyReduction_116 (HappyAbsSyn57 happy_var_3)+ _+ (HappyAbsSyn29 happy_var_1)+ = HappyAbsSyn57+ ((:) happy_var_1 happy_var_3+ )+happyReduction_116 _ _ _ = notHappyAtAll ++happyReduce_117 = happySpecReduce_1 58 happyReduction_117+happyReduction_117 (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn45+ ((:[]) happy_var_1+ )+happyReduction_117 _ = notHappyAtAll ++happyReduce_118 = happySpecReduce_3 58 happyReduction_118+happyReduction_118 (HappyAbsSyn45 happy_var_3)+ _+ (HappyAbsSyn19 happy_var_1)+ = HappyAbsSyn45+ ((:) happy_var_1 happy_var_3+ )+happyReduction_118 _ _ _ = notHappyAtAll ++happyNewToken action sts stk [] =+ action 100 100 notHappyAtAll (HappyState action) sts stk []++happyNewToken action sts stk (tk:tks) =+ let cont i = action i i tk (HappyState action) sts stk tks in+ case tk of {+ PT _ (TS _ 1) -> cont 59;+ PT _ (TS _ 2) -> cont 60;+ PT _ (TS _ 3) -> cont 61;+ PT _ (TS _ 4) -> cont 62;+ PT _ (TS _ 5) -> cont 63;+ PT _ (TS _ 6) -> cont 64;+ PT _ (TS _ 7) -> cont 65;+ PT _ (TS _ 8) -> cont 66;+ PT _ (TS _ 9) -> cont 67;+ PT _ (TS _ 10) -> cont 68;+ PT _ (TS _ 11) -> cont 69;+ PT _ (TS _ 12) -> cont 70;+ PT _ (TS _ 13) -> cont 71;+ PT _ (TS _ 14) -> cont 72;+ PT _ (TS _ 15) -> cont 73;+ PT _ (TS _ 16) -> cont 74;+ PT _ (TS _ 17) -> cont 75;+ PT _ (TS _ 18) -> cont 76;+ PT _ (TS _ 19) -> cont 77;+ PT _ (TS _ 20) -> cont 78;+ PT _ (TS _ 21) -> cont 79;+ PT _ (TS _ 22) -> cont 80;+ PT _ (TS _ 23) -> cont 81;+ PT _ (TS _ 24) -> cont 82;+ PT _ (TS _ 25) -> cont 83;+ PT _ (TS _ 26) -> cont 84;+ PT _ (TS _ 27) -> cont 85;+ PT _ (TS _ 28) -> cont 86;+ PT _ (TS _ 29) -> cont 87;+ PT _ (TS _ 30) -> cont 88;+ PT _ (TS _ 31) -> cont 89;+ PT _ (TS _ 32) -> cont 90;+ PT _ (TL happy_dollar_dollar) -> cont 91;+ PT _ (TC happy_dollar_dollar) -> cont 92;+ PT _ (T_Frac happy_dollar_dollar) -> cont 93;+ PT _ (T_Uident happy_dollar_dollar) -> cont 94;+ PT _ (T_Lident happy_dollar_dollar) -> cont 95;+ PT _ (T_USym happy_dollar_dollar) -> cont 96;+ PT _ (T_Number happy_dollar_dollar) -> cont 97;+ PT _ (T_Count happy_dollar_dollar) -> cont 98;+ _ -> cont 99;+ _ -> happyError' (tk:tks)+ }++happyError_ tk tks = happyError' (tk:tks)++happyThen :: () => Err a -> (a -> Err b) -> Err b+happyThen = (thenM)+happyReturn :: () => a -> Err a+happyReturn = (returnM)+happyThen1 m k tks = (thenM) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> Err a+happyReturn1 = \a tks -> (returnM) a+happyError' :: () => [(Token)] -> Err a+happyError' = happyError++pModule tks = happySomeParser where+ happySomeParser = happyThen (happyParse action_0 tks) (\x -> case x of {HappyAbsSyn12 z -> happyReturn z; _other -> notHappyAtAll })++happySeq = happyDontSeq+++returnM :: a -> Err a+returnM = return++thenM :: Err a -> (a -> Err b) -> Err b+thenM = (>>=)++happyError :: [Token] -> Err a+happyError ts =+ Bad $ "syntax error at " ++ tokenPos ts ++ + case ts of+ [] -> []+ [Err _] -> " due to lexer error"+ _ -> " before " ++ unwords (map (id . prToken) (take 4 ts))++myLexer = tokens+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp ++{-# LINE 30 "templates/GenericTemplate.hs" #-}+++++++++{-# LINE 51 "templates/GenericTemplate.hs" #-}++{-# LINE 61 "templates/GenericTemplate.hs" #-}++{-# LINE 70 "templates/GenericTemplate.hs" #-}++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is (1), it means we've just accepted a partial+-- parse (a %partial parser). We must ignore the saved token on the top of+-- the stack in this case.+happyAccept (1) tk st sts (_ `HappyStk` ans `HappyStk` _) =+ happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = + (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++{-# LINE 148 "templates/GenericTemplate.hs" #-}++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++++newtype HappyState b c = HappyState+ (Int -> -- token number+ Int -> -- token number (yes, again)+ b -> -- token semantic value+ HappyState b c -> -- current state+ [HappyState b c] -> -- state stack+ c)++++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state (1) tk st sts stk@(x `HappyStk` _) =+ let (i) = (case x of { HappyErrorToken (i) -> i }) in+-- trace "shifting the error token" $+ new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)++happyShift new_state i tk st sts stk =+ happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn (1) tk st sts stk+ = happyFail (1) tk st sts stk+happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk+ = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn (1) tk st sts stk+ = happyFail (1) tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')+ = let r = fn v1 in+ happySeq r (action nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn (1) tk st sts stk+ = happyFail (1) tk st sts stk+happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')+ = let r = fn v1 v2 in+ happySeq r (action nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn (1) tk st sts stk+ = happyFail (1) tk st sts stk+happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+ = let r = fn v1 v2 v3 in+ happySeq r (action nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn (1) tk st sts stk+ = happyFail (1) tk st sts stk+happyReduce k nt fn j tk st sts stk+ = case happyDrop (k - ((1) :: Int)) sts of+ sts1@(((st1@(HappyState (action))):(_))) ->+ let r = fn stk in -- it doesn't hurt to always seq here...+ happyDoSeq r (action nt j tk st1 sts1 r)++happyMonadReduce k nt fn (1) tk st sts stk+ = happyFail (1) tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+ happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))+ where (sts1@(((st1@(HappyState (action))):(_)))) = happyDrop k ((st):(sts))+ drop_stk = happyDropStk k stk++happyMonad2Reduce k nt fn (1) tk st sts stk+ = happyFail (1) tk st sts stk+happyMonad2Reduce k nt fn j tk st sts stk =+ happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))+ where (sts1@(((st1@(HappyState (action))):(_)))) = happyDrop k ((st):(sts))+ drop_stk = happyDropStk k stk++++++ new_state = action+++happyDrop (0) l = l+happyDrop n ((_):(t)) = happyDrop (n - ((1) :: Int)) t++happyDropStk (0) l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction++{-# LINE 246 "templates/GenericTemplate.hs" #-}+happyGoto action j tk st = action j j tk (HappyState action)+++-----------------------------------------------------------------------------+-- Error recovery ((1) is the error token)++-- parse error if we are in recovery and we fail again+happyFail (1) tk old_st _ stk =+-- trace "failing" $ + happyError_ tk++{- We don't need state discarding for our restricted implementation of+ "error". In fact, it can cause some bogus parses, so I've disabled it+ for now --SDM++-- discard a state+happyFail (1) tk old_st (((HappyState (action))):(sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) =+-- trace ("discarding state, depth " ++ show (length stk)) $+ action (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+-- save the old token and carry on.+happyFail i tk (HappyState (action)) sts stk =+-- trace "entering error recovery" $+ action (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll :: a+notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions++++++++-----------------------------------------------------------------------------+-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq+-- otherwise it emits+-- happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template. GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.++{-# LINE 311 "templates/GenericTemplate.hs" #-}+{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.
+ Language/Pec/Print.hs view
@@ -0,0 +1,314 @@+{-# OPTIONS -fno-warn-incomplete-patterns #-}+module Language.Pec.Print where++-- pretty-printer generated by the BNF converter++import Language.Pec.Abs+import Data.Char+++-- the top-level printing method+printTree :: Print a => a -> String+printTree = render . prt 0++type Doc = [ShowS] -> [ShowS]++doc :: ShowS -> Doc+doc = (:)++render :: Doc -> String+render d = rend 0 (map ($ "") $ d []) "" where+ rend i ss = case ss of+ "[" :ts -> showChar '[' . rend i ts+ "(" :ts -> showChar '(' . rend i ts+ "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts+ "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts+ "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts+ ";" :ts -> showChar ';' . new i . rend i ts+ t : "," :ts -> showString t . space "," . rend i ts+ t : ")" :ts -> showString t . showChar ')' . rend i ts+ t : "]" :ts -> showString t . showChar ']' . rend i ts+ t :ts -> space t . rend i ts+ _ -> id+ new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace+ space t = showString t . (\s -> if null s then "" else (' ':s))++parenth :: Doc -> Doc+parenth ss = doc (showChar '(') . ss . doc (showChar ')')++concatS :: [ShowS] -> ShowS+concatS = foldr (.) id++concatD :: [Doc] -> Doc+concatD = foldr (.) id++replicateS :: Int -> ShowS -> ShowS+replicateS n f = concatS (replicate n f)++-- the printer class does the job+class Print a where+ prt :: Int -> a -> Doc+ prtList :: [a] -> Doc+ prtList = concatD . map (prt 0)++instance Print a => Print [a] where+ prt _ = prtList++instance Print Char where+ prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')+ prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')++mkEsc :: Char -> Char -> ShowS+mkEsc q s = case s of+ _ | s == q -> showChar '\\' . showChar s+ '\\'-> showString "\\\\"+ '\n' -> showString "\\n"+ '\t' -> showString "\\t"+ _ -> showChar s++prPrec :: Int -> Int -> Doc -> Doc+prPrec i j = if j<i then parenth else id+++instance Print Integer where+ prt _ x = doc (shows x)+++instance Print Double where+ prt _ x = doc (shows x)++++instance Print Frac where+ prt _ (Frac i) = doc (showString ( i))+++instance Print Uident where+ prt _ (Uident i) = doc (showString ( i))+++instance Print Lident where+ prt _ (Lident i) = doc (showString ( i))+++instance Print USym where+ prt _ (USym i) = doc (showString ( i))+++instance Print Number where+ prt _ (Number i) = doc (showString ( i))+++instance Print Count where+ prt _ (Count i) = doc (showString ( i))++++instance Print Module where+ prt i e = case e of+ Module modid exportdecl topdecls -> prPrec i 0 (concatD [doc (showString "module") , prt 0 modid , doc (showString "exports") , prt 0 exportdecl , doc (showString "where") , doc (showString "{") , prt 0 topdecls , doc (showString "}")])+++instance Print ExportDecl where+ prt i e = case e of+ ExpAllD -> prPrec i 0 (concatD [doc (showString "all")])+ ExpListD exports -> prPrec i 0 (concatD [doc (showString "(") , prt 0 exports , doc (showString ")")])+++instance Print Export where+ prt i e = case e of+ TypeEx con spec -> prPrec i 0 (concatD [prt 0 con , prt 0 spec])+ VarEx var -> prPrec i 0 (concatD [prt 0 var])++ prtList es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])++instance Print Spec where+ prt i e = case e of+ Neither -> prPrec i 0 (concatD [])+ Decon -> prPrec i 0 (concatD [doc (showString "(") , doc (showString ".") , doc (showString ")")])+ Both -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "..") , doc (showString ")")])+++instance Print TopDecl where+ prt i e = case e of+ ImportD modid asspec -> prPrec i 0 (concatD [doc (showString "import") , prt 0 modid , prt 0 asspec])+ ExternD extnm var type' -> prPrec i 0 (concatD [doc (showString "extern") , prt 0 extnm , prt 0 var , doc (showString "::") , prt 0 type'])+ TypeD con tyvars tydecl -> prPrec i 0 (concatD [doc (showString "type") , prt 0 con , prt 0 tyvars , doc (showString "=") , prt 0 tydecl])+ AscribeD var type' -> prPrec i 0 (concatD [prt 0 var , doc (showString "::") , prt 0 type'])+ VarD var exp -> prPrec i 0 (concatD [prt 0 var , doc (showString "=") , prt 0 exp])+ ProcD var exps exp -> prPrec i 0 (concatD [prt 0 var , prt 0 exps , doc (showString "=") , prt 0 exp])++ prtList es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])++instance Print AsSpec where+ prt i e = case e of+ AsAS con -> prPrec i 0 (concatD [doc (showString "as") , prt 0 con])+ EmptyAS -> prPrec i 0 (concatD [])+++instance Print ExtNm where+ prt i e = case e of+ SomeNm str -> prPrec i 0 (concatD [prt 0 str])+ NoneNm -> prPrec i 0 (concatD [])+++instance Print Exp where+ prt i e = case e of+ BlockE exps -> prPrec i 0 (concatD [doc (showString "do") , doc (showString "{") , prt 5 exps , doc (showString "}")])+ LetS exp0 exp -> prPrec i 5 (concatD [prt 4 exp0 , doc (showString "=") , prt 0 exp])+ LetE exp0 exp1 exp -> prPrec i 5 (concatD [doc (showString "let") , prt 4 exp0 , doc (showString "=") , prt 0 exp1 , doc (showString "in") , prt 0 exp])+ StoreE exp0 exp -> prPrec i 5 (concatD [prt 4 exp0 , doc (showString "<-") , prt 0 exp])+ CaseE exp casealts -> prPrec i 5 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 casealts , doc (showString "}")])+ BranchE branchalts -> prPrec i 5 (concatD [doc (showString "branch") , doc (showString "of") , doc (showString "{") , prt 0 branchalts , doc (showString "}")])+ BinOpE exp0 usym exp -> prPrec i 4 (concatD [prt 3 exp0 , prt 0 usym , prt 3 exp])+ AppE exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , prt 2 exp])+ UnOpE unop exp -> prPrec i 2 (concatD [prt 0 unop , prt 1 exp])+ IdxE exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "[") , prt 0 exp , doc (showString "]")])+ FldE exp field -> prPrec i 1 (concatD [prt 1 exp , doc (showString ".") , prt 0 field])+ ArrayE exps -> prPrec i 0 (concatD [doc (showString "Array") , doc (showString "[") , prt 0 exps , doc (showString "]")])+ RecordE fieldds -> prPrec i 0 (concatD [doc (showString "{") , prt 0 fieldds , doc (showString "}")])+ TupleE exps -> prPrec i 0 (concatD [doc (showString "(") , prt 0 exps , doc (showString ")")])+ AscribeE exp type' -> prPrec i 0 (concatD [doc (showString "(") , prt 0 exp , doc (showString "::") , prt 0 type' , doc (showString ")")])+ CountE count -> prPrec i 0 (concatD [prt 0 count])+ VarE var -> prPrec i 0 (concatD [prt 0 var])+ LitE lit -> prPrec i 0 (concatD [prt 0 lit])++ prtList es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ [x] -> (concatD [prt 0 x])+ [x] -> (concatD [prt 5 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])+ x:xs -> (concatD [prt 0 x , prt 0 xs])+ x:xs -> (concatD [prt 5 x , doc (showString ";") , prt 5 xs])++instance Print UnOp where+ prt i e = case e of+ Load -> prPrec i 0 (concatD [doc (showString "@")])+++instance Print CaseAlt where+ prt i e = case e of+ CaseAlt casepat exp -> prPrec i 0 (concatD [prt 0 casepat , doc (showString "->") , prt 0 exp])++ prtList es = case es of+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])++instance Print CasePat where+ prt i e = case e of+ ConP con var -> prPrec i 0 (concatD [prt 0 con , prt 0 var])+ LitP lit -> prPrec i 0 (concatD [prt 0 lit])+ VarP var -> prPrec i 0 (concatD [prt 0 var])+++instance Print BranchAlt where+ prt i e = case e of+ BranchAlt branchpat exp -> prPrec i 0 (concatD [doc (showString "|") , prt 0 branchpat , doc (showString "->") , prt 0 exp])++ prtList es = case es of+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])++instance Print BranchPat where+ prt i e = case e of+ BoolBP exp -> prPrec i 0 (concatD [prt 4 exp])+ DefaultBP -> prPrec i 0 (concatD [])+++instance Print Type where+ prt i e = case e of+ TyFun type'0 type' -> prPrec i 0 (concatD [prt 2 type'0 , doc (showString "->") , prt 0 type'])+ TyArray type'0 type' -> prPrec i 2 (concatD [doc (showString "Array") , prt 1 type'0 , prt 1 type'])+ TyConstr con types -> prPrec i 2 (concatD [prt 0 con , prt 1 types])+ TyTuple types -> prPrec i 0 (concatD [doc (showString "(") , prt 0 types , doc (showString ")")])+ TyCount count -> prPrec i 0 (concatD [prt 0 count])+ TyVarT tyvar -> prPrec i 0 (concatD [prt 0 tyvar])+ TyConstr0 con -> prPrec i 0 (concatD [prt 0 con])++ prtList es = case es of+ [] -> (concatD [])+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ [x] -> (concatD [prt 1 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])+ x:xs -> (concatD [prt 0 x , prt 0 xs])+ x:xs -> (concatD [prt 1 x , prt 1 xs])++instance Print TyDecl where+ prt i e = case e of+ TyRecord fieldts -> prPrec i 0 (concatD [doc (showString "{") , prt 0 fieldts , doc (showString "}")])+ TyTagged concs -> prPrec i 0 (concatD [doc (showString "|") , prt 0 concs])+ TySyn type' -> prPrec i 0 (concatD [prt 0 type'])+++instance Print ConC where+ prt i e = case e of+ ConC con types -> prPrec i 0 (concatD [prt 0 con , prt 0 types])++ prtList es = case es of+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])++instance Print FieldT where+ prt i e = case e of+ FieldT field type' -> prPrec i 0 (concatD [prt 0 field , doc (showString "::") , prt 0 type'])++ prtList es = case es of+ [] -> (concatD [])+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])++instance Print Lit where+ prt i e = case e of+ CharL c -> prPrec i 0 (concatD [prt 0 c])+ StringL str -> prPrec i 0 (concatD [prt 0 str])+ IntL number -> prPrec i 0 (concatD [prt 0 number])+ FracL frac -> prPrec i 0 (concatD [prt 0 frac])+ EnumL con -> prPrec i 0 (concatD [prt 0 con])+++instance Print FieldD where+ prt i e = case e of+ FieldD field exp -> prPrec i 0 (concatD [prt 0 field , doc (showString "=") , prt 0 exp])++ prtList es = case es of+ [x] -> (concatD [prt 0 x])+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])++instance Print Var where+ prt i e = case e of+ Var lident -> prPrec i 0 (concatD [prt 0 lident])+++instance Print Con where+ prt i e = case e of+ Con uident -> prPrec i 0 (concatD [prt 0 uident])+++instance Print Modid where+ prt i e = case e of+ Modid uident -> prPrec i 0 (concatD [prt 0 uident])+++instance Print Field where+ prt i e = case e of+ Field lident -> prPrec i 0 (concatD [prt 0 lident])+++instance Print TyVar where+ prt i e = case e of+ VarTV lident -> prPrec i 0 (concatD [prt 0 lident])+ CntTV lident -> prPrec i 0 (concatD [doc (showString "#") , prt 0 lident])++ prtList es = case es of+ [] -> (concatD [])+ x:xs -> (concatD [prt 0 x , prt 0 xs])++
+ Main.hs view
@@ -0,0 +1,694 @@+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- The pec embedded compiler+-- Copyright 2011, Brett Letner++module Main (main) where++import Control.Monad.State+import Data.Char+import Data.Either+import Data.List+import GHC.IO.Exception+import Language.Pec.Abs+import Language.Pec.ErrM+import Language.Pec.Layout+import Language.Pec.Par+import Language.Pec.Print+import System.Console.CmdArgs+import System.Directory+import System.FilePath+import System.Process+import qualified Language.Haskell as H++data Args = Args+ { files :: [FilePath]+ , keep_tmp_files :: Bool+ , rebuild_all :: Bool+ } deriving (Show, Data, Typeable)++argsDesc :: Args+argsDesc = Args+ { files = def &= args+ , keep_tmp_files = def &= help "Keep temporary files"+ , rebuild_all = def &= help "Rebuild all files"+ } &= summary summry &= program prog++summry :: String+summry = prog ++ " v" ++ vers ++ ", " ++ copyright++prog :: String+prog = "pec"++copyright :: String+copyright = "(C) Brett Letner 2011"++vers :: String+vers = "0.1"++initSt :: Args -> St+initSt x = St+ { visited = []+ , modified = False+ , rebuild = rebuild_all x+ , not_visited = map (\fn -> dropExtension fn ++ "_") $ files x+ , strings = []+ , counts = []+ , keep_tmps = keep_tmp_files x+-- , mains = []+ }++type M a = StateT St IO a++data St = St+ { not_visited :: [FilePath]+ , modified :: Bool+ , rebuild :: Bool+ , visited :: [FilePath]+ , strings :: [String]+ , counts :: [Integer]+ , keep_tmps :: Bool+-- , mains :: [FilePath]+ }++main :: IO ()+main = do+ args <- cmdArgs argsDesc+ let fns = files args+ case fns of+ [] -> putStrLn summry+ (fn:_) -> do+ let mnFn = new_ext "_main.hs" fn+ let llFn = new_ext ".ll" fn+ st <- execStateT pec_all $ initSt args+ when (modified st || rebuild st) $ writeFile mnFn $ H.prettyPrint $+ hMainModule (dropExtension fn) (visited st) (strings st)+ let mnExe = new_ext ".exe" mnFn+ my_system $ unwords ["ghc --make -o", mnExe, mnFn] -- fixme:check exit code+ pwd <- getCurrentDirectory+ my_system $ pwd ++ "/" ++ mnExe+ let llFns = ["istrings_" ++ new_ext ".ll" fn] ++ (map (new_ext ".ll" . init) $ visited st)+ let llBc = new_ext ".bc" llFn+ my_system $ "cat " ++ unwords llFns ++ " | llvm-as > " ++ llBc+ let llExe = new_ext ".exe" llFn+ my_system $ unwords ["llvm-ld -disable-opt -o", llExe, llBc] -- array bug in llvm+ when (not $ keep_tmps st) $ my_system $ unwords $+ [ "rm *.hi *.o", "*_.hs" -- fixme: clean up Cnts files+ , mnExe, mnFn, llBc+ ] ++ llFns+ return ()++pec_all :: M ()+pec_all = do+ st <- get+ case not_visited st of+ [] -> return ()+ (n:ns) -> do+ put $ st{ not_visited = ns }+ when (n `notElem` visited st) $ do+ ns <- pec_file n+ modify $ \st -> st{ visited = n : visited st+ , not_visited = ns ++ not_visited st+ }+ pec_all++pec_file :: FilePath -> M [FilePath]+pec_file n = do+ let fn = init n ++ ".pec"+ let hsFn = new_ext "_.hs" fn+ ss <- lift $ liftM lines $ readFile fn+ let (xs,ys) = partition (\s -> not (null s) && head s == '>') ss+ case pModule $ resolveLayout True $ myLexer $ unlines ys of+ Bad e -> error e+ Ok m -> do+ b <- isOutOfDate fn hsFn+ h <- hModule m+ when b $ do+ modify $ \st -> st{ modified = True }+ lift $ writeFile hsFn $ unlines $+ imports_hack (lines $ H.prettyPrint h) (map tail xs)+ return $ imports m++isOutOfDate :: FilePath -> FilePath -> M Bool+isOutOfDate inFn outFn = do+ b <- gets rebuild+ if b+ then return True+ else do+ r <- lift $ doesFileExist outFn+ if r+ then liftM2 (>) (lift $ getModificationTime inFn) (lift $ getModificationTime outFn)+ else return True++imports_hack :: [String] -> [String] -> [String]+imports_hack xs ys+ | null es = bs ++ cs ++ ds+ | otherwise = bs ++ ds ++ fs ++ cs ++ gs+ where+ (bs,cs) = break (has_prefix "import ") xs+ (ds,es) = break (has_prefix "import ") ys+ (fs,gs) = span (has_prefix "import ") es++doList :: [H.Exp] -> H.Exp+doList xs =+ H.Do $ map H.Qualifier $ xs ++ [H.apps (H.var "return") [H.Tuple []]]++importDecl :: Bool -> String -> H.ImportDecl+importDecl q n = H.ImportDecl+ { H.importModule = H.ModuleName n+ , H.importQualified = q+ , H.importLoc = nl+ , H.importSrc = False+ , H.importPkg = Nothing+ , H.importAs = Nothing+ , H.importSpecs = Nothing+ }++typeSig :: String -> H.Type -> H.Decl+typeSig s = H.TypeSig nl [H.name s]++gen :: Modid -> [TopDecl] -> [H.Decl]+gen n xs =+ [ typeSig "gen" $ H.TyApp (H.tyCon "M") (H.TyTuple H.Boxed [])+ , H.bind "gen" [] $ H.apps (H.var "gen_file") [H.strE $ printTree n, doList $ concatMap f xs ]+ ]+ where+ f x = case x of+ ExternD _ a _ -> [H.apps (H.var "declare") [hvar a "d"]]+ ProcD a _ _ -> [H.apps (H.var "define") [hvar a "d"]]+ _ -> []++hmodule :: String -> [String] -> Maybe [H.ExportSpec] -> [H.ImportDecl] -> [H.Decl] -> H.Module+hmodule n ps = H.Module nl (H.ModuleName n)+ [H.LanguagePragma nl [H.name p] | p <- ps ] Nothing++hMainModule :: FilePath -> [String] -> [String] -> H.Module+hMainModule fn ns ss = hmodule "Main" [] Nothing imps [mainDecl]+ where+ imps = importDecl False "Pec.Base" : map (importDecl True) ns+ mainDecl = H.bind "main" [] $ H.apps (H.var "gen_files")+ [ H.strE fn+ , doList [H.qvar (H.ModuleName n) (H.name "gen") | n <- ns ]+ , H.List $ map H.strE $ nub $ sort ss+ ]++filterCnts :: (Ord a, Num a) => [a] -> [a]+filterCnts xs = filter (`notElem` [256, 4294967296]) $ nub $ sort xs++hCountModule :: Integer -> M ()+hCountModule i = do+ q <- gets rebuild+ r <- lift $ doesFileExist fn+ when (q || not r) $ do+ modify $ \st -> st{ modified = True }+ lift $ writeFile fn $ H.prettyPrint $ hmodule n [] Nothing+ [importDecl False "Pec.Base"]+ [ hdatadecl n [] [H.QualConDecl nl [] [] (H.ConDecl (H.name n) [])]+ , hinstdecl [] "Count" [H.tyCon n]+ [H.InsDecl $ H.simpleFun nl (H.name "countof") (H.name "_") (H.intE i)]+ , hinstdecl [] "Typed" [H.tyCon n]+ [H.InsDecl $ H.simpleFun nl (H.name "typeof") (H.name "_") (H.con "TyUnit")]+ ]+ where+ n = "Cnt" ++ show i+ fn = n ++ ".hs"++hinstdecl :: H.Context -> String -> [H.Type] -> [H.InstDecl] -> H.Decl+hinstdecl qs n = H.InstDecl nl (nub $ sort qs) (H.qname n)++hModule :: Module -> M H.Module+hModule (Module a b cs) = do+ (xs,ys) <- liftM partitionEithers $ mapM (hTopDecl n) cs+ cnts <- liftM filterCnts $ gets counts+ modify $ \st -> st{ counts = [] }+ mapM_ hCountModule cnts+ return $ hmodule n+ [ "FlexibleInstances", "MultiParamTypeClasses", "ScopedTypeVariables"+ , "TypeSynonymInstances" ]+ (hExpDecl a cs b)+ (importDecl False "Pec.Base" : [ importDecl False $ "Cnt" ++ show cnt | cnt <- cnts ] ++ xs)+ (gen a cs ++ concat ys)+ where n = userc a++hExpDecl :: Modid -> [TopDecl] -> ExportDecl -> Maybe [H.ExportSpec]+hExpDecl n xs a = case a of+ ExpAllD -> Nothing+ ExpListD bs -> Just $ (H.EVar $ H.Qual (H.ModuleName $ userc n) (H.name "gen")) : concatMap (hExport xs) bs++hevar :: String -> H.ExportSpec+hevar = H.EVar . H.qname++hExport :: [TopDecl] -> Export -> [H.ExportSpec]+hExport xs ex = case ex of+ VarEx a -> [hevar $ user a]+ TypeEx a b -> H.EThingWith (H.qname $ userc a) [] : map hevar zs+ where+ zs = case (lookupType xs a, b) of+ (_, Neither) -> []+ (TyTagged ys, Decon) -> concat $ map (tail . nPat) ys+ (TyTagged ys, Both) -> concatMap nPat ys+ (TyRecord ys, Both) -> map hgetfld ys+ _ -> error "export spec doesn't match type decl"++lookupType :: Print a => [TopDecl] -> a -> TyDecl+lookupType xs a = case [ b | TypeD a1 _ b <- xs, printTree a == printTree a1 ] of+ [] -> error $ "unknown type decl:" ++ printTree a+ (b:_) -> b++hTopDecl :: String -> TopDecl -> M (Either H.ImportDecl [H.Decl])+hTopDecl qn x = case x of+ VarD a b -> do+ e <- hExp b+ return $ Right [ nameBind (user a) e ]+ ProcD a bs c -> do+ e0 <- hExp c+ e1 <- foldM hArg e0 $ reverse bs+ return $ Right+ [ nameBind n $ H.App (H.var "call") (H.var nd)+ , nameBind nd $ H.apps (H.var "proc")+ [ H.strE $ init $ if n == "main_" then n else qn ++ "." ++ n+ , e1+ ]+ ]+ where+ n = user a+ nd = n ++ "d"+ ImportD a b -> case b of+ AsAS{} -> error "todo:'import as' not implemented"+ EmptyAS -> return $ Left $ importDecl False (userc a)+ ExternD a b c -> do+ t <- htype "Decl" c+ return $ Right+ [ nameBind (user b) $ H.App (H.var "call") (H.var nd)+ , nameBind nd $ ascribe (H.App (H.var "extern") (H.strE s)) t+ ]+ where+ s = case a of+ NoneNm -> printTree b+ SomeNm s -> s+ nd = user b ++ "d"+ AscribeD a b -> do+ t <- htype "Term" b+ return $ Right [typeSig (user a) t]+ TypeD a bs0 c -> do+ let bs = map uTyVar bs0+ let t0 = dtype_ty a bs+ case c of+ TySyn d -> do+ t <- pType d+ return $ Right+ [H.TypeDecl nl (H.name $ userc a) (map htvbind bs) t]+ TyRecord fs0 -> do+ let fs = sortBy cmpFieldT fs0+ Right ds <- hTopDecl qn $ TypeD a bs0 $ TyTagged [ConC a [ t | FieldT _ t <- fs ]]+ xs <- mapM (hfieldt t0 bs $ length fs) $ zip fs [0 .. ]+ return $ Right $ concat xs ++ ds+ TyTagged xs0 -> do+ let xs = sortBy (\(ConC a _) (ConC b _) -> compare a b) xs0+ let cnt = genericLength xs+ add_count cnt+ let dd = hdatadecl (userc a) (map htvbind bs) []+ cts <- sequence [ htytuple ts | ConC _ ts <- xs ]+ let rs = concatMap (fconc a bs cnt (isTyEnum xs)) $ zip (zip xs [0 .. ]) cts+ let typed_id e = hinstdecl (pre bs) "Typed" [t0] [ H.InsDecl $ nameBind "typeof" $ H.lamE nl [H.PParen $ H.PatTypeSig nl (H.PWildCard) t0 ] e ]+ return $ Right $ case () of+ () | isTyUnit xs ->+ let+ [ConC m _] = xs+ n = user m+ in+ [ dd+ , typed_id $ H.con "TyUnit"+ , typeSig n $ tpred bs $ tterm t0+ , nameBind n $ H.App (H.var "cast") (H.var "unit")+ , hinstdecl (hassts "EQ" bs) "EQ" [t0]+ [ H.InsDecl $ nameBind "eq" (H.var "eq_unit")+ , H.InsDecl $ nameBind "ne" (H.var "ne_unit") ]+ ]+ | isTyNewtype xs ->+ let+ [ct] = cts+ [ConC m _] = xs+ n = user m+ in+ [ dd+ , typed_id $ unused_ty ct+ , hinstdecl (hassts "Typed" bs) "Newtype" [t0, ct] []+ -- , hinstdecl (hassts "EQ" bs) "EQ" [t0]+ -- [ H.InsDecl $ nameBind "eq" (H.App (H.var "unwrap2") (H.var "eq"))+ -- , H.InsDecl $ nameBind "ne" (H.App (H.var "unwrap2") (H.var "ne")) ]+ , typeSig n $ tpred bs $ tterm $ H.TyFun ct t0+ , nameBind n $ H.var "wrap"+ ]+ | isTyEnum xs ->+ [ dd+ , typed_id $ H.App (H.con "TyEnum") (H.intE cnt)+ , hinstdecl (pre bs) "Tagged" [ t0, tcnt cnt ]+ [H.InsDecl $ nameBind "tagof" (H.var "cast")]+ , hinstdecl [] "EQ" [t0] []+ ] ++ rs+ | otherwise ->+ [ dd+ , typed_id $ H.App (H.con "TySum") (H.List [unused_ty ct | ct <- cts ])+ , hinstdecl (pre bs) "Tagged" [ tptr t0, tcnt cnt ]+ [H.InsDecl $ nameBind "tagof" (H.var "tagofp")]+ ] ++ rs++hfieldt :: H.Type -> [TyVar] -> Int -> (FieldT, Int) -> M [H.Decl]+hfieldt t0 tvs cnt (fld@(FieldT _ t), i) = do+ ht <- pType t+ return+ [ typeSig n $ tpred tvs $ H.TyFun (tterm $ tptr t0) (tterm $ tptr ht)+ , nameBind n $ foldr (\a b -> H.InfixApp (H.var $ a ++ "_get") (H.qvop ".") b) (H.App (H.var "app") (H.var "unwrap_ptr_")) ss+ ]+ where+ n = hgetfld fld+ ss = case cnt of+ 1 -> []+ _ | i == cnt - 1 -> replicate i "snd"+ _ -> ["fst"] ++ replicate i "snd"++hgetfld :: FieldT -> String+hgetfld (FieldT f _) = user f ++ "get"++cmpFieldT :: FieldT -> FieldT -> Ordering+cmpFieldT (FieldT a _) (FieldT b _) = compare a b++cmpFieldD :: FieldD -> FieldD -> Ordering+cmpFieldD (FieldD a _) (FieldD b _) = compare a b++unused_ty :: H.Type -> H.Exp+unused_ty t = H.App (H.var "typeof") $ ascribe (H.var "unused") t++isTyUnit :: [ConC] -> Bool+isTyUnit x = isTyNewtype x && isTyEnum x++isTyNewtype :: [a] -> Bool+isTyNewtype [_] = True+isTyNewtype _ = False++isTyEnum :: [ConC] -> Bool+isTyEnum xs = and [ null ys | ConC _ ys <- xs ]++hdatadecl :: String -> [H.TyVarBind] -> [H.QualConDecl] -> H.Decl+hdatadecl n vs ds = H.DataDecl nl H.DataType [] (H.name n) vs ds []++htycon :: Print a => a -> H.Type+htycon = H.tyCon . userc++htyvar :: TyVar -> H.Type+htyvar = H.tyVar . printTree . uncnttv++uncnttv :: TyVar -> Lident+uncnttv x = case x of+ CntTV a -> a+ VarTV a -> a++uTyVar :: TyVar -> TyVar+uTyVar x = case x of+ CntTV a -> CntTV $ Lident $ user a+ VarTV a -> VarTV $ Lident $ user a++pre :: [TyVar] -> [H.Asst]+pre = map hasst++hasst :: TyVar -> H.Asst+hasst x = case x of+ CntTV{} -> H.ClassA (H.qname "Count") [htyvar x]+ VarTV{} -> H.ClassA (H.qname "Typed") [htyvar x]++hassts :: String -> [TyVar] -> [H.Asst]+hassts s tvs = [H.ClassA (H.qname s) [htyvar tv] | tv@VarTV{} <- tvs ] ++ map hasst tvs++dtype_ty :: Print a => a -> [TyVar] -> H.Type+dtype_ty a tvs = H.tyApps (htycon a) $ map htyvar tvs++tptr :: H.Type -> H.Type+tptr = H.TyApp (H.tyCon "Ptr")++tcnt :: Show a => a -> H.Type+tcnt cnt = H.tyCon $ "Cnt" ++ show cnt++tpred :: [TyVar] -> H.Type -> H.Type+tpred xs = H.TyForall Nothing (pre xs)++tterm :: H.Type -> H.Type+tterm = H.TyApp (H.tyCon "Term")++fconc :: (Print a, Show a1) =>+ a+ -> [TyVar]+ -> a1+ -> Bool+ -> ((ConC, Integer), H.Type)+ -> [H.Decl]+fconc a tvs cnt is_enm ((conc@(ConC _ ts), i),t1) =+ [ typeSig nTag $ tpred tvs $ tterm $ H.tyApps (H.tyCon "Tag") [mtptr t0, tcnt cnt]+ , nameBind nTag $ H.App (H.var "tag") (H.intE i)+ , typeSig n $ tpred tvs $ tterm $ if null ts then t0 else H.TyFun t1 t0+ , nameBind n $ H.App (H.var $ if is_enm then "cast" else if null ts then "constr0" else "constr") (H.var nTag)+ , typeSig nAlt $ tpred ((VarTV $ Lident "a") : tvs) $ H.TyFun (H.TyFun (tterm (mtptr t1)) (tterm ta)) $ H.TyFun (tterm (mtptr t0)) (tterm ta)+ , nameBind nAlt $ H.var $ if is_enm then "alt0" else "alt"+ ]+ where+ t0 = dtype_ty a tvs+ [n, nTag, nAlt] = nPat conc+ ta = H.tyVar "a"+ mtptr v = if is_enm then v else tptr v++nPat :: ConC -> [String]+nPat (ConC c _) = [n, n ++ "tag", n ++ "alt"]+ where+ n = user c++hArg :: H.Exp -> Exp -> M H.Exp+hArg e x = case x of+ VarE{} -> return $ H.apps (H.var "arg")+ [H.strE (printTree x), lambda [hpvar x] e]+ TupleE [] -> return $ H.App (H.var "unitarg") e+ TupleE [a] -> hArg e a+ _ -> do+ let v = varE "v"+ s <- hStmt $ LetS x v+ hArg (blocke [s, [H.Qualifier $ eval e]]) v++ascribe :: H.Exp -> H.Type -> H.Exp+ascribe a b = H.Paren $ H.ExpTypeSig nl a b++nameBind :: String -> H.Exp -> H.Decl+nameBind s = H.nameBind nl (H.name s)++htype :: String -> Type -> M H.Type+htype s = liftM (H.TyApp (H.tyCon s)) . pType++pType :: Type -> M H.Type+pType x = case x of+ TyConstr0{} -> return $ htycon x+ TyFun a b -> liftM2 H.TyFun (pType a) (pType b)+ TyTuple xs -> htytuple xs+ TyConstr a bs -> liftM (H.tyApps (htycon a)) $ mapM pType bs+ TyArray a b -> liftM (H.tyApps (H.tyCon "Array")) $ mapM pType [a,b]+ TyCount a -> add_count i >> return (tcnt i)+ where i = pcount a+ TyVarT a -> return $ H.tyVar $ user a++htytuple :: [Type] -> M H.Type+htytuple xs0 = case xs0 of+ [] -> return $ tytuple []+ [a] -> pType a+ [a,b] -> liftM tytuple $ mapM pType [a,b]+ (x:xs) -> liftM tytuple $ mapM pType [x, TyTuple xs]++htvbind :: TyVar -> H.TyVarBind+htvbind = H.UnkindedVar . H.name . printTree . uncnttv++pcount :: Count -> Integer+pcount = read . tail . printTree++tytuple :: [H.Type] -> H.Type+tytuple = H.TyTuple H.Boxed++lambda :: [H.Pat] -> H.Exp -> H.Exp+lambda = H.Lambda nl++hpvar :: Print a => a -> H.Pat+hpvar = H.pVar . user++hvar :: Print a => a -> String -> H.Exp+hvar a s = H.var $ user a ++ s++hCaseAlt :: CaseAlt -> M H.Exp+hCaseAlt (CaseAlt p x) = do+ e <- hExp x+ case p of+ VarP{} -> return $ H.tuple [ H.var "defaulttag", lambda [hpvar p] e]+ ConP a b -> return $ H.tuple+ [ H.var $ s ++ "tag"+ , H.App (H.var $ s ++ "alt") (lambda [hpvar b] e)+ ]+ where s = user a+ LitP y -> case y of+ EnumL a -> hCaseAlt (CaseAlt (ConP a (var "_")) x)+ IntL a -> f "int" (H.Paren $ H.Lit $ H.Int $ read $ printTree a)+ StringL a -> add_string a >> f "string" (H.Lit $ H.String a)+ CharL a -> f "char" (H.Lit $ H.Char a)+ FracL{} -> error $ "can't case on fractional:" ++ printTree y+ where+ f s t = return $ H.tuple [ H.App (H.var $ s ++ "tag") t+ , lambda [H.wildcard] e]+ +eval :: H.Exp -> H.Exp+eval e = H.App (H.var "eval") e++hStmt :: Exp -> M [H.Stmt]+hStmt x = case x of+ LetS a b -> case a of+ VarE{} -> do+ e <- hExp b+ return [H.Generator nl (hpvar a) $ eval e]+ TupleE xs0 -> case xs0 of+ [] -> do+ e <- hExp b+ t <- htype "Term" $ TyTuple []+ return [H.Qualifier $ eval $ ascribe e t]+ [e] -> hStmt $ LetS e b+ [ea,eb] -> liftM concat $ mapM hStmt+ [ LetS e b+ , LetS ea $ AppE (varE "fst") e+ , LetS eb $ AppE (varE "snd") e+ ] where e = varE "pat"+ (x:xs) -> hStmt $ LetS (TupleE [x, TupleE xs]) b+ AscribeE e t -> hStmt $ LetS e $ AscribeE b t+ _ -> error $ "unexpected pattern:" ++ printTree x+ _ -> do+ e <- hExp x+ return [H.Qualifier $ eval e]++varE :: String -> Exp+varE = VarE . var++var :: String -> Var+var = Var . Lident++con :: String -> Con+con = Con . Uident++blocke :: [[H.Stmt]] -> H.Exp+blocke = H.App (H.var "lift") . H.Do . concat++enuml :: String -> Lit+enuml = EnumL . con++penum :: String -> CasePat+penum = LitP . enuml++hExp :: Exp -> M H.Exp+hExp x = case x of+ RecordE xs -> hExp $ BlockE $+ [ LetS p $ varE "alloca'" ] +++ [ StoreE (FldE p a) b | FieldD a b <- sortBy cmpFieldD xs ] +++ [ UnOpE Load p ]+ where p = varE "p"+ BlockE xs -> liftM blocke $ mapM hStmt xs+ LetS{} -> error "let stmt must be inside of do block"+ LetE a b c -> hExp $ BlockE [LetS a b, c]+ BranchE bs0 -> case bs0 of+ (BranchAlt (BoolBP f) g : bs) | not $ null bs -> hExp $ CaseE f+ [ CaseAlt (penum "True") g+ , CaseAlt (penum "False") $ BranchE bs+ ]+ [BranchAlt DefaultBP g] -> hExp g+ _ -> error "malformed branch expression"+ CaseE a bs -> do+ e <- hExp a+ cs <- mapM hCaseAlt bs+ return $ H.apps (H.var "switch") [ e, H.List cs ]+ StoreE a b -> do+ ea <- hExp a+ eb <- hExp b+ return $ H.apps (H.var "store") [ea, eb]+ AppE a b -> do+ ea <- hExp a+ eb <- hExp b+ return $ H.apps (H.var "app") [ea, eb]+ BinOpE a b c -> do+ ea <- hExp a+ ec <- hExp c+ return $ H.Paren $ H.InfixApp ea (H.qvop $ eSym $ printTree b) ec+ UnOpE a b ->+ liftM (H.App (H.Paren $ H.var $ eSym $ printTree a)) $ hExp b+ IdxE a b -> do+ ea <- hExp a+ eb <- hExp b+ return $ H.apps (H.var "idx") [ea,eb]+ FldE a b -> liftM (H.App (hvar b "get")) $ hExp a+ ArrayE xs -> do+ e <- hExp $ CountE (Count $ '#' : show (length xs))+ es <- mapM hExp xs+ return $ H.apps (H.var "array") [ e, H.List es ]+ TupleE xs0 -> case xs0 of+ [] -> return $ H.var "unit"+ [a] -> hExp a+ [a,b] -> do+ ea <- hExp a+ eb <- hExp b+ return $ H.apps (H.var "pair") [ea,eb]+ (x:xs) -> hExp $ TupleE [x, TupleE xs]+ AscribeE a b -> liftM2 ascribe (hExp a) (htype "Term" b)+ CountE a -> do+ add_count i+ return $ ascribe (H.var "unused") $+ H.TyApp (H.tyCon "Term") (H.tyCon $ "Cnt" ++ show i)+ where i = pcount a+ VarE a -> return $ hvar a ""+ LitE a -> hLit a++nl :: H.SrcLoc+nl = error "SRCLOC"++add_string :: String -> M ()+add_string s = modify $ \st -> st{ strings = s : strings st }++add_count :: Integer -> M ()+add_count s = modify $ \st -> st{ counts = s : counts st }++eSym :: String -> String+eSym cs = cs ++ "$"++hLit :: Lit -> M H.Exp+hLit x = case x of+ EnumL a -> return $ H.var $ user a+ CharL a -> return $ H.App (H.var "char") $ H.Lit $ H.Char a+ IntL a -> return $ H.App (H.var "int") $ H.Paren $ H.Lit $ H.Int $ read $ printTree a+ StringL a -> do+ add_string a+ return (H.App (H.var "string") $ H.Lit $ H.String a)+ FracL a -> return $ H.App (H.var "frac") $ H.Paren $ H.Lit $ H.Frac $ toRational $ ((read $ printTree a) :: Double)++lowercase :: String -> String+lowercase "" = ""+lowercase (c:cs) = toLower c : cs++has_prefix :: Eq a => [a] -> [a] -> Bool+has_prefix pre s = take (length pre) s == pre++new_ext :: String -> FilePath -> FilePath+new_ext s fn = dropExtension fn ++ s++imports :: Module -> [String]+imports (Module _ _ xs) = [ userc a | ImportD a _ <- xs ]++user :: Print a => a -> String+user = lowercase . userc++userc :: Print a => a -> String+userc a = printTree a ++ "_"++my_system :: String -> IO ()+my_system s = do+ putStrLn $ "system:" ++ s+ ec <- system s+ case ec of+ ExitSuccess -> return ()+ ExitFailure i -> error $ "exiting(" ++ show i ++ ")"
+ Makefile view
@@ -0,0 +1,45 @@+all : config install tests # cov+ wc -l Main.hs Pec/Base.hs++install : build+ ./Setup.exe install++tests :+ (cd test_cases;make)++build : Setup.exe # config + ./Setup.exe build++config : ./Setup.exe+ ./Setup.exe configure --user++EXCLUDE=--exclude=Language.Pec.Print --exclude=Language.Pec.Abs --exclude=Language.Pec.Par --exclude=Language.Pec.Lex --exclude=Language.Pec.ErrM --exclude=Language.Pec.Layout++cov :+ mv test_cases/*.tix .+ hpc markup pec $(EXCLUDE)+ hpc report pec $(EXCLUDE)++Setup.exe : Setup.hs+ ghc --make -o $@ $<++gen : Language/Pec/Par.hs Language/Pec/Lex.hs++Language/%/Par.y Language/%/Lex.x : %.cf+ bnfc -p Language -d $<++Language/%/Par.hs : Language/%/Par.y+ happy $<++Language/%/Lex.hs : Language/%/Lex.x+ alex $<++clean :+ rm -f *.bc *.ll *.exe *.o *.hi *.y *.s *.out *~ *.tix hpc_*.html *.hs.html *~+ (cd test_cases;make clean)+ (cd Pec;make clean)+ rm -rf dist .hpc pec-0.1++vclean : clean+ (cd test_cases;make vclean)+ rm -rf Language
+ Pec.cf view
@@ -0,0 +1,136 @@+comment "//";+comment "/*" "*/";++entrypoints Module;++layout "where", "do", "of";++Module . Module ::= "module" Modid "exports" ExportDecl "where" "{" [TopDecl] "}";++ExpAllD . ExportDecl ::= "all";+ExpListD . ExportDecl ::= "(" [Export] ")";++TypeEx . Export ::= Con Spec;+VarEx . Export ::= Var;++Neither . Spec ::= ;+Decon . Spec ::= "(" "." ")";+Both . Spec ::= "(" ".." ")";++ImportD . TopDecl ::= "import" Modid AsSpec;+ExternD . TopDecl ::= "extern" ExtNm Var "::" Type;+TypeD . TopDecl ::= "type" Con [TyVar] "=" TyDecl;+AscribeD . TopDecl ::= Var "::" Type;+VarD . TopDecl ::= Var "=" Exp;+ProcD . TopDecl ::= Var [Exp0] "=" Exp;++AsAS . AsSpec ::= "as" Con ;+EmptyAS . AsSpec ::= ;++SomeNm . ExtNm ::= String;+NoneNm . ExtNm ::= ;++BlockE . Exp ::= "do" "{" [Exp5] "}";+_ . Exp ::= Exp5;++LetS . Exp5 ::= Exp4 "=" Exp; -- sugar which can only appear in a block and lhs only var+LetE . Exp5 ::= "let" Exp4 "=" Exp "in" Exp;+StoreE . Exp5 ::= Exp4 "<-" Exp;+CaseE . Exp5 ::= "case" Exp "of" "{" [CaseAlt] "}";+BranchE . Exp5 ::= "branch" "of" "{" [BranchAlt] "}";+_ . Exp5 ::= Exp4;++BinOpE . Exp4 ::= Exp3 USym Exp3;+_ . Exp4 ::= Exp3;++AppE . Exp3 ::= Exp3 Exp2;+_ . Exp3 ::= Exp2;++UnOpE . Exp2 ::= UnOp Exp1;+_ . Exp2 ::= Exp1;++IdxE . Exp1 ::= Exp1 "[" Exp "]";+FldE . Exp1 ::= Exp1 "." Field;+_ . Exp1 ::= Exp0;++ArrayE . Exp0 ::= "Array" "[" [Exp] "]";+RecordE . Exp0 ::= "{" [FieldD] "}";+TupleE . Exp0 ::= "(" [Exp] ")";+AscribeE . Exp0 ::= "(" Exp "::" Type ")";+CountE . Exp0 ::= Count;+VarE . Exp0 ::= Var;+LitE . Exp0 ::= Lit;++Load . UnOp ::= "@";++CaseAlt . CaseAlt ::= CasePat "->" Exp;++ConP . CasePat ::= Con Var;+LitP . CasePat ::= Lit;+VarP . CasePat ::= Var;++BranchAlt . BranchAlt ::= "|" BranchPat "->" Exp;++BoolBP . BranchPat ::= Exp4;+DefaultBP . BranchPat ::= ;++TyFun . Type ::= Type2 "->" Type;+_ . Type ::= Type2;++TyArray . Type2 ::= "Array" Type1 Type1;+TyConstr . Type2 ::= Con [Type1];+_ . Type2 ::= Type1;++_ . Type1 ::= Type0;++TyTuple . Type0 ::= "(" [Type] ")";+TyCount . Type0 ::= Count;+TyVarT . Type0 ::= TyVar;+TyConstr0 . Type0 ::= Con;++TyRecord . TyDecl ::= "{" [FieldT] "}";+TyTagged . TyDecl ::= "|" [ConC];+TySyn . TyDecl ::= Type;++ConC . ConC ::= Con [Type0];++FieldT . FieldT ::= Field "::" Type;++CharL . Lit ::= Char;+StringL . Lit ::= String;+IntL . Lit ::= Number;+FracL . Lit ::= Frac;+EnumL . Lit ::= Con;++FieldD . FieldD ::= Field "=" Exp;++Var . Var ::= Lident;+Con . Con ::= Uident;+Modid . Modid ::= Uident;++Field . Field ::= Lident;+VarTV . TyVar ::= Lident;+CntTV . TyVar ::= "#" Lident;++token Frac ('-'? digit+ '.' digit+ ('e' '-'? digit+)?);++token Uident (upper (letter | digit | '_')*);+token Lident ((lower | '_') (letter | digit | '_')*);+token USym (('!' | '#' | '$' | '%' | '&' | '*' | '+' | '-' | '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '\\' | '^' | '|' | '~')+);+token Number ('-'? digit+);+token Count ('#' digit+);++separator Exp ",";+separator FieldT ",";+separator TyVar "";+separator Type ",";+separator Export ",";+separator Type0 "";+separator nonempty ConC "|";+separator nonempty Exp0 "";+separator nonempty FieldD ",";+separator nonempty Type1 "";+separator TopDecl ";";+separator nonempty CaseAlt ";";+separator nonempty BranchAlt ";";+separator nonempty Exp5 ";";
+ Pec/Base.hs view
@@ -0,0 +1,599 @@+{-# OPTIONS -Wall #-}+{-# LANGUAGE EmptyDataDecls, MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies, FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances, GADTs #-}++-- The pec embedded compiler+-- Copyright 2011, Brett Letner++module Pec.Base++where++import Control.Monad+import Control.Monad.State hiding (lift)+import Data.Char+import Data.List+import Data.Unique+import Numeric+import System.IO+import qualified Control.Monad.State as S++data V a = V String+data Decl a = Decl Id (Term a)+data Ptr a+data Tag a cnt+data Idx cnt+data Array cnt a+data I cnt+data IString+data W cnt+data Cnt256 = Cnt256+data Cnt4294967296 = Cnt4294967296+data SuccCnt cnt++data Term a where+ Arg :: (Typed a, Typed b) => Id -> (Term a -> Term b) -> Term (a -> b)+ Val :: Typed a => V a -> Term a+ App :: (Typed a, Typed b) => Term (a -> b) -> Term a -> Term b+ Lift :: Typed a => M (Term a) -> Term a++data Ty+ = TyUnit+ | TyEnum Integer+ | TyPtr Ty+ | TyArray Integer Ty+ | TyPair Ty Ty+ | TySum [Ty]+ | TyFun Ty Ty+ | TyDouble+ | TyFloat+ deriving Eq++data St = St+ { istrings_tbl :: [String]+ , outH :: Handle+ , last_label :: Label+ }++type CntW32 = Cnt4294967296+type W32 = W CntW32+type Label = String+type M a = StateT St IO a+type Id = String+type CString = Ptr Char+type W_ a = W a+type I_ a = I a+type SuccCnt_ a = SuccCnt a++class Count cnt where countof :: cnt -> Integer++instance Count cnt => Count (SuccCnt cnt) where+ countof _ = succ $ countof (unused :: cnt)++class (Count cnt, Typed a) => Tagged a cnt | a -> cnt where+ tagof :: Term a -> Term (Tag a cnt)++class Typed a where+ typeof :: a -> Ty+ callt :: Id -> [(Id,Ty)] -> Term a+ callt n bs = with_local $ \(v :: V a) -> do+ let t = typeof (unused :: a)+ let pre = if is_tyunit t then [] else [vof v ++ " ="]+ out 2 $ pre ++ ["call", tyof t, n ++ args (reverse bs)]++class (Typed a, Typed b) => Newtype a b | a -> b where+ unwrap_ :: Term (a -> b)+ unwrap_ = wrap++ unwrap_ptr_ :: Term (Ptr a -> Ptr b)+ unwrap_ptr_ = lam_ cast++class INT a where int :: Integer -> Term a++instance Count Cnt256 where countof _ = 256+instance Count Cnt4294967296 where countof _ = 4294967296+instance Count cnt => INT (I cnt) where int = sint unused+instance Count cnt => INT (Idx cnt) where int = uint unused+instance Count cnt => INT (W cnt) where int = uint unused+instance Count cnt => Tagged (I cnt) cnt where tagof = cast+instance Count cnt => Tagged (W cnt) cnt where tagof = cast+instance Tagged Char Cnt256 where tagof = cast+instance Tagged IString CntW32 where tagof = cast+instance Typed () where typeof _ = TyUnit+instance Typed Char where typeof _ = TyEnum 256+instance Typed Double where typeof _ = TyDouble+instance Typed Float where typeof _ = TyFloat+instance Typed IString where typeof _ = TyEnum $ countof (unused :: CntW32)++instance Count cnt => Typed (SuccCnt cnt) where typeof _ = TyUnit++instance Typed a => Typed (Ptr a) where+ typeof (_ :: Ptr a) = TyPtr $ typeof (unused :: a)++instance (Typed a, Count cnt) => Typed (Array cnt a) where+ typeof (_ :: Array cnt a) =+ TyArray (countof (unused :: cnt)) (typeof (unused :: a))++instance (Typed a, Typed b) => Typed (a -> b) where+ typeof (_ :: a -> b) =+ TyFun (typeof (unused :: a)) (typeof (unused :: b))++ callt n bs = Arg n $ \a -> Lift $ do+ V s <- evalv a+ return $ callt n ((s, typeof (unused :: a)) : bs)++instance (Typed a, Typed b) => Typed (a, b) where+ typeof (_ :: (a, b)) =+ TyPair (typeof (unused :: a)) (typeof (unused :: b))++instance Count cnt => Typed (I cnt) where+ typeof (_ :: I cnt) = TyEnum (countof (unused :: cnt))++instance Count cnt => Typed (W cnt) where+ typeof (_ :: W cnt) = TyEnum (countof (unused :: cnt))++instance Count cnt => Typed (Idx cnt) where+ typeof (_ :: Idx cnt) = TyEnum (countof (unused :: cnt))++instance (Typed a, Count cnt) => Typed (Tag a cnt) where+ typeof (_ :: Tag a cnt) = TyEnum $ countof (unused :: cnt)++uint :: (Count cnt, Typed (f cnt)) => f cnt -> Integer -> Term (f cnt)+uint (_ :: f cnt) x+ | x >= 0 && x < countof (unused :: cnt) = tag x+ | otherwise = error $ "unsigned integer out of range:" ++ show x++sint :: (Count cnt, Typed (f cnt)) => f cnt -> Integer -> Term (f cnt)+sint (_ :: f cnt) x+ | x >= -y && x < y = tag x+ | otherwise = error $ "signed integer out of range:" ++ show x+ where+ y = countof (unused :: cnt) `div` 2++wrap :: (Typed a, Typed b) => Term (a -> b)+wrap = lam_ cast++unwrap2 :: (Newtype a b, Typed c) =>+ (Term b -> Term b -> Term c) -> Term a -> Term a -> Term c+unwrap2 f = \a b -> f (app unwrap_ a) (app unwrap_ b)++unused :: a+unused = error "unused"++cast :: (Typed a, Typed b) => Term a -> Term b+cast f = Lift $ do+ V a <- evalv f+ return $ val a++tagofp :: (Typed a, Count cnt) => Term (Ptr a) -> Term (Tag (Ptr a) cnt)+tagofp = load . tagp++alt0 :: (Typed a, Typed b) => (Term () -> Term b) -> Term a -> Term b+alt0 f _ = f unit++alt :: (Typed a, Typed b, Typed c) =>+ (Term (Ptr b) -> Term c) -> Term (Ptr a) -> Term c+alt f = f . datap++constr :: (Typed a, Count cnt, Typed b) =>+ Term (Tag (Ptr a) cnt) -> Term (b -> a)+constr tg = lam_ $ \f -> Lift $ do+ p <- eval $ alloca unused+ eval_ $ store (tagp p) tg+ eval_ $ store (datap p) f+ return $ load p++constr0 :: (Typed a, Count cnt) => Term (Tag (Ptr a) cnt) -> Term a+constr0 tg = Lift $ do+ p <- eval $ alloca unused+ eval_ $ store (tagp p) tg+ return $ load p++tagp :: (Typed a, Count cnt) =>+ Term (Ptr a) -> Term (Ptr (Tag (Ptr a) cnt))+tagp = gep (tag 0 :: Term W32)++datap :: (Typed a, Typed b) => Term (Ptr a) -> Term (Ptr b)+datap (f :: Term (Ptr a)) = with_local $ \r -> do+ p <- evalv f+ q <- new_local+ let TySum ts = typeof (unused :: a)+ out 2 [ vof q, "= getelementptr", vtof p ++ ", i32 0, i32 1" ]+ out 2 [ vof r, "= bitcast", tyof $ TyPtr $ max_tysum ts, vof q+ , "to", tof r ]++bitcast :: (Typed a, Typed b) => Term (Ptr a) -> Term (Ptr b)+bitcast x = with_local $ \q -> do+ p <- evalv x+ out 2 [ vof q, "= bitcast", vtof p, "to", tof q ]++gep :: (Typed a, Typed b) => Term i -> Term (Ptr a) -> Term (Ptr b)+gep f g = with_local $ \q -> do+ i <- evalv f+ p <- evalv g+ out 2 [ vof q, "= getelementptr", vtof p ++ ", i32 0, i32", vof i ]++load :: Typed a => Term (Ptr a) -> Term a+load f = with_local $ \v -> do+ p <- evalv f+ out 2 [ vof v, "= load", vtof p ]++prim2 :: (Typed a, Typed b, Typed c) =>+ String -> Term a -> Term b -> Term c+prim2 s f g = with_local $ \c -> do+ a <- evalv f+ b <- evalv g+ out 2 [ vof c, "=", s, vtof a ++ ",", vof b ]++tag :: Typed a => Integer -> Term a+tag = val . show++store :: Typed a => Term (Ptr a) -> Term a -> Term ()+store f g = Lift $ do+ p <- evalv f+ a <- evalv g+ out 2 [ "store", vtof a ++ ",", vtof p ]+ return unit++pair :: (Typed a, Typed b) => Term a -> Term b -> Term (a,b)+pair f g = Lift $ do+ p <- eval $ alloca unused+ eval_ $ store (fst_get p) f+ eval_ $ store (snd_get p) g+ return $ load p++fst_get :: (Typed a, Typed b) => Term (Ptr (a,b)) -> Term (Ptr a)+fst_get = gep (tag 0 :: Term W32)++snd_get :: (Typed a, Typed b) => Term (Ptr (a,b)) -> Term (Ptr b)+snd_get = gep (tag 1 :: Term W32)++fst_ :: (Typed a, Typed b) => Term (Ptr (a,b) -> Ptr a)+fst_ = lam_ fst_get++snd_ :: (Typed a, Typed b) => Term (Ptr (a,b) -> Ptr b)+snd_ = lam_ snd_get++array :: (Count cnt, Typed a) => Term cnt -> [Term a] -> Term (Array cnt a)+array _ xs = Lift $ do+ p <- eval $ alloca unused+ sequence_ [ eval $ store (idx p (int i)) x | (i,x) <- zip [0 .. ] xs ]+ return $ load p++new_ :: Typed a => Term (a -> Ptr a)+new_ = lam_ new++alloca :: Typed a => Term a -> Term (Ptr a)+alloca (_ :: Term a) = with_local $ \p -> do+ out 2 [ vof p, "= alloca", tof (unused :: V a) ]++alloca'_ :: Typed a => Term (Ptr a)+alloca'_= alloca unused++new :: Typed a => Term a -> Term (Ptr a)+new f = Lift $ do+ p <- eval $ alloca f+ eval_ $ store p f+ return p++lam3_ :: (Typed a, Typed b, Typed c, Typed d) =>+ (Term a -> Term b -> Term c -> Term d) -> Term (a -> b -> c -> d)+lam3_ f = lam_ $ \x -> lam_ $ \y -> lam_ $ \z -> f x y z++lam2_ :: (Typed a, Typed b, Typed c) =>+ (Term a -> Term b -> Term c) -> Term (a -> b -> c)+lam2_ f = lam_ $ \x -> lam_ $ \y -> f x y++app3 :: (Typed a, Typed b, Typed c, Typed d) =>+ Term (a -> b -> c -> d) -> Term a -> Term b -> Term c -> Term d+app3 f a b = app (app2 f a b)++app2 :: (Typed a, Typed b, Typed c) =>+ Term (a -> b -> c) -> Term a -> Term b -> Term c+app2 f = app . app f++arg :: (Typed a, Typed b) => Id -> (Term a -> Term b) -> Term (a -> b)+arg s = Arg ("%" ++ s)++unitarg :: Typed a => Term a -> Term (() -> a)+unitarg x = arg (error "UNITLAM") (\_ -> x)++args :: [(Id,Ty)] -> String+args xs = parens $ commaSep $ map (\(s,t) -> tyof t ++ " " ++ s) $+ filter (not . is_tyunit . snd) xs++parens :: String -> String+parens s = "(" ++ s ++ ")"++argsof :: Typed a => Term a -> [(Id,Ty)]+argsof (x :: Term a) = case x of+ Arg s (f :: Term b -> Term c) ->+ (s, typeof (unused :: b)) : argsof (f (unused :: Term b))+ _ -> [(error "ARGSOF", typeof (unused :: a))]++define :: Typed a => Decl a -> M ()+define (Decl n a) = do+ out 0 ["define", tyof $ snd $ last xs, n ++ args (init xs) ]+ out 2 ["{"]+ loop a+ out 2 ["}"]+ where+ xs = argsof a+ loop :: Typed a => Term a -> M ()+ loop (x :: Term a) = case x of+ Arg s f -> loop (f $ val s)+ _ -> do+ v <- evalv x+ out 2 [ "ret"+ , if is_tyunit (typeof (unused :: a)) then "void" else vtof v+ ]++switch :: (Tagged a cnt, Typed b) =>+ Term a -> [(Term (Tag a cnt), Term a -> Term b)] -> Term b+switch a bs = Lift $ do+ v <- eval a+ tg <- evalv $ tagof v+ ls <- sequence $ replicate (length bs) new_label+ out 2 [ "switch", vtof tg ++ ",", lblof (last ls) ]+ out 4 ["["]+ let zs = zip bs ls+ sequence_+ [ do u <- evalv t+ out 4 [commaSep [vtof u, lblof l]]+ | ((t,_),l) <- init zs+ ]+ out 4 ["]"]+ done <- new_label+ cs <- mapM (eval_alt v done) zs+ lblout done+ return $ phi cs++phi :: Typed a => [(V a, Label)] -> Term a+phi xs = with_local $ \(v :: V a) ->+ when (not $ is_tyunit $ typeof (unused :: a)) $+ out 2 [ vof v, "= phi", tof v, commaSep $ map phi_arg xs ]++phi_arg :: Typed a => (V a, Label) -> String+phi_arg (x,l) = brackets (vof x ++ ", %" ++ l)++brackets :: String -> String+brackets s = "[" ++ s ++ "]"++eval_alt :: (Typed a, Typed b) =>+ Term a -> Label -> ((z, Term a -> Term b), Label) -> M (V b, Label)+eval_alt a done ((_,f),l) = do+ lblout l+ v <- evalv $ f a+ out 2 [ "br", lblof done ]+ m <- gets last_label+ return (v,m)++lblout :: Label -> M ()+lblout l = do+ out 0 [l ++ ":"]+ modify $ \st -> st{ last_label = l }++lblof :: Label -> String+lblof l = "label %" ++ l++from_istring_ :: Term (IString -> CString) -- todo:should return immutable cstring+from_istring_ = lam_ $ \f -> with_local $ \s -> do+ i <- evalv f+ p :: V (Ptr CString) <- new_local+ xs <- gets istrings_tbl+ out 2 [ vof p, "= getelementptr [" ++ show (length xs)+ , " x i8*]* @.istrings, i32 0,", vtof i+ ]+ out 2 [ vof s, "= load", vtof p]++app :: (Typed a, Typed b) => Term (a -> b) -> Term a -> Term b+app = App++evalv :: Term a -> M (V a)+evalv x = case x of+ Arg a _ -> return $ V a+ Val a -> return a+ _ -> reduce x >>= evalv++reduce :: Term a -> M (Term a)+reduce x = case x of+ App f a -> case f of+ Arg _ g -> return $ g a+ Val (V n) -> reduce $ App (callt n []) a+ _ -> reduce f >>= \v -> return (App v a)+ Lift f -> f+ _ -> return x++val :: Typed a => String -> Term a+val = Val . V++is_tyunit :: Ty -> Bool+is_tyunit x = x == TyUnit++tof :: Typed a => V a -> String+tof (_ :: V a) = tyof $ typeof (unused :: a)++proc :: Typed a => Id -> Term a -> Decl a+proc a = Decl ("@" ++ a)++lift :: Typed a => M (Term a) -> Term a+lift = Lift++extern :: Typed a => Id -> Decl a+extern n = Decl ("@" ++ n) unused++gen_files :: FilePath -> M () -> [String] -> IO ()+gen_files fn f ss = evalStateT (f >> gen_istrings fn) (St ss (error "gen_files:outH") "")++gen_file :: FilePath -> M () -> M ()+gen_file fn f = do+ h <- S.lift $ openFile outFn WriteMode+ modify $ \st -> st{ outH = h }+ () <- f+ modify $ \st -> st{ outH = error "outH" }+ S.lift $ hClose h+ where+ outFn = fn ++ ".ll"++gen_istrings :: FilePath -> M ()+gen_istrings fn = gen_file ("istrings_" ++ fn) $ do+ xs <- gets istrings_tbl+ when (not $ null xs) $ do+ let ys = [ ("@.istr" ++ show i, cs, show $ length cs + 1)+ | (i,cs) <- zip [0 :: Int .. ] xs ]+ mapM_ f ys+ out 0 ["@.istrings = global [" ++ show (length ys) ++ " x i8*]"]+ out 2 ["["]+ mapM_ (g ",") (init ys)+ g "" (last ys)+ out 2 ["]"]+ where+ f (i,s,n) =+ out 0 [i, "= private constant [" ++ n ++ " x i8]", const_cstring s ]+ g s (i,_,n) =+ out 2 [ "i8* getelementptr ([" ++ n, "x i8]*"+ , i ++ ", i32 0, i32 0)" ++ s]++string :: String -> Term IString+string s = Lift $ do+ xs <- gets istrings_tbl+ case elemIndex s xs of+ Just i -> return $ tag $ fromIntegral i+ Nothing -> error "STRING"++tyof :: Ty -> String+tyof x = case x of+ TyEnum{} -> "i" ++ show (sizeof x)+ TyUnit -> "void"+ TyPtr a -> tyof a ++ "*"+ TyPair a b -> "{" ++ tyof a ++ ", " ++ tyof b ++ "}"+ TyArray i a -> brackets $ show i ++ " x " ++ tyof a+ TySum xs -> tyof $ ty_sum xs+ TyDouble -> "double"+ TyFloat -> "float"+ TyFun{} -> (tyof $ last xs) ++ parens (commaSep $ map tyof $ init xs) ++ "*"+ where xs = unfold_tyfun x++unfold_tyfun :: Ty -> [Ty]+unfold_tyfun x = case x of+ TyFun a b -> a : unfold_tyfun b+ _ -> [x]++ty_sum :: [Ty] -> Ty+ty_sum xs = TyPair (TyEnum $ genericLength xs) $ max_tysum xs++max_tysum :: [Ty] -> Ty+max_tysum = maximumBy (\a b -> compare (sizeof a) (sizeof b))++sizeofptr :: Integer+sizeofptr = 32 -- fixme:non-portable++idx :: (Count cnt, Typed a) =>+ Term (Ptr (Array cnt a)) -> Term (Idx cnt) -> Term (Ptr a)+idx = flip gep++sizeof :: Ty -> Integer+sizeof x = case x of+ TyEnum i -> bitsToEncode i+ TyUnit -> 0+ TyPtr{} -> sizeofptr+ TyPair a b -> sizeof a + sizeof b+ TyFun{} -> sizeofptr+ TyArray i a -> i * sizeof a+ TySum xs -> sizeof $ ty_sum xs+ TyDouble -> 64+ TyFloat -> 32++char :: Char -> Term Char+char = tag . fromIntegral . ord++eval :: Typed a => Term a -> M (Term a)+eval = liftM Val . evalv++eval_ :: Typed a => Term a -> M ()+eval_ x = eval x >> return ()++lam_ :: (Typed a, Typed b) => (Term a -> Term b) -> Term (a -> b)+lam_ = Arg (error "lam")++with_local :: Typed a => (V a -> M ()) -> Term a+with_local f = Lift $ do+ v <- new_local+ f v+ return $ Val v++vof :: V a -> String+vof (V v) = v++vtof :: Typed a => V a -> String+vtof a = unwords [tof a, vof a]++out :: Int -> [String] -> M ()+out i xs = do+ h <- gets outH+ S.lift $ hPutStrLn h $ replicate i ' ' ++ unwords xs++new_local :: M (V a)+new_local = liftM (V . (++) "%v") $ S.lift freshNm++new_label :: M Label+new_label = liftM ((++) "LBL") $ S.lift freshNm++unit :: Term ()+unit = val $ error "UNIT"++call :: Typed a => Decl a -> Term a+call (Decl n _) = callt n []++declare :: Typed a => Decl a -> M ()+declare (Decl n (_ :: Term a)) =+ out 0 ["declare", tyof $ last xs, n ++ args_ (init xs) ]+ where+ xs = loop (typeof (unused :: a))+ loop t = case t of+ TyFun a b -> [a] ++ loop b+ _ -> [t]++args_ :: [Ty] -> String+args_ xs = parens $ commaSep $ map tyof $ filter (not . is_tyunit) xs++const_cstring :: String -> String+const_cstring s = "c\"" ++ concatMap const_char s ++ "\\00\""++const_char :: Char -> String+const_char c+ | c < ' ' || c > '~' || c == '\\' = encode_char c+ | otherwise = [c]++encode_char :: Enum a => a -> String+encode_char c =+ '\\' : (if i <= 0xf then "0" else "") ++ map toUpper (showHex i "")+ where i = fromEnum c++bitsToEncode :: Integer -> Integer+bitsToEncode 0 = 0+bitsToEncode i = ceiling $ logBase 2 (fromIntegral i :: Double)++freshNm :: IO String+freshNm = liftM (show . hashUnique) newUnique++commaSep :: [String] -> String+commaSep = concat . intersperse ", "++inttag :: (INT a, Typed a, Count cnt) => Integer -> Term (Tag a cnt)+inttag = inttagt unused++inttagt :: (INT a, Typed a, Count cnt) => a -> Integer -> Term (Tag a cnt)+inttagt (_ :: a) i = Lift $ do+ V s :: V a <- evalv (int i)+ return $ val s++chartag :: Char -> Term (Tag Char Cnt256)+chartag = cast . char++stringtag :: String -> Term (Tag IString CntW32)+stringtag = cast . string++defaulttag :: Tagged a cnt => Term (Tag a cnt)+defaulttag = val $ error "DEFAULT"
+ Pec/Makefile view
@@ -0,0 +1,2 @@+clean : + rm -f *~ *.hi *.o
+ README view
@@ -0,0 +1,36 @@+Introducing the pec language and pec embedded compiler. + +The intent of pec is to provide a drop-in replacement for C, but with +modern language features. Pec is a procedural language with a +functional/declarative feel. Programming in pec is very similar to +monadic programming in Haskell. The primary use case for pec is to +provide a productive environment for writing safe, performant embedded +applications. + +Feature list + - Easy C integration + - No garbage collection + - Strong typing with Hindley-Milner type inference + - Safe pointers, no indexing out of bounds + - Variants, vectors, tuples, records, arbitrary sized integers + - User defined, polymorphic data structures + - Parametric polymorphism, ad-hoc polymorphism, laziness (strict by + default), user-defined operators, etc. + - Modules + - Compiles to LLVM (C planned) + - Haskell-ish syntax/layout + - BSD license + +Pec (the language and the compiler) is in the alpha stage of +development. The compiler is implemented in Haskell and has a very +small codebase (thanks to several existing Haskell tools/libraries). + +You can download and install pec via cabal or access the git +repository on github (git@github.com:stevezhee/pec.git). + +Any feedback on the design and/or implementation of pec would be +greatly appreciated :) + +Thanks, +Brett +brettletner at gmail dot com
+ Setup.hs view
@@ -0,0 +1,8 @@+#! /usr/bin/env runhaskell + +-- The pec embedded compiler +-- Copyright 2011, Brett Letner + +import Distribution.Simple + +main = defaultMain
+ THANKS view
@@ -0,0 +1,16 @@+The developement of pec would not have been possible without the following free software: + - ghc http://haskell.org/ghc/ + - llvm http://llvm.org/ + - bnfc http://www.cse.chalmers.se/research/group/Language-technology/BNFC/ + - happy http://haskell.org/happy/ + - alex http://haskell.org/alex/ + - hackage modules http://hackage.haskell.org/packages/hackage.html + +In addition I'd like to thank the following people... + +Sigbjorn Finne, Andy Gill, Iavor Diatchki, Lee Pike, Isaac +Potoczny-Jones, Brian Adams, Travis Rhoades, Mike Letner, Brevin +Letner, and my family + +Thanks guys! +
+ TODO view
@@ -0,0 +1,55 @@+todo +- do language design doc +- do compiler architecture doc +- add qualified names +- make read only pointers +- "Show" instances +- "Eq" instances +- allow operators in export lists +- add import "as" +- add import list(?) +- make the inline Haskell code (i.e. '>') play nice with comments +- implement downward closures(?) +- properly create .ll files (i.e. with declare statements) +- implement puts that doesn't tack on a newline +- haddock'ize modules +- write more example code (project euler or language shootout) +- add -i flag to search other directories +- add c code generation +- report llvm bug +- add state machine optimization(?) +- don't rebuild files that haven't changed (unfortunately the istrings complicate things) +- add warning when _ is used as a name +- add check to ensure that variables are SSA +- add check to prevent recursion + +done +- datatype: string buffer +- datatype: stack +- implement prelude/ other library functions +- generate Counts, etc. in separate files +- get test infrastructure in place +- get coverage infrastructure in place +- make Bool work in case exp (make it constructed like all the rest) +- get arrays working +- add ascription +- fix operator precedence +- add top level type declarations for functions +- make code generation easier to read/debug +- make pretty printer robust +- call external Haskell pretty-printer for generated code +- consider removing module keyword. Decided to keep it. That way we can process streams, not just files. +- add the ability to generate arbitrary sized integers and words (e.g. I16, W64) (add boilerplate generation to pec.hs) +- add exports +- get variants working +- get tuples working +- get records working +- added arithmetic ops +- added bitwise ops +- make top level (non-procedure) values work +- add array initializer that takes a count and a value +- implement function pointers +- take all non-essential things out of Base and put them into pec libraries +- make library implementation easier by integrating haskell code into .pec files +- create separate .ll files and cat them together +- add rebuild all flag
+ pec.cabal view
@@ -0,0 +1,46 @@+Name: pec + +Version: 0.1 + +Synopsis: pec embedded compiler + +Description: The intent of pec is to provide a drop-in replacement for C, but with modern language features. Pec is a procedural language with a functional/declarative feel. Programming in pec is very similar to monadic programming in Haskell. The primary use case for pec is to provide a productive environment for writing safe, performant embedded applications. + +License: BSD3 + +License-file: LICENSE + +Author: Brett Letner <brettletner@gmail.com> + +Maintainer: Brett Letner <brettletner@gmail.com> + +Copyright: Brett letner 2011 + +Category: Language + +Build-type: Simple + +Extra-source-files: Pec.cf + +data-files: Makefile, FAQ, Pec/Makefile, DESIGN, test_cases/Makefile, test_cases/TestStack.pec, test_cases/Prelude.pec, test_cases/TestLoad.pec, test_cases/Stack.pec, test_cases/StrBuf.pec, test_cases/TestPrims.pec, test_cases/TestTuple.pec, test_cases/TestStrBuf.pec, test_cases/TestVariant.pec, test_cases/TestArray.pec, pec.cabal, THANKS, README, TODO, LICENSE, Language/Pec/Doc.html + +Cabal-version: >= 1.6 + +source-repository head + type: git + location: git://github.com/stevezhee/pec.git + +Library + Exposed-modules: Pec.Base + Build-depends: base +-- GHC-Options: -fhpc + +Executable pec + Main-is: Main.hs + + Build-depends: base >= 4 && < 5, derive, array, filepath, cmdargs, mtl, process, directory + + Other-modules: Language.Pec.Lex, Language.Pec.Layout, Language.Pec.ErrM, Language.Pec.Abs, Language.Pec.Par, Language.Pec.Print + +-- Build-tools: happy, alex + -- GHC-Options: -fhpc
+ test_cases/Makefile view
@@ -0,0 +1,16 @@+.SUFFIXES :++all : clean TestStack.exe TestStrBuf.exe TestPrims.exe TestTuple.exe TestVariant.exe TestArray.exe TestLoad.exe # T.exe+ pec+ pec --version+ pec --help++%.exe : %.pec+ pec -k $<+ ./$@++clean :+ rm -f *.bc *.ll *.exe *.s *.out *~ *.tix++vclean : clean+ rm -f Cnt*.hs *.o *.hi *_.hs *_main.hs
+ test_cases/Prelude.pec view
@@ -0,0 +1,287 @@+module Prelude++exports all++where++type W8 = W #256 //singleton "Count" type. In this case, used to specify a word that holds 256 values.+type W16 = W #65536+type I32 = I #4294967296 // 32 bit int++type Bool = | False | True+// enum type+// the "|" is used to specify "or"++type Maybe a = | Nothing | Just a // polymorphic variant+// order doesn't matter+// type Maybe a = | Just a | Nothing would be compiled exactly the same way++type Either a b = | Left a | Right b // polymorphic variant++type Ordering = | LT | EQ | GT // another enum++extern putchar :: Char -> ()+// external C call+// name on the left, type on the right++extern puts :: Ptr Char -> ()+extern exit :: I32 -> ()++to_ordering :: I32 -> Ordering+to_ordering x = branch of+ | x < 0 -> LT+ | x > 0 -> GT+ | -> EQ++putCh :: Char -> ()+putCh c = putchar c++assert :: Bool -> ()+assert x = when (not x)+ (do+ putLn "assertion failed"+ exit -1+ )+// "when" is not a primitive, it is a library function, see "when_" below++not :: Bool -> Bool+not x = if x False True++putLn :: IString -> ()+putLn x = puts (from_istring x)++is_upper :: Char -> Bool+is_upper c = (c >= 'A') && (c <= 'Z') // operators don't have precedence, parens are required++is_lower :: Char -> Bool+is_lower c = (c >= 'a') && (c <= 'z')++is_digit :: Char -> Bool+is_digit c = (c >= '0') && (c <= '9')++to_lower :: Char -> Char+to_lower c = branch of+ | is_upper c -> chr (ord c + 32)+ | -> c++to_upper :: Char -> Char+to_upper c = branch of+ | is_lower c -> chr (ord c - 32)+ | -> c++// inline Haskell "library" DSL code++>import Pec.Base+>import Data.List+>+>type CntW8 = Cnt256+>type W8 = W CntW8+>type Char_ = Char+>type Ptr_ a = Ptr a+>type IString_ = IString+>type W32_ = W32+>type Float_ = Float+>type Double_ = Double+>+>class Typed a => ARITH a where+> add :: Term a -> Term a -> Term a+> sub :: Term a -> Term a -> Term a+> mul :: Term a -> Term a -> Term a+> adiv :: Term a -> Term a -> Term a+> arem :: Term a -> Term a -> Term a+>+>class Typed a => BITS a where+> shl :: Term a -> Term a -> Term a+> shr :: Typed a => Term a -> Term a -> Term a+> band :: Term a -> Term a -> Term a+> bor :: Term a -> Term a -> Term a+> xor :: Term a -> Term a -> Term a+> -- support ashr?+>+>class Typed a => ORD a where+> gt :: Term a -> Term a -> Term Bool_+> ge :: Term a -> Term a -> Term Bool_+> lt :: Term a -> Term a -> Term Bool_+> le :: Term a -> Term a -> Term Bool_+>+>class Typed a => EQ a where+> eq :: Term a -> Term a -> Term Bool_+> eq = prim2 "icmp eq"+> ne :: Term a -> Term a -> Term Bool_+> ne = prim2 "icmp ne"+>+>class (Typed a, Show a) => FRAC a where+> frac :: a -> Term a+> frac = val . show+>+// operators must be defined using the DSL+// The '$' is tacked on by the compiler in order to avoid name clashes.+>(@$) :: Typed a => Term (Ptr a) -> Term a+>(@$) = load+>+>(>$) :: ORD a => Term a -> Term a -> Term Bool_+>(>$) = gt+>+>(>=$) :: ORD a => Term a -> Term a -> Term Bool_+>(>=$) = ge+>+>(<$) :: ORD a => Term a -> Term a -> Term Bool_+>(<$) = lt+>+>(<=$) :: ORD a => Term a -> Term a -> Term Bool_+>(<=$) = le+>+>(+$) :: ARITH a => Term a -> Term a -> Term a+>(+$) = add+>+>(-$) :: ARITH a => Term a -> Term a -> Term a+>(-$) = sub+>+>(*$) :: ARITH a => Term a -> Term a -> Term a+>(*$) = mul+>+>(/$) :: ARITH a => Term a -> Term a -> Term a+>(/$) = adiv+>+>(%$) :: ARITH a => Term a -> Term a -> Term a+>(%$) = arem+>+>(==$) :: EQ a => Term a -> Term a -> Term Bool_+>(==$) = eq+>+>(!=$) :: EQ a => Term a -> Term a -> Term Bool_+>(!=$) = ne+>+>(<<$) :: BITS a => Term a -> Term a -> Term a+>(<<$) = shl+>+>(>>$) :: BITS a => Term a -> Term a -> Term a+>(>>$) = shr+>+>(&$) :: BITS a => Term a -> Term a -> Term a+>(&$) = band+>+>(|$) :: BITS a => Term a -> Term a -> Term a+>(|$) = bor+>+>(^$) :: BITS a => Term a -> Term a -> Term a+>(^$) = xor+>+>(&&$) :: Term Bool_ -> Term Bool_ -> Term Bool_+>(&&$) x y = Lift $ do+> a <- eval x+> b <- eval y+> return $ switch a+> [(false_tag, false_alt (\ _ -> false_))+> ,(defaulttag, \ _ -> b)]+>+>(||$) :: Term Bool_ -> Term Bool_ -> Term Bool_+>(||$) x y = Lift $ do+> a <- eval x+> b <- eval y+> return $ switch a+> [(true_tag, true_alt (\ _ -> true_))+> ,(defaulttag, \ _ -> b)]+>+// ad-hoc polymorphism, using Haskell classes+>instance Count cnt => EQ (I cnt)+>instance Count cnt => EQ (W cnt)+>instance EQ Char+>instance EQ IString+>instance (EQ a, EQ b) => EQ (a,b)+>instance INT Double where int = frac . fromInteger+>instance INT Float where int = frac . fromInteger+>instance FRAC Double+>instance FRAC Float+>+>instance Count cnt => BITS (W cnt) where+> shl = prim2 "shl"+> shr = prim2 "lshr"+> band = prim2 "and"+> bor = prim2 "or"+> xor = prim2 "xor"+>+>instance Count cnt => ORD (W cnt) where+> gt = prim2 "icmp ugt"+> ge = prim2 "icmp uge"+> lt = prim2 "icmp ult"+> le = prim2 "icmp ule"+>+>instance ORD Char where+> gt = prim2 "icmp ugt"+> ge = prim2 "icmp uge"+> lt = prim2 "icmp ult"+> le = prim2 "icmp ule"+>+>instance Count cnt => ORD (I cnt) where+> gt = prim2 "icmp sgt"+> ge = prim2 "icmp sge"+> lt = prim2 "icmp slt"+> le = prim2 "icmp sle"+>+>instance ORD Double where+> gt = prim2 "fcmp ogt"+> ge = prim2 "fcmp oge"+> lt = prim2 "fcmp olt"+> le = prim2 "fcmp ole"+>+>instance ORD Float where+> gt = prim2 "fcmp ogt"+> ge = prim2 "fcmp oge"+> lt = prim2 "fcmp olt"+> le = prim2 "fcmp ole"+>+>instance Count cnt => ARITH (I cnt) where+> add = prim2 "add"+> sub = prim2 "sub"+> mul = prim2 "mul"+> adiv = prim2 "sdiv"+> arem = prim2 "srem"+>+>instance Count cnt => ARITH (W cnt) where+> add = prim2 "add"+> sub = prim2 "sub"+> mul = prim2 "mul"+> adiv = prim2 "udiv"+> arem = prim2 "urem"+>+>instance ARITH Double where+> add = prim2 "fadd"+> sub = prim2 "fsub"+> mul = prim2 "fmul"+> adiv = prim2 "fdiv"+> arem = prim2 "frem"+>+>instance ARITH Float where+> add = prim2 "fadd"+> sub = prim2 "fsub"+> mul = prim2 "fmul"+> adiv = prim2 "fdiv"+> arem = prim2 "frem"+>+>eq_unit = \_ _ -> true_+>ne_unit = \_ _ -> false_+>+>instance EQ () where+> eq = eq_unit+> ne = ne_unit+>+// polymorphic function+// note that the '_' is added to the end of pec names to avoid name clashes+>array_ :: (Count cnt, Typed cnt, Typed a) => Term (cnt -> a -> Array cnt a)+>array_ = lam2_ $ \(cnt :: Term cnt) x -> Lift $ do+> a <- eval x+> return $ array cnt $ genericReplicate (countof (unused :: cnt)) a+>+>ord_ :: Term (Char -> W8)+>ord_ = lam_ cast+>+>chr_ :: Term (W8 -> Char)+>chr_ = lam_ cast+>+>if_ :: Typed a => Term (Bool_ -> a -> a -> a)+>if_ = lam3_ $ \f g h ->+> switch f [(true_tag, \_ -> g), (false_tag, \_ -> h)]+>+>when_ :: Term (Bool_ -> () -> ())+>when_ = lam2_ $ \a b -> app3 if_ a b unit
+ test_cases/Stack.pec view
@@ -0,0 +1,50 @@+module Stack++exports (Stack, stack, push, pop, is_empty, is_full)+// explicit export list++where++import Prelude++type Stck #cnt a = { height :: W32, data :: Array cnt a }+// stacks are polymorphic in their size and what they contain++type Stack #cnt a = Stck cnt a++>type Stack cnt a = Stack_ cnt a+>+>stack_ :: (Count cnt, Typed cnt, Typed a) => Term (cnt -> Stack cnt a)+>stack_ = lam_ $ \_ -> lift $ do+> p <- eval $ alloca unused+> eval_ $ store (height_get p) (int 0)+> return $ load p+>+>push_ :: (Count cnt, Typed cnt, Typed a) =>+> Term (a -> Ptr (Stack cnt a) -> Bool_)+>push_ = lam2_ $ \a (p :: Term (Ptr (Stack cnt a))) ->+> app3 if_ (app is_full_ p)+> false_+> (lift (do i <- eval $ load (height_get p)+> evalv $ store (idx (data_get p) (cast i)) a+> evalv $ store (height_get p) (add i (int 1))+> return true_+> ))+> +>pop_ :: (Count cnt, Typed cnt, Typed a) =>+> Term (Ptr (Stack cnt a) -> Maybe_ a)+>pop_ = lam_ $ \p -> app3 if_ (app is_empty_ p)+> nothing_+> (lift (do i <- eval $ sub (load (height_get p)) (int 1)+> evalv $ store (height_get p) i+> return $ app just_ (load (idx (data_get p) (cast i)))+> ))+>+>is_empty_ :: (Count cnt, Typed cnt, Typed a) =>+> Term (Ptr (Stack cnt a) -> Bool_)+>is_empty_ = lam_ $ \p -> eq (load (height_get p)) (int 0)+>+>is_full_ :: (Count cnt, Typed cnt, Typed a) =>+> Term (Ptr (Stack cnt a) -> Bool_)+>is_full_ = lam_ $ \(p :: Term (Ptr (Stack cnt a))) ->+> eq (load (height_get p)) (int $ countof (unused :: cnt))
+ test_cases/StrBuf.pec view
@@ -0,0 +1,48 @@+module StrBuf exports all++where++import Prelude++type StrBuf #cnt = | StrBuf (Array (SuccCnt cnt) Char)++extern "strcmp" c_strcmp :: Ptr Char -> Ptr Char -> I32+extern "strlen" c_strlen :: Ptr Char -> W32+extern "strncpy" c_strncpy :: Ptr Char -> Ptr Char -> I32 -> Ptr Char+// a different name can be used for the C call if necessary++>type StrBuf a = StrBuf_ a+>+>strbuf_ :: (Count cnt, Typed cnt) => Term (cnt -> StrBuf cnt)+>strbuf_ = lam_ $ \(a :: Term cnt) ->+> cast (app2 array_ (unused :: Term (SuccCnt cnt)) (char '\0'))+>+>from_strbuf_ :: Count cnt => Term (Ptr (StrBuf cnt) -> Ptr Char)+>from_strbuf_ = lam_ bitcast+>+>put_ :: Count cnt => Term (Ptr (StrBuf cnt) -> ())+>put_ = lam_ $ \p -> app puts_ (app from_strbuf_ p)+>+>strlen_ :: Count cnt => Term (Ptr (StrBuf cnt) -> W32)+>strlen_ = lam_ $ \x -> app c_strlen_ (app from_strbuf_ x)+>+>strcmp_ :: (Count a, Count b) =>+> Term (Ptr (StrBuf a) -> Ptr (StrBuf b) -> Ordering_)+>strcmp_ = lam2_ $ \x y ->+> app to_ordering_ (app2 c_strcmp_ (app from_strbuf_ x) (app from_strbuf_ y))+>+>to_strbuf_ :: Count cnt => Term (IString -> Ptr (StrBuf cnt) -> Bool_)+>to_strbuf_ = lam2_ $ \x y -> app2 strncpy (app from_istring_ x) y+>+>strcpy_ :: (Count a, Count b) =>+> Term (Ptr (StrBuf a) -> Ptr (StrBuf b) -> Bool_)+>strcpy_ = lam2_ $ \x y -> app2 strncpy (app from_strbuf_ x) y+>+>strncpy :: Count cnt => Term (Ptr Char -> Ptr (StrBuf cnt) -> Bool_)+>strncpy = lam2_ $ \x (y :: Term (Ptr (StrBuf cnt))) -> Lift $ do+> let n = countof (unused :: cnt)+> evalv $ app3 c_strncpy_ (app from_strbuf_ y) x (int $ succ n)+> c <- eval $ idx (app unwrap_ptr_ y) (int n)+> return $ app3 if_ (load c `eq` char '\0')+> true_+> (lift (eval (store c (char '\0')) >> return false_))
+ test_cases/TestArray.pec view
@@ -0,0 +1,69 @@+module TestArray exports all + +where + +import Prelude + +// fixed sized arrays + +garr = Array [ 'a', 'b', 'c' ] + +main :: () -> W32 +main () = do + testSingleDim () + testMultiDim () + 0 + +testSingleDim () = do + putLn "testSingleDim" + arr = new Array [ 'x', 'y', 'z' ] + assert (@arr[0] == 'x') + putCh @arr[0] // index operator. returns pointer to given index + putCh @arr[1] + putCh @arr[2] +// the index operator is type safe, i.e. putCh @arr[3] will fail to compile. + arr[0] <- 'a' // store an 'a' at element 0 + arr[1] <- 'b' + arr[2] <- 'c' + putCh @arr[0] + putCh @arr[1] + putCh @arr[2] + assert (@arr[0] == 'a') + arr <- Array [ 'x', 'y', 'z' ] + putCh @arr[0] + putCh @arr[1] + putCh @arr[2] + assert (@arr[2] == 'z') + assert (@(new garr)[1] == 'b') + arr2 = new (array #5 'c') + assert (@arr2[4] == 'c') + putCh @arr2[0] + putCh @arr2[4] + putLn "done" + +arrayf :: Ptr (Array #2 Bool) -> () +arrayf arr = do + assert @arr[0] + assert (not @arr[1]) + +testMultiDim () = do + putLn "testMultiDim" + arr = new Array [ Array [ 'a', 'b' ] + , Array [ 'c', 'd' ] + , Array [ 'e', 'f' ] ] + putCh @arr[0][0] + putCh @arr[0][1] + putCh @arr[1][0] + putCh @arr[1][1] + putCh @arr[2][0] + putCh @arr[2][1] + assert True + (a :: Ptr Bool) = new True + assert @a + b = new Array [ True ] + assert @b[0] + x = new Array [ Array [ Array [ True ] ], Array [ Array [ False ] ] ] + assert @x[0][0][0] + assert (not @x[1][0][0]) + () = arrayf (new (Array [ True, False ])) + (putLn "done" :: ())
+ test_cases/TestLoad.pec view
@@ -0,0 +1,13 @@+module TestLoad exports all + +where + +import Prelude + +main :: () -> I32 +main () = do + p = new 'a' + assert (@p == 'a') + putCh @p + putCh '\n' + 0
+ test_cases/TestPrims.pec view
@@ -0,0 +1,260 @@+module TestPrims // module declaration++exports all // export declaration++where++import Prelude // import declaration. pulls in the declarations from Prelude.pec++// single line comment++// some top-level declarations.+// non-function top-level decls are+// simply inlined++gchar :: Char // type signature like in Haskell+gchar = 'a'+ // char literal+ // chars are are char, not ints like in C++gi32 :: I32 // 32 bit integer+gi32 = (3 :: I32) // type ascription+// pec can have arbitrary sized ints and uints, like in llvm++gw16 = (12 :: W16) // 16 bit word (unsigned int)+gw16_2 = gw16 + 1++gbool :: Bool // boolean type+gbool = True+// booleans aren't primitive, they are defined in Prelude.pec++gistring :: IString+gistring = "global istring"+// string literals are IStrings, immutable strings+// comparison is O(1)++gSideEffect :: Bool+gSideEffect = do+ putLn "side effect" // print an IString to the screen+ True+// pec is impure.+// This definition will get inlined++// "do" notation, similar to haskell+// in pec it is syntactic sugar for let [v=e] in r+// where r is the "return" value+// note the 0 at the end++main :: () -> W32+// main has type function of () to W32+// where () is the type 'unit' (similar to void in C)+main () = do // unit pattern match+ putLn "starting test..."+ testChar () // procedure call. calls are made using juxtaposition like in Haskell, not tupling like in C+ testI32 ()+ testW16 ()+ testBool ()+ testIString ()+ testDouble ()+ putLn "...test complete"+ 0++testI32 :: () -> ()+testI32 () = do+ putLn "testI32"+ assert (gi32 == 3) // assert is just a library function+ assert ((0 :: I32) == 0) // type ascription+ putLn "done"++testDouble :: () -> ()+testDouble () = do+ putLn "testDouble"+ assert ((0 :: Double) >= 0)+ assert (((-1) :: Float) >= (-1.0)) // floats aren't working at the moment+// fixme: doesn't work. need ieee754 library or just some prelude functions? assert (((-1) :: Float) >= (-1.1))+ assert (gi32 == 3)+ putLn "done"++testW16 :: () -> ()+testW16 () = do+ putLn "testW16"+ assert ((0 :: W16) == 0)+ x = (4 :: W16) // name binding+// names in pec are single static assignment (SSA)+// i.e. x has a constant value++// case statment, similar to Haskell+// like a more powerful C switch statement+ case x of+ 4 -> assert True // pattern on the left, expression on the right+ _ -> assert False // default++ case (7 :: W16) of // type ascription can be most anywhere+ 4 -> assert False+ 7 -> assert True+ _ -> assert False++ p = new (3 :: W16) // 'new' allocates memory on the stack and stores the given value there. p :: Ptr W16++ case @p of // '@' is the load operator. It returns the value stored at the given location.+ 3 -> assert True+ _ -> assert False++ p <- 12 // '<-' is the store operator. It takes a value and stores it at the given location.++ case @p of+ 3 -> assert False+ x -> assert (x == 12)++ assert (gw16 == 12)+ assert (gw16_2 == 13)+ assert ((1 << 1) == (2 :: W16)) // left shift operator++// branch expression. like switch except each arm has a boolean operator.+// Its purpose in life is to reduce the number of nested ifs.+ branch of+ | @p < 3 -> assert False // boolean expression on the left, value on the right+ | False -> assert False+ | -> assert True // all branch expressions must have a default++ putLn "done"++testBool :: () -> ()+testBool () = do+ putLn "testBool"+ assert True+ assert (not False)+ assert (True == True)+ assert (gbool == True)+ assert gSideEffect // will output to the screen+ assert gSideEffect // will also output to the screen+ x = gSideEffect // will output to the screen+// x is evaluated immediately+ assert x // won't output anything+ assert x // won't output anything+ putLn "done"++testIString :: () -> ()+testIString () = do+ putLn "testIString"+ // IStrings are just represented in a global table,+ // so they can be compared by their index value+ assert ("hi" == "hi")+ assert (gistring == "global istring")+ case "hi" of+ "bye" -> assert False+ "hi" -> assert True+ s -> do // default pattern match, so that we can use the case scrutinee+ putLn s+ assert False+ s = "blah" // at a different scope than the previous "s". This feature might be removed in the future.+ case s of+ "blah" -> assert (s == "blah")+ _ -> assert False+ putLn "done"++type MyChar a = Char // polymorphic type++testChar :: () -> ()+testChar () = do // character literals+ putLn "testChar"+ assert (is_lower 'a')+ assert (is_upper 'A')+ assert (gchar == 'a')+ putCh 't'++ if ('m' == 'm') (putCh 't') (putCh 'f')++ case 'm' of+ 'n' -> putCh 'n'+ 'm' -> putCh 't'+ v -> putCh v+ + case 't' of+ 'm' -> putCh 'm'+ 'n' -> putCh 'n'+ v -> putCh v+ + x = 't'+ putCh x++// "if" function call.+// "if" is not a primitive, it is defined using the "library" DSL, so that it can be polymorphic and lazy+// see "if_" in Prelude.pec++ if (x != 'm') (putCh 't') (putCh 'f')++ case x of+ 'm' -> putCh 'm'+ 'n' -> putCh 'n'+ v -> putCh v+ + p = new 't'+ + putCh @p++ if (@p == 'm')+ (putCh 'f')+ (putCh 't')++ case @p of+ 'm' -> putCh 'm'+ 'n' -> putCh 'n'+ v -> do+ putCh @p+ putCh v+ + p <- 'T'++ putCh @p++ assert (@p == 'T')++ putCh @p+ + p <- x+ + putCh @p+ + p <- @p+ + putCh @p+ + p <- case 'l' of+ 'l' -> 't'+ 'n' -> 'n'+ _ -> 'a'+ + putCh @p+ + p <- getT ()+ + putCh @p++ let c = ('a' :: MyChar W32) in putCh c // let expression++ (v) = 'c' // parens used for grouping+ putCh v+ assert (is_lower v)+ putCh (to_upper v)+ putCh (to_lower (to_upper @p))+ assert (is_upper (to_upper v))+ assert (funptr is_lower 'c') // making a call using a function pointer+ assert (funptr is_upper 'C') // again, but with different arguments+ w = funptr2 to_lower 'A'+ x = funptr2 to_upper 'a'+ putCh w+ putCh x+ assert (is_lower w)+ assert (is_upper x)+ putCh '\n'+ putLn "done"++getT :: () -> Char+getT (()) = 'T'++funptr :: (Char -> Bool) -> Char -> Bool // type of a function that takes a function pointer argument, a character, and returns a bool+funptr f c = f c++funptr2 :: (Char -> Char) -> Char -> Char+funptr2 f c = f c
+ test_cases/TestStack.pec view
@@ -0,0 +1,39 @@+module TestStack exports all++where++// polymorphic Stack implementation++import Prelude+import Stack++main :: () -> W32+main () = do+ putLn "test Stack"+ p = new (stack #3) // stacks must be given a size+ case new (pop p) of+ Nothing -> assert True+ Just _ -> assert False+ assert (push 'a' p)+ case new (pop p) of+ Nothing -> assert False+ Just c -> do+ putCh @c+ assert (@c == 'a')+ assert (is_empty p)+ assert (push 'a' p)+ assert (push 'b' p)+ assert (push 'c' p)+ assert (is_full p)+ assert (not (push 'd' p))+ mc = new (pop p)+ case mc of+ Nothing -> assert False+ Just c -> do+ putCh @c+ assert (@c == 'c')+ mc <- pop p+ mc <- pop p+ assert (is_empty p)+ putLn "done"+ 0
+ test_cases/TestStrBuf.pec view
@@ -0,0 +1,46 @@+module TestStrBuf exports all++where++import Prelude+import StrBuf++// String buffers, like char sbuf[N] in C except we don't have to worry about a missing null terminator++main :: () -> W32+main () = do+ putLn "test StrBuf"+ p = new (strbuf #5) // declaring an empty string buffer requires a singleton "Count" value+ assert (strlen p == 0)+ put p+ assert (to_strbuf "BL" p) // to_strbuf returns True if all the characters were copied+ put p+ assert (strlen p == 2)+ assert (to_strbuf "Brett" p)+ assert (strlen p == 5)+ put p+ assert (not (to_strbuf "Letner" p)) // to_strbuf returns False if not all the characters were able to be copied.+ assert (strlen p == 5)+ put p+ q = new (strbuf #6)+ assert (to_strbuf "Letner" q)+ assert (strlen q == 6)+ put q+ case strcmp p q of+ LT -> assert True+ EQ -> assert False+ GT -> assert False+ assert (to_strbuf "Letne" q)+ puts (from_strbuf p)+ puts (from_strbuf q)+ case strcmp p q of+ EQ -> assert True+ _ -> assert False+ to_strbuf "foo" p+ put p+ put q+ strcpy p q+ put q+ assert (strcmp p q == EQ)+ putLn "done"+ 0
+ test_cases/TestTuple.pec view
@@ -0,0 +1,119 @@+module TestTuple exports all++where++import Prelude++// () is a tuple with no elements.+// it gets compiled as "void" in the LLVM code+main :: () -> W32+main () = do+ testUnit ()+ testPair ()+ testTuple ()+ testRecord ()+ 0++testUnit :: () -> ()+testUnit () = do+ putLn "testUnit"+ putLn "done"++pairf :: Ptr (Char, Bool) -> () // pairf takes a pointer to a tuple containing a Char and a Bool and returns ()+pairf (a,b) = do // tuple pattern match on left hand side+ putCh @a+ assert (@a == 'a')+ assert @b++testPair :: () -> ()+testPair () = do+ p = new ('a',True) // p :: Ptr (Char, Bool)++ (c,b) = p // pattern match. note that c :: Ptr Char and b :: Ptr Bool+ putCh @c+ putCh @p.fst // using record syntax to extract the first element of a pair+// note that it returns a pointer to the element within the record+ putCh @(fst p) // using function syntax for the same thing+ assert @b++ c <- 'b'+ b <- False+ putCh @c+ putCh @p.fst+ putCh @(fst p)+ assert (not @b)++ p.fst <- 'c'+ p.snd <- True+ putCh @c+ putCh @p.fst+ putCh @(fst p)+ assert @p.snd+ assert @b+ pairf (new ('a',True))+ putLn "done"++tuplef :: Ptr (Bool, Char, W32) -> ()+// a triple of Bool, Char, and W32+// n-ary tuples in pec are syntactic sugar for pairs, so+// this is exactly the same as (Bool, (Char, W32))+tuplef p = do+ (x,y,z) = p // sugar for (x,(y,z))+ assert @x+ putCh @y+ assert (@y == 'c')+ assert (@z == 7)++testTuple :: () -> ()+testTuple () = do+ putLn "testTuple"+ t3 = ('c',True,"asdf") // sugar for ('c', (True, "asdf"))+ p = new t3+ putCh @p.fst+ assert @p.snd.fst // record syntax+ putLn @p.snd.snd+ (x,y,z) = p+ putLn @z+ assert @y+ (a,(b,c)) = p+ putLn @c+ assert @b+ tuplef (new (True, 'c', 7))+ putLn "done"++type Person = // the standard record example+ { name :: IString+ , middle_initial :: Char+ , city :: IString+ , zipcode :: W32 }+// order of elements doesn't matter, so this is exactly the same as+// type Person =+// { zipcode :: W32+// , city :: IString+// , middle_initial :: Char+// , name :: IString+// }++type Stuff = { stuff :: Char }++testRecord :: () -> ()+testRecord () = do+ putLn "testRecord"+ x = { stuff = 'a' }+ p = new x+ assert (@p.stuff == 'a')+ putCh @p.stuff+ p.stuff <- 'b'+ assert (@p.stuff == 'b')+ putCh @p.stuff+ y = { name = "Brett", city = "Beverly Hills", zipcode = 90210, middle_initial = 'A' }+// since pec has side effects, record labels are sorted prior to execution.+// having a side effecting function within a record initilization is considered bad form :)++ q = new y+ putLn @q.name+ putLn @q.city+ assert (@q.zipcode == 90210)+ q.city <- "BC"+ assert (@q.city == "BC")+ putLn "done"
+ test_cases/TestVariant.pec view
@@ -0,0 +1,140 @@+module TestVariant exports all++where++import Prelude++main :: () -> W32+main () = do+ testEnum ()+ testNewtype ()+ testNewtypePoly ()+ testVariant ()+ testUnit ()+ 0++type Color = | Red | Blue | Green // the standard enum example++unColor :: Color -> W32+unColor c = case c of+ Red -> 0+ Blue -> 1+ Green -> 2++sColor :: Color -> IString+sColor c = case c of // case on enums is by value+ Red -> "Red"+ Blue -> "Blue"+ Green -> "Green"++type Unit = | Unit // singleton type, isomorphic to ()++unitf :: () -> Unit+unitf () = Unit++unita :: Unit -> ()+unita _ = () // todo(?): unita Unit = ()++testUnit :: () -> ()+testUnit () = do+ putLn "testunit"+ x = Unit // singleton types are compiled into "void" in LLVM+ unita x+ unitf ()+ unita Unit+ putLn "done"++testEnum :: () -> ()+testEnum () = do+ putLn "testEnum"+ assert (Red == Red)+ x = Green // enum types are compiled into unsigned ints in LLVM+ putLn (sColor x)+ assert (Green == x)+ assert (x == Green)+ assert (x != Blue)+ p = new Blue+ assert (@p == Blue)+ putLn (sColor @p)+ p <- Red+ assert (@p != Blue)+ putLn (sColor @p)+ p <- x+ putLn (sColor @p)+ assert (@p == Green)+ assert (unColor @p == 2)+ assert (unColor Blue == 1)+ case Red of+ Green -> assert False+ Red -> assert True+ color -> assert (color != Blue)+ case x of+ Green -> assert True+ Red -> assert False+ Blue -> assert False+ putLn "done"++type Meters = | M W32 // newtype. A variant with only one tag++>instance EQ Meters_ where+> eq = unwrap2 eq+> ne = unwrap2 ne++type MyA a = | My a // polymorphic newtype++testNewtype :: () -> ()+testNewtype () = do+ putLn "testNewtype"+ assert (M 7 == M 7)+// newtypes are constructed by juxtaposition like in Haskell+// newtypes are compiled into whatever the underlying type is in LLVM (i.e. the tag is eliminated)+ x = M 12+ assert (x == M 12)+ p = new (M 7)+ assert (@p != M 12)+ assert (@p == M 7)+ p <- M 47+ assert (@p == M 47)+ assert (47 == unwrap @p) // instead of using "case" to extract values from newtypes, pec provides the polymorphic "unwrap" function+ p <- M 1+ i = unwrap @p+ assert (i == 1)+ putLn "done"++testNewtypePoly :: () -> ()+testNewtypePoly () = do+ putLn "testNewtypePoly"+ x = My 'c'+ p = new x+ assert (unwrap @p == 'c')+ q = new (My True)+ assert (unwrap @q)+ putLn "done"++testVariant :: () -> ()+testVariant () = do+ putLn "testVariant"+ p = new (Left False)+ p <- Right 'c' // p :: Ptr (Either Bool Char)+// variants must be accessed via a pointer+ case p of+ Left a -> do+ assert @a+ Right b -> do // b :: Ptr Char, not Char+ putCh @b+ assert (@b == 'c')+ p <- Left True // store the value "Left True" in p+ case p of+ Left a -> assert @a+ Right b -> do+ putCh @b+ assert False+ q = new Nothing+ case q of+ Nothing -> assert True+ Just _ -> assert False+ q <- Just True+ case q of+ Just b -> assert @b+ _ -> assert False+ putLn "done"