Cabalized

goldfirere · May 12, 2015 · 739e7b0 · 739e7b0
1 parent aebc3cf
commit 739e7b0
Show file tree

Hide file tree

Showing 19 changed files with 200 additions and 92 deletions.
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1 @@
+dist
diff --git a/LICENSE b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2015, Richard Eisenberg
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.
+
+2. 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.
+
+3. Neither the name of the author nor the names of its 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 HOLDER 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.
diff --git a/Language/Glambda/Check.hs b/Language/Glambda/Check.hs
@@ -21,14 +21,9 @@ import Language.Glambda.Type
 import Language.Glambda.Unchecked
 import Language.Glambda.Util
 import Language.Glambda.Globals
-import Language.Glambda.Monad
 
 import Text.PrettyPrint.ANSI.Leijen
 
-import Control.Applicative
-import Control.Error
-import Control.Monad
-import Control.Monad.Trans
 import Control.Monad.Error
 import Control.Monad.Reader
 import Data.Type.Equality

diff --git a/Language/Glambda/Exp.hs b/Language/Glambda/Exp.hs
@@ -81,18 +81,18 @@ eqExp _ _ = False
 -- Pretty-printing
 
 instance PrettyExp (Exp ctx ty) where
-  prettyPrec = pretty_exp
+  prettyExp = pretty_exp
 
 instance PrettyExp (Val ctx ty) where
-  prettyPrec prec v = prettyPrec prec (val v)
+  prettyExp coloring prec v = prettyExp coloring prec (val v)
 
