Functions rather than constructors for building operations in Epic.Epic

Atuin/src/MkEpic.lhs

@@ -77,15 +77,15 @@ in SDLprims do this for us.
 > instance Compile Exp where
 >     compile state (Infix op l r) 
 >         = (mkOp op) (compile state l) (compile state r)
->         where mkOp Turtle.Plus = primPlus
->               mkOp Turtle.Minus = primMinus
->               mkOp Turtle.Times = primTimes
->               mkOp Turtle.Divide = primDivide
->               mkOp Turtle.Eq = primEq
->               mkOp Turtle.LT = primLT
->               mkOp Turtle.LE = primLE
->               mkOp Turtle.GT = primGT
->               mkOp Turtle.GE = primGE
+>         where mkOp Plus   = primPlus
+>               mkOp Minus  = primMinus
+>               mkOp Times  = primTimes
+>               mkOp Divide = primDivide
+>               mkOp Eq     = primEq
+>               mkOp Lt     = primLT
+>               mkOp Le     = primLE
+>               mkOp Gt     = primGT
+>               mkOp Ge     = primGE
 >     compile state (Var i) = ref (epicId i)
 >     compile state (Const i) = compile state i
 
@@ -118,8 +118,8 @@ them to the current state and the given argument.
 
 > instance Compile Command where
 >     compile state (Fd i)     = fn "forward" @@ state @@ compile state i
->     compile state (Rt i)     = fn "right"   @@ state @@ compile state i
->     compile state (Lt i)     = fn "left"    @@ state @@ compile state i
+>     compile state (RightT i) = fn "right"   @@ state @@ compile state i
+>     compile state (LeftT i)  = fn "left"    @@ state @@ compile state i
 >     compile state (Colour c) = fn "colour"  @@ state @@ compile state c
 >     compile state PenUp      = fn "pen"     @@ state @@ bool False
 >     compile state PenDown    = fn "pen"     @@ state @@ bool True

Atuin/src/Parser.y

@@ -92,8 +92,8 @@ Turtle : name '(' ExprList ')' { Call $1 $3 }
        | eval Expr { Eval $2 }
        | repeat Expr Block { Repeat $2 $3 }
        | forward Expr { Turtle (Fd $2) }
-       | right Expr { Turtle (Rt $2) }
-       | left Expr { Turtle (Lt $2) }
+       | right Expr { Turtle (RightT $2) }
+       | left Expr { Turtle (LeftT $2) }
        | colour Expr { Turtle (Colour $2) }
        | penup { Turtle PenUp }
        | pendown { Turtle PenDown }
@@ -115,10 +115,10 @@ Expr : name { Var $1 }
      | Expr '*' Expr { Infix Times $1 $3 }
      | Expr '/' Expr { Infix Divide $1 $3 }
      | Expr eq Expr  { Infix Eq $1 $3 }
-     | Expr '<' Expr { Infix Turtle.LT $1 $3 }
-     | Expr '>' Expr { Infix Turtle.GT $1 $3 }
-     | Expr le Expr  { Infix LE $1 $3 }
-     | Expr ge Expr  { Infix GE $1 $3 }
+     | Expr '<' Expr { Infix Lt $1 $3 }
+     | Expr '>' Expr { Infix Gt $1 $3 }
+     | Expr le Expr  { Infix Le $1 $3 }
+     | Expr ge Expr  { Infix Ge $1 $3 }
      | '(' Expr ')'  { $2 }
      | '{' TurtleProg '}' { Block $2 }
 

Atuin/src/SDLprims.lhs

@@ -72,18 +72,18 @@ we stop any other instances for (a -> e) being allowed somehow?
 
 Arithmetic operations
 
-> primPlus x y = mkint $ op_ Plus (getInt x) (getInt y)
-> primMinus x y = mkint $ op_ Minus (getInt x) (getInt y)
-> primTimes x y = mkint $ op_ Times (getInt x) (getInt y)
-> primDivide x y = mkint $ op_ Divide (getInt x) (getInt y)
+> primPlus x y = mkint $ op_ plus_ (getInt x) (getInt y)
+> primMinus x y = mkint $ op_ minus_ (getInt x) (getInt y)
+> primTimes x y = mkint $ op_ times_ (getInt x) (getInt y)
+> primDivide x y = mkint $ op_ divide_ (getInt x) (getInt y)
 
 Comparisons
 