-pretty_exp :: Prec -> Exp ctx ty -> Doc
-pretty_exp _    (Var n)                     = char '#' <> int (elemToInt n)
-pretty_exp prec (Lam (body :: Exp (arg ': rest) ty))
-  = prettyLam prec (unrefineTy (sty :: STy arg)) body
-pretty_exp prec (App e1 e2)                 = prettyApp prec e1 e2
-pretty_exp prec (Arith e1 op e2)            = prettyArith prec e1 op e2
-pretty_exp prec (Cond e1 e2 e3)             = prettyIf prec e1 e2 e3
-pretty_exp _    (IntE n)                    = integer n
-pretty_exp _    (BoolE True)                = text "true"
-pretty_exp _    (BoolE False)               = text "false"
+pretty_exp :: Coloring -> Prec -> Exp ctx ty -> Doc
+pretty_exp c _    (Var n)                     = prettyVar c (elemToInt n)
+pretty_exp c prec (Lam (body :: Exp (arg ': rest) ty))
+  = prettyLam c prec (unrefineTy (sty :: STy arg)) body
+pretty_exp c prec (App e1 e2)                 = prettyApp c prec e1 e2
+pretty_exp c prec (Arith e1 op e2)            = prettyArith c prec e1 op e2
+pretty_exp c prec (Cond e1 e2 e3)             = prettyIf c prec e1 e2 e3
+pretty_exp _ _    (IntE n)                    = integer n
+pretty_exp _ _    (BoolE True)                = text "true"
+pretty_exp _ _    (BoolE False)               = text "false"
diff --git a/Language/Glambda/Globals.hs b/Language/Glambda/Globals.hs
@@ -18,7 +18,6 @@ module Language.Glambda.Globals (
 import Language.Glambda.Exp
 import Language.Glambda.Type
 
-import Control.Error
 import Control.Monad.Error
 
 import Text.PrettyPrint.ANSI.Leijen

diff --git a/Language/Glambda/Lex.hs b/Language/Glambda/Lex.hs
@@ -17,28 +17,20 @@ module Language.Glambda.Lex ( lexG, lex ) where
 import Prelude hiding ( lex )
 
 import Language.Glambda.Token
-import Language.Glambda.Util
 import Language.Glambda.Monad
 
-import Text.Parsec.Token
-import Text.Parsec.Language
-import Text.Parsec.Pos
-import Text.Parsec.Prim  ( Parsec, parse, getPosition )
-import Text.Parsec.Error
+import Text.Parsec.Prim  ( Parsec, parse, getPosition, try )
+import Text.Parsec.Combinator
 
 import Text.Parser.Char
-import Text.Parser.Combinators
 import Text.Parser.Token as Parser hiding ( symbolic )
 
-import Control.Error
-
 import Data.Functor
-import Data.Functor.Identity
 import Data.Text
+import Data.Maybe
 
 import Control.Applicative
 import Control.Arrow as Arrow
-import Data.Maybe
 
 type Lexer = Parsec Text ()
 

diff --git a/Language/Glambda/Parse.hs b/Language/Glambda/Parse.hs
@@ -24,16 +24,12 @@ import Language.Glambda.Type
 import Language.Glambda.Monad
 import Language.Glambda.Util
 
-import Text.Parsec.Prim as Parsec   ( runParserT, ParsecT, tokenPrim )
-import Text.Parsec.Error            ( ParseError )
+import Text.Parsec.Prim as Parsec hiding ( parse )
 import Text.Parsec.Pos
-
-import Text.Parser.Combinators as Parser
+import Text.Parsec.Combinator
 
 import Text.PrettyPrint.ANSI.Leijen hiding ( (<$>) )
 
-import Control.Error
-
 import Data.List as List
 import Data.Text as Text
 

diff --git a/Language/Glambda/Pretty.hs b/Language/Glambda/Pretty.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE ViewPatterns, GADTs, FlexibleInstances, UndecidableInstances,
              OverlappingInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -15,14 +16,17 @@
 ----------------------------------------------------------------------------
 
 module Language.Glambda.Pretty (
-  PrettyExp(..), prettyLam, prettyApp, prettyArith, prettyIf
+  PrettyExp(..), Coloring, defaultColoring,
+  prettyVar, prettyLam, prettyApp, prettyArith, prettyIf
   ) where
 
 import Language.Glambda.Token
 import Language.Glambda.Type
 import Language.Glambda.Util
 
 import Text.PrettyPrint.ANSI.Leijen
+import Data.Stream
+import Data.List as List
 
 lamPrec, appPrec, appLeftPrec, appRightPrec, ifPrec :: Prec
 lamPrec = 1
@@ -49,39 +53,62 @@ precInfo Greater  = (4, 4, 4)
 precInfo GreaterE = (4, 4, 4)
 precInfo Equals   = (4, 4, 4)
 
+-- | A function that changes a 'Doc's color
+type ApplyColor = Doc -> Doc
+
+data Coloring = Coloring (Stream ApplyColor)
+                            -- ^ a stream of remaining colors to use
+                         [ApplyColor]  -- ^ the colors used for bound variables
+
+-- | A 'Coloring' for an empty context
+defaultColoring :: Coloring
+defaultColoring = Coloring all_colors []
+  where
+    all_colors = red <:> green <:> yellow <:> blue <:>
+                 magenta <:> cyan <:> all_colors
+
+-- | A class for expressions that can be pretty-printed
 class Pretty exp => PrettyExp exp where
-  prettyPrec :: Prec -> exp -> Doc
+  prettyExp :: Coloring -> Prec -> exp -> Doc
 
 instance PrettyExp exp => Pretty exp where
-  pretty = prettyPrec topPrec
+  pretty = prettyExp defaultColoring topPrec
+
+-- | Print a variable
+prettyVar :: Coloring -> Int -> Doc
+prettyVar (Coloring _ bound) n = (bound List.!! n) (char '#' <> int n)
 
 -- | Print a lambda expression
-prettyLam :: PrettyExp exp => Prec -> Ty -> exp -> Doc
-prettyLam prec ty body
+prettyLam :: PrettyExp exp => Coloring -> Prec -> Ty -> exp -> Doc
+prettyLam (Coloring (next `Cons` supply) existing) prec ty body
   = maybeParens (prec >= lamPrec) $
     char 'λ' <>
-    char '#' <> text ":" <> pretty ty <>
-    char '.' <+> prettyPrec topPrec body
+    next (char '#') <> text ":" <> pretty ty <>
+    char '.' <+> prettyExp (Coloring supply (next : existing)) topPrec body
 
 -- | Print an application
 prettyApp :: (PrettyExp exp1, PrettyExp exp2)
-          => Prec -> exp1 -> exp2 -> Doc
-prettyApp prec e1 e2
+          => Coloring -> Prec -> exp1 -> exp2 -> Doc
+prettyApp coloring prec e1 e2
   = maybeParens (prec >= appPrec) $
-    prettyPrec appLeftPrec  e1 <+>
-    prettyPrec appRightPrec e2
+    prettyExp coloring appLeftPrec  e1 <+>
+    prettyExp coloring appRightPrec e2
 
 prettyArith :: (PrettyExp exp1, PrettyExp exp2)
-            => Prec -> exp1 -> ArithOp ty -> exp2 -> Doc
-prettyArith prec e1 op e2
+            => Coloring -> Prec -> exp1 -> ArithOp ty -> exp2 -> Doc
+prettyArith coloring prec e1 op e2
   = maybeParens (prec >= opPrec op) $
-    prettyPrec (opLeftPrec op) e1 <+>
+    prettyExp coloring (opLeftPrec op) e1 <+>
     pretty op <+>
-    prettyPrec (opRightPrec op) e2
+    prettyExp coloring (opRightPrec op) e2
 
 prettyIf :: (PrettyExp exp1, PrettyExp exp2, PrettyExp exp3)
-         => Prec -> exp1 -> exp2 -> exp3 -> Doc
-prettyIf prec e1 e2 e3
+         => Coloring -> Prec -> exp1 -> exp2 -> exp3 -> Doc
+prettyIf coloring prec e1 e2 e3
   = maybeParens (prec >= ifPrec) $
-    hsep [ text "if", pretty e1, text "then"
-         , pretty e2, text "else", pretty e3 ]
+    hsep [ text "if"
+         , prettyExp coloring topPrec e1
+         , text "then"
+         , prettyExp coloring topPrec e2
+         , text "else"
+         , prettyExp coloring topPrec e3 ]
diff --git a/Language/Glambda/Repl.hs b/Language/Glambda/Repl.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleInstances,
+{-# LANGUAGE OverloadedStrings, FlexibleInstances,
              UndecidableInstances, OverlappingInstances #-}
 
 -----------------------------------------------------------------------------
@@ -32,11 +32,8 @@ import Text.PrettyPrint.ANSI.Leijen as Pretty hiding ( (<$>) )
 import System.Console.Haskeline
 
 import Data.Text
-import Language.Haskell.TH.Syntax as TH hiding ( report )
 import Control.Applicative
 import Control.Monad
-import Control.Error
-import Control.Monad.Error
 import Control.Monad.Reader
 import Data.Char
 import Data.List as List
@@ -99,10 +96,7 @@ lambda
 
 -- | The current version of glambda
 version :: String
-version = $( do Loc { loc_package = pkg_string } <- location
-                TH.lift $ case List.stripPrefix "glambda-" pkg_string of
-                  Just ver -> ver
-                  Nothing  -> "?" )
+version = "1.0"
 
 -------------------------------------------
 -- commands

diff --git a/Language/Glambda/Unchecked.hs b/Language/Glambda/Unchecked.hs
@@ -32,15 +32,15 @@ data UExp
   | UBoolE Bool
 
 instance PrettyExp UExp where
-  prettyPrec = pretty_exp
+  prettyExp = pretty_exp
 
-pretty_exp :: Prec -> UExp -> Doc
-pretty_exp _    (UVar n)                     = char '#' <> int n
-pretty_exp _    (UGlobal n)                  = text (unpack n)
-pretty_exp prec (ULam ty body)               = prettyLam prec ty body
-pretty_exp prec (UApp e1 e2)                 = prettyApp prec e1 e2
-pretty_exp prec (UArith e1 (UArithOp op) e2) = prettyArith prec e1 op e2
-pretty_exp prec (UCond e1 e2 e3)             = prettyIf prec e1 e2 e3
-pretty_exp _    (UIntE n)                    = integer n
-pretty_exp _    (UBoolE True)                = text "true"
-pretty_exp _    (UBoolE False)               = text "false"
+pretty_exp :: Coloring -> Prec -> UExp -> Doc
+pretty_exp c _    (UVar n)                     = prettyVar c n
+pretty_exp _ _    (UGlobal n)                  = text (unpack n)
+pretty_exp c prec (ULam ty body)               = prettyLam c prec ty body
+pretty_exp c prec (UApp e1 e2)                 = prettyApp c prec e1 e2
+pretty_exp c prec (UArith e1 (UArithOp op) e2) = prettyArith c prec e1 op e2
+pretty_exp c prec (UCond e1 e2 e3)             = prettyIf c prec e1 e2 e3
+pretty_exp _ _    (UIntE n)                    = integer n
+pretty_exp _ _    (UBoolE True)                = text "true"
+pretty_exp _ _    (UBoolE False)               = text "false"
diff --git a/Language/Glambda/Util.hs b/Language/Glambda/Util.hs
@@ -21,7 +21,6 @@ module Language.Glambda.Util (
 import Text.Parsec
 import Text.PrettyPrint.ANSI.Leijen as Pretty
 
-import Control.Applicative
 import Control.Monad
 
 instance Pretty ParseError where

diff --git a/Setup.hs b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/glambda.cabal b/glambda.cabal
@@ -0,0 +1,82 @@
+name:           glambda
+version:        1.0
+cabal-version:  >= 1.10
+synopsis:       A simply typed lambda calculus interpreter, written with GADTs
+homepage:       https://github.com/goldfirere/glambda
+category:       Compilers/Interpreters
+author:         Richard Eisenberg <[email protected]>
+maintainer:     Richard Eisenberg <[email protected]>
+bug-reports:    https://github.com/goldfirere/glambda/issues
+stability:      unknown
+extra-source-files: README.md, CHANGES.md
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+description:
+    This is an interpreter for the simply-typed lambda calculus. It is
+    written making heavy use of generalized algebraic datatypes (GADTs), and is
+    meant to serve as an example how how these GADTs can be useful. See
+    the GitHub repo for more information about the syntax for the language
+    and interpreter commands.
+
+source-repository this
+  type:     git
+  location: https://github.com/goldfirere/glambda.git
+  tag:      v1.0
+
+library
+  build-depends:      base == 4.*
+                    , ansi-wl-pprint >= 0.6.7.1
+                    , errors >= 1.4.6
+                    , mtl >= 2.1.3.1
+                    , containers >= 0.5
+                    , text >= 1.1
+                    , parsec >= 3.1
+                    , haskeline >= 0.7.1.1
+                    , Stream >= 0.4.7.1
+                    , parsers >= 0.12
+
+
+  exposed-modules:    Language.Glambda.Check
+                      Language.Glambda.Eval
+                      Language.Glambda.Exp
+                      Language.Glambda.Globals
+                      Language.Glambda.Lex
+                      Language.Glambda.Monad
+                      Language.Glambda.Parse
+                      Language.Glambda.Pretty
+                      Language.Glambda.Repl
+                      Language.Glambda.Statement
+                      Language.Glambda.Token
+                      Language.Glambda.Type
+                      Language.Glambda.Unchecked
+                      Language.Glambda.Util
+
+  ghc-options:        -Wall -fno-warn-name-shadowing
+  default-language:   Haskell2010
+
+executable glam
+  build-depends:      base == 4.*
+                    , glambda
+
+  hs-source-dirs:     main
+  ghc-options:        -Wall -fno-warn-name-shadowing
+  default-language:   Haskell2010
+  main-is:            Main.hs
+
+test-suite tests
+  type:               exitcode-stdio-1.0
+  hs-source-dirs:     testing
+  ghc-options:        -Wall -fno-warn-name-shadowing -main-is Tests.Main
+  default-language:   Haskell2010
+  main-is:            Tests/Main.hs
+
+  build-depends:      base == 4.*
+                    , glambda
+                    , ansi-wl-pprint >= 0.6.7.1
+                    , errors >= 1.4.6
+                    , mtl >= 2.1.3.1
+                    , text >= 1.1
+                    , parsec >= 3.1
+                    , tasty >= 0.10
+                    , tasty-hunit >= 0.9
diff --git a/main/Main.hs b/main/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import qualified Language.Glambda.Repl as Repl ( main )
+
+main :: IO ()
+main = Repl.main