-> primEq x y = mkbool $ op_ OpEQ (getInt x) (getInt y)
-> primLT x y = mkbool $ op_ OpLT (getInt x) (getInt y)
-> primLE x y = mkbool $ op_ OpLE (getInt x) (getInt y)
-> primGT x y = mkbool $ op_ OpGT (getInt x) (getInt y)
-> primGE x y = mkbool $ op_ OpGE (getInt x) (getInt y)
+> primEq x y = mkbool $ op_ eq_ (getInt x) (getInt y)
+> primLT x y = mkbool $ op_ lt_ (getInt x) (getInt y)
+> primLE x y = mkbool $ op_ lte_ (getInt x) (getInt y)
+> primGT x y = mkbool $ op_ gt_ (getInt x) (getInt y)
+> primGE x y = mkbool $ op_ gte_ (getInt x) (getInt y)
 
 Graphics primitive, just extracts the tuple of RGBA values for the colour
 and calls the SDL_gfx primitive.
@@ -105,7 +105,7 @@ Here's some primitives to do the necessary conversions.
 > intToFloat x = foreign_ tyFloat "intToFloat" [(x, tyInt)]
 > floatToInt x = foreign_ tyInt "floatToInt" [(x, tyFloat)]
 
-> rad x = op_ FTimes (intToFloat x) (float (pi/180))
+> rad x = op_ timesF_ (intToFloat x) (float (pi/180))
 
 > esin x = foreign_ tyFloat "sin" [(rad x, tyFloat)]
 > ecos x = foreign_ tyFloat "cos" [(rad x, tyFloat)]
@@ -122,10 +122,10 @@ Return the new state.
 > forward st dist = case_ st 
 >   [tuple (\ (surf :: Expr) (x :: Expr) (y :: Expr) 
 >             (dir :: Expr) (col :: Expr) (pen :: Expr) -> 
->              let_ (op_ Plus x (floatToInt (op_ FTimes (intToFloat (getInt dist))
+>              let_ (op_ plus_ x (floatToInt (op_ timesF_ (intToFloat (getInt dist))
 >                                                        (esin dir))))
->              (\x' -> let_ (op_ Plus y (floatToInt 
->                                            (op_ FTimes (intToFloat (getInt dist))
+>              (\x' -> let_ (op_ plus_ y (floatToInt 
+>                                            (op_ timesF_ (intToFloat (getInt dist))
 >                                                        (ecos dir))))
 >              (\y' -> if_ pen (fn "drawLine" @@ surf @@ x @@ y 
 >                                      @@ x' @@ y' @@ col)
@@ -139,7 +139,7 @@ Return the new state.
 > right st ang = case_ st
 >   [tuple (\ (surf :: Expr) (x :: Expr) (y :: Expr) 
 >             (dir :: Expr) (col :: Expr) (pen :: Expr) -> 
->          (tuple_ @@ surf @@ x @@ y @@ op_ Minus dir (getInt ang) @@ col @@ pen))]
+>          (tuple_ @@ surf @@ x @@ y @@ op_ minus_ dir (getInt ang) @@ col @@ pen))]
 
 To turn left, create a new state with the turtle turned left. 
 Return the new state.
@@ -148,7 +148,7 @@ Return the new state.
 > left st ang = case_ st
 >   [tuple (\ (surf :: Expr) (x :: Expr) (y :: Expr) 
 >             (dir :: Expr) (col :: Expr) (pen :: Expr) -> 
->          (tuple_ @@ surf @@ x @@ y @@ op_ Plus dir (getInt ang) @@ col @@ pen))]
+>          (tuple_ @@ surf @@ x @@ y @@ op_ plus_ dir (getInt ang) @@ col @@ pen))]
 
 > colour :: Expr -> Expr -> Term
 > colour st col' = case_ st
@@ -169,7 +169,7 @@ Repeat n times
 >                 [constcase 0 st,
 >                  defaultcase (let_ (e @@ st)
 >                      (\st' -> fn "repeat" @@ st'
->                                   @@ mkint (op_ Minus (getInt n) (int 1))
+>                                   @@ mkint (op_ minus_ (getInt n) (int 1))
 >                                   @@ e))]
 
 Turtle state consists of an SDL surface,

Atuin/src/Turtle.lhs

@@ -35,13 +35,13 @@
 > type Function = ([Id], Turtle)
 
 > data Op = Plus | Minus | Times  | Divide      -- int ops
->         | Eq   | LT    | LE     | GT     | GE -- bool ops  
+>         | Eq   | Lt    | Le     | Gt     | Ge -- bool ops  
 >         | Car  | Cdr   | Append | Index       -- TODO: string/char ops
 >   deriving Show
 
 > data Command = Fd Exp
->              | Rt Exp
->              | Lt Exp
+>              | RightT Exp
+>              | LeftT Exp
 >              | Colour Exp
 >              | PenUp
 >              | PenDown

Epic/Epic.lhs

@@ -16,14 +16,19 @@
 >                  Expr, Term, Name, name,
 >                  (@@), case_, con_, tuple_, con, tuple,
 >                  constcase, defaultcase,
->                  if_, while_, whileAcc_, error_, op_,
+>                  if_, while_, whileAcc_, error_, 
 >                  lazy_, effect_,
 >                  foreign_, foreignL_, foreignConst_, foreignConstL_,
->                  let_, letN_, update_, Op(..),
+>                  let_, letN_, update_, op_,
 >                  str, int, float, char, bool, unit_, (!.), fn, ref, (+>),
 >                  -- * Types
 >                  Type, tyInt, tyChar, tyBool, tyFloat, tyString,
->                  tyPtr, tyUnit, tyAny, tyC, 
+>                  tyPtr, tyUnit, tyAny, tyC,
+>                  -- * Operators
+>                  plus_, minus_, times_, divide_, 
+>                  plusF_, minusF_, timesF_, divideF_,
+>                  eq_, lt_, lte_, gt_, gte_, 
+>                  eqF_, ltF_, lteF_, gtF_, gteF_, shiftl_, shiftr_,
 >                  -- * Declarations and programs
 >                  EpicDecl(..), Program, 
 >                  -- * Compiling and execution
@@ -101,11 +106,33 @@ Allow Haskell functions to be used to build expressions.
 
 Binary operators
 
-> eq = Op OpEQ
-> lt = Op OpLT
-> lte = Op OpLE
-> gt = Op OpGT
-> gte = Op OpGE
+> plus_, minus_, times_, divide_, plusF_, minusF_, timesF_, divideF_ :: Op
+> lt_, lte_, gt_, gte_, ltF_, lteF_, gtF_, gteF_, shiftl_, shiftr_   :: Op
+
+> plus_   = Plus
+> minus_  = Minus
+> times_  = Times
+> divide_ = Divide
+
+> plusF_   = FPlus
+> minusF_  = FMinus
+> timesF_  = FTimes
+> divideF_ = FDivide
+
+> eq_  = OpEQ
+> lt_  = OpLT
+> lte_ = OpLE
+> gt_  = OpGT
+> gte_ = OpGE
+
+> eqF_  = OpFEQ
+> ltF_  = OpFLT
+> lteF_ = OpFLE
+> gtF_  = OpFGT
+> gteF_ = OpFGE
+
+> shiftl_ = ShL
+> shiftr_ = ShR
 
 > mkFunc :: EpicFn e => e -> Func
 > mkFunc e = evalState (func e) 0

FL/src/Lang.lhs

@@ -14,8 +14,8 @@
 > data Const = CInt Int
 >            | CStr String
 
-> data Infix = IPlus | IMinus | ITimes | IDivide | IAppend
->            | IEQ | ILT | IGT
+> data Infix = Plus  | Minus | Times | Divide | Append
+>            | Equal | Lt    | Gt
 
 > data Def = LangDef Lang
 >          | PrimDef EpicDecl
@@ -29,15 +29,15 @@
 > build (App f a) = build f @@ build a
 > build (Const (CInt x)) = int x
 > build (Const (CStr x)) = str x
-> build (Op IAppend l r) = fn "append" @@ build l @@ build r
+> build (Op Append l r) = fn "append" @@ build l @@ build r
 > build (Op op l r) = op_ (buildOp op) (build l) (build r)
->  where buildOp IPlus = Plus
->        buildOp IMinus = Minus
->        buildOp ITimes = Times
->        buildOp IDivide = Divide
->        buildOp IEQ = OpEQ
->        buildOp ILT = OpLT
->        buildOp IGT = OpGT
+>  where buildOp Plus   = plus_
+>        buildOp Minus  = minus_
+>        buildOp Times  = times_
+>        buildOp Divide = divide_
+>        buildOp Equal  = eq_
+>        buildOp Lt     = lt_
+>        buildOp Gt     = gt_
 
 > mkEpic :: Def -> EpicDecl
 > mkEpic (PrimDef p) = p

FL/src/Main.lhs

@@ -6,7 +6,7 @@
 > import Epic.Epic
 
 > add :: Lang
-> add = Lam (\x -> Lam (\y -> Op IPlus x y))
+> add = Lam (\x -> Lam (\y -> Op Plus x y))
 
 > main_ = App (Ref (name "putStrLn"))
 >             (App (Ref (name "intToString"))

Papers/Epic/epic.tex

@@ -50,7 +50,7 @@
 
 \begin{document}
 
-\title{Epic --- a Generic Back End for Functional Programming Languages}
+\title{Epic --- a Generic Intermediate Functional Programming Language}
 %\author{Edwin Brady}
 
 \authorinfo{Edwin C. Brady}

Papers/Epic/intro.tex

@@ -1,19 +1,25 @@
 \section{Introduction}
 
+[Just some notes for now...]
+
 Lots of backends for functional languages,
 e.g. STG~\cite{evalpush,stg,llvm-haskell}, ABC~\cite{abc-machine}.
 But they aren't simple enough that they are easy to bolt on to a new
 language. Either too low level, or an interface isn't exposed, or
 where an interface is exposed, there are constraints on the type
 system. So things like Agda~\cite{norell-thesis} have resorted to
-generating Haskell with unsafeCoerce. This works but we can't expect
+generating Haskell with unsafeCoerce, Cayenne~\cite{cayenne-icfp} used LML
+with the type checker switched off. This works but we can't expect
 GHC optimisations without working very hard, are limited to GHC's
 choice of evaluation order, and could throw away useful information
 gained from the type system.
 
-Epic originally written for Epigram~\cite{levitation} (the name is
+Epic originally written for Epigram~\cite{levitation} (the
+name\footnote{Coined by James McKinna} is
 short for ``\textbf{Epi}gram \textbf{C}ompiler''). Now used by
 Idris~\cite{idris-plpv}, also as an experimental back end for Agda.
+It is specifically designed for reuse by other languages (in constrast
+to, say, Haskell Core).
 
 \subsection{Features and non-features}
 
@@ -43,3 +49,39 @@ \subsection{Features and non-features}
 
 Also lacking, but entirely possible to add later (with some care) are
 unboxed types.
+
+\subsection{Why an Intermediate Language}
+
+Why not generate Haskell, OCaml, Scheme, \ldots? In general they are
+too high level and impose design choices and prevent certain
+implementation choices. An intermediate level language such as Epic
+allows the following:
+
+\begin{description}
+\item[Control of generated code]
+A higher level target language imposes implementation choices such as
+evaluation strategy and purity. Also makes it harder to use lower
+level features where it might be appropriate (e.g. while loops, mutation).
+
+\item[Control of language design]
+Choice of a high level target language (especially a typed one) might
+influence our type system design, restrict our choices for ease of
+code generation. 
+
+\item[Efficiency]
+We might expect using a mature target language to give us
+optimisations for free. This might be true in many cases, but only if
+our source language is similar enough. e.g. in Epigram the type system
+tells us more about the code than we can pass on to a Haskell back
+end. 
+
+\end{description}
+
+Epic aims to provide the necessary features for implementing the
+back-end of a functional language --- thunks, closures, algebraic data
+types, scope management, lambda lifting --- without imposing
+\remph{any} design choices on the high level language designer, with
+the obvious exception that a functional style is encouraged!
+A further advantage of Epic is that the library provides
+\remph{compiler combinators}, which guarantee that any
+output code will be syntactically correct and well-scoped.