diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -1,4 +1,10 @@ #! /usr/bin/env runhaskell -> import Distribution.Simple -> main = defaultMain +> import Distribution.Simple (defaultMainWithHooks) +> import Distribution.Simple.UUAGC (uuagcLibUserHook) +> import UU.UUAGC (uuagc) +> +> main :: IO () +> main = defaultMainWithHooks $ +> uuagcLibUserHook uuagc +> diff --git a/src/CCO/Arith.hs b/src/CCO/Arith.hs new file mode 100644 --- /dev/null +++ b/src/CCO/Arith.hs @@ -0,0 +1,30 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.Arith +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- Simple arithmetic expressions. +-- +------------------------------------------------------------------------------- + +module CCO.Arith ( + -- * Syntax + Num_ -- = Int + , Tm (Tm) -- instances: Tree + , Tm_ (Num, Add, Sub, Mul, Div) -- instances: Tree + + -- * Parser + , parser -- :: Component String Tm + + -- * Evaluation + , Val (VNum) -- instances: Tree, Printable + , eval -- :: Tm -> Feedback Val +) where + +import CCO.Arith.Base (Num_, Tm (Tm), Tm_ (..), Val (VNum), eval) +import CCO.Arith.Parser (parser) diff --git a/src/CCO/Arith/AG.ag b/src/CCO/Arith/AG.ag new file mode 100644 --- /dev/null +++ b/src/CCO/Arith/AG.ag @@ -0,0 +1,20 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.Arith.AG +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- Attribute grammar for simple arithmetic expressions. +-- +------------------------------------------------------------------------------- + +module {CCO.Arith.AG} {} {} + +include "AG/Base.ag" +include "AG/Evaluation.ag" +include "AG/Pos.ag" +include "AG/Printing.ag" diff --git a/src/CCO/Arith/AG/Base.ag b/src/CCO/Arith/AG/Base.ag new file mode 100644 --- /dev/null +++ b/src/CCO/Arith/AG/Base.ag @@ -0,0 +1,23 @@ +imports +{ +import CCO.SourcePos (SourcePos) +} + +------------------------------------------------------------------------------- +-- Syntax +------------------------------------------------------------------------------- + +{ +-- | Type of numerals. +type Num_ = Int +} + +data Tm + | Tm pos :: {SourcePos} t :: Tm_ + +data Tm_ + | Num n :: {Num_} + | Add t1 :: Tm t2 :: Tm + | Sub t1 :: Tm t2 :: Tm + | Mul t1 :: Tm t2 :: Tm + | Div t1 :: Tm t2 :: Tm diff --git a/src/CCO/Arith/AG/Evaluation.ag b/src/CCO/Arith/AG/Evaluation.ag new file mode 100644 --- /dev/null +++ b/src/CCO/Arith/AG/Evaluation.ag @@ -0,0 +1,61 @@ +imports +{ +import CCO.Feedback (Feedback, errorMessage) +import CCO.Printing (wrapped, showable, Printable (pp)) +import CCO.SourcePos (Source (..), Pos (..), SourcePos (..)) +import CCO.Tree (ATerm (App), Tree (fromTree, toTree)) +import CCO.Tree.Parser (parseTree, app, arg) +import Control.Applicative ((<$>)) +import Control.Monad (when) +} + +------------------------------------------------------------------------------- +-- Syntax +------------------------------------------------------------------------------- + +{ +-- | Type of values. +data Val = VNum Num_ -- ^ Numeral. + +instance Tree Val where + fromTree (VNum n) = App "Num" [fromTree n] + toTree = parseTree [app "Num" (VNum <$> arg)] + +instance Printable Val where + pp (VNum n) = showable n +} + +------------------------------------------------------------------------------- +-- Evaluation +------------------------------------------------------------------------------- + +attr Tm Tm_ + syn val :: {Feedback Val} + +sem Tm_ + | Num lhs.val = return (VNum @n) + | Add lhs.val = do VNum n1 <- @t1.val + VNum n2 <- @t2.val + return (VNum (n1 + n2)) + | Sub lhs.val = do VNum n1 <- @t1.val + VNum n2 <- @t2.val + return (VNum (if n2 > n1 then 0 else (n1 - n2))) + | Mul lhs.val = do VNum n1 <- @t1.val + VNum n2 <- @t2.val + return (VNum (n1 * n2)) + | Div lhs.val = do VNum n1 <- @t1.val + VNum n2 <- @t2.val + when (n2 == 0) (errDivByZero @lhs.pos) + return (VNum (n1 `div` n2)) + +------------------------------------------------------------------------------- +-- Run-time errors +------------------------------------------------------------------------------- + +{ +-- | Produces a division-by-zero error. +errDivByZero :: SourcePos -> Feedback () +errDivByZero pos = + errorMessage . wrapped $ + describeSourcePos pos ++ ": Run-time error: division by zero." +} diff --git a/src/CCO/Arith/AG/Pos.ag b/src/CCO/Arith/AG/Pos.ag new file mode 100644 --- /dev/null +++ b/src/CCO/Arith/AG/Pos.ag @@ -0,0 +1,32 @@ +imports +{ +import CCO.SourcePos (SourcePos) +} + +------------------------------------------------------------------------------- +-- Source positions +------------------------------------------------------------------------------- + +attr Tm_ + inh pos :: {SourcePos} + +sem Tm + | Tm t.pos = @pos + +------------------------------------------------------------------------------- +-- Utilities +------------------------------------------------------------------------------- + +{ +-- | Retrieves a textual description of a 'SourcePos'. +describeSourcePos :: SourcePos -> String +describeSourcePos (SourcePos (File file) (Pos ln col)) + = file ++ + ":line " ++ show ln ++ + ":column " ++ show col +describeSourcePos (SourcePos (File file) EOF) = file ++ + ":" +describeSourcePos (SourcePos Stdin (Pos ln col)) = "line " ++ show ln ++ + ":column " ++ show col +describeSourcePos (SourcePos Stdin EOF) = "" +} diff --git a/src/CCO/Arith/AG/Printing.ag b/src/CCO/Arith/AG/Printing.ag new file mode 100644 --- /dev/null +++ b/src/CCO/Arith/AG/Printing.ag @@ -0,0 +1,51 @@ +imports +{ +import CCO.Printing +} + +------------------------------------------------------------------------------- +-- Pretty printing +------------------------------------------------------------------------------- + +attr Tm Tm_ + syn pp :: Doc + +sem Tm_ + | Num lhs.pp = showable @n + | Add lhs.pp = ppInfix @lhs.prec ("+", 6) @t1.pp @t2.pp + | Sub lhs.pp = ppInfix @lhs.prec ("-", 6) @t1.pp @t2.pp + | Mul lhs.pp = ppInfix @lhs.prec ("*", 7) @t1.pp @t2.pp + | Div lhs.pp = ppInfix @lhs.prec ("/", 7) @t1.pp @t2.pp + +------------------------------------------------------------------------------- +-- Precedence levels +------------------------------------------------------------------------------- + +{ +-- | Type of precedence levels. +type Prec = Int +} + +attr Tm Tm_ + inh prec :: Int + +sem Tm_ + | Add Sub t1.prec = 6 + t2.prec = 7 + | Mul Div t1.prec = 7 + t2.prec = 8 + +{ +-- | Pretty prints, given the precedence level of its immediate context, a term +-- constructed from a binary operator of a specified precedence level. +-- +-- A term is enclosed in parentheses if the precedence level of its operator +-- is less than the precedence level of the enclosing context. + +ppInfix :: Prec -> (String, Prec) -> Doc -> Doc -> Doc +ppInfix ctx (op, prec) l r = modifier $ + l >#< ppOp >#< r + where + modifier = if prec < ctx then parens else id + ppOp = text op +} diff --git a/src/CCO/Arith/Base.hs b/src/CCO/Arith/Base.hs new file mode 100644 --- /dev/null +++ b/src/CCO/Arith/Base.hs @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.Arith.Base +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- Simple arithmetic expressions. +-- +------------------------------------------------------------------------------- + +module CCO.Arith.Base ( + -- * Syntax + Num_ -- = Int + , Tm (Tm) -- instances: Tree + , Tm_ (Num, Add, Sub, Mul, Div) -- instances: Tree + + -- * Evaluation + , Val (VNum) -- instances: Tree, Printable + , eval -- :: Tm -> Feedback Val +) where + +import CCO.Arith.AG +import CCO.Feedback (Feedback) +import CCO.Printing (Printable (pp)) +import CCO.Tree (ATerm (App), Tree (fromTree, toTree)) +import CCO.Tree.Parser (parseTree, app, arg) +import Control.Applicative (Applicative ((<*>)), (<$>)) + +------------------------------------------------------------------------------- +-- Tree instances +------------------------------------------------------------------------------- + +instance Tree Tm where + fromTree (Tm pos t) = App "Tm" [fromTree pos, fromTree t] + toTree = parseTree [app "Tm" (Tm <$> arg <*> arg)] + +instance Tree Tm_ where + fromTree (Num n) = App "Num" [fromTree n] + fromTree (Add t1 t2) = App "Add" [fromTree t1, fromTree t2] + fromTree (Sub t1 t2) = App "Sub" [fromTree t1, fromTree t2] + fromTree (Mul t1 t2) = App "Mul" [fromTree t1, fromTree t2] + fromTree (Div t1 t2) = App "Div" [fromTree t1, fromTree t2] + + toTree = parseTree [ app "Num" (Num <$> arg) + , app "Add" (Add <$> arg <*> arg) + , app "Sub" (Sub <$> arg <*> arg) + , app "Mul" (Mul <$> arg <*> arg) + , app "Div" (Div <$> arg <*> arg) + ] + +------------------------------------------------------------------------------- +-- Pretty printing +------------------------------------------------------------------------------- + +instance Printable Tm where + pp t = pp_Syn_Tm (wrap_Tm (sem_Tm t) inh_Tm) + +------------------------------------------------------------------------------- +-- Evaluation +------------------------------------------------------------------------------- + +-- | Evaluates a 'Tm'. +eval :: Tm -> Feedback Val +eval t = val_Syn_Tm (wrap_Tm (sem_Tm t) inh_Tm) + +------------------------------------------------------------------------------- +-- Top-level inherited attributes +------------------------------------------------------------------------------- + +-- | The top-level inherited attributes to be passed to an attribute grammar +-- for simple arithmetic expressions. +inh_Tm :: Inh_Tm +inh_Tm = Inh_Tm { prec_Inh_Tm = 0 } diff --git a/src/CCO/Arith/Lexer.hs b/src/CCO/Arith/Lexer.hs new file mode 100644 --- /dev/null +++ b/src/CCO/Arith/Lexer.hs @@ -0,0 +1,106 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.Arith.Lexer +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- A 'Lexer' for simple arithmetic expressions. +-- +------------------------------------------------------------------------------- + +module CCO.Arith.Lexer ( + -- * Tokens + Token -- abstract, instance: Symbol + + -- * Lexer + , lexer -- :: Lexer Token + + -- * Token parser + , num -- :: Parser Token Num_ + , operator -- :: String -> Parser Token String + , spec -- :: Char -> Parser Token Char +) where + +import CCO.Arith.Base (Num_) +import CCO.Lexing (Lexer, ignore, anyCharFrom, string, digit_) +import CCO.Parsing (Symbol (describe), Parser, satisfy, ()) +import Control.Applicative (Alternative ((<|>)), (<$>), some) + +------------------------------------------------------------------------------- +-- Tokens +------------------------------------------------------------------------------- + +-- | Type of tokens for simple arithmetic expressions. +data Token + = Num { fromNum :: Num_ } -- ^ Numeral. + | Operator { fromOperator :: String } -- ^ Operator. + | Spec { fromSpec :: Char } -- ^ Special character. + +instance Symbol Token where + describe (Num _) lexeme = "numeral " ++ lexeme + describe (Operator _) lexeme = "operator " ++ lexeme + describe (Spec _) lexeme = lexeme + +-- | Retrieves wehter a 'Token' is a 'Num'. +isNum :: Token -> Bool +isNum (Num _) = True +isNum _ = False + +-- | Retrieves wehter a 'Token' is an 'Operator'. +isOperator :: Token -> Bool +isOperator (Operator _) = True +isOperator _ = False + +-- | Retrieves wehter a 'Token' is a 'Spec'. +isSpec :: Token -> Bool +isSpec (Spec _) = True +isSpec _ = False + +------------------------------------------------------------------------------- +-- Lexer +------------------------------------------------------------------------------- + +-- | A 'Lexer' that recognises (and ignores) whitespace. +layout_ :: Lexer Token +layout_ = ignore (some (anyCharFrom " \n\t")) + +-- | A 'Lexer' that recognises 'Num' tokens. +num_ :: Lexer Token +num_ = (Num . foldl (\n i -> 10 * n + i) 0) <$> some digit_ + +-- | A 'Lexer' that recognises 'Operator' tokens. +operator_ :: Lexer Token +operator_ = fmap Operator $ + string "*" <|> string "-" <|> string "+" <|> string "/" + +-- | A 'Lexer' that recognises 'Spec' tokens. +spec_ :: Lexer Token +spec_ = Spec <$> anyCharFrom "()" + +-- | A 'Lexer' for simple arithmetic expressions. +lexer :: Lexer Token +lexer = layout_ <|> num_ <|> operator_ <|> spec_ + +------------------------------------------------------------------------------- +-- Token parsers +------------------------------------------------------------------------------- + +-- | A 'Parser' that recognises numerals. +num :: Parser Token Num_ +num = fromNum <$> satisfy isNum "numeral" + +-- | A 'Parser' that recognises a specified operator. +operator :: String -> Parser Token String +operator op = fromOperator <$> + satisfy (\tok -> isOperator tok && fromOperator tok == op) + "operator " ++ op + +-- | A 'Parser' that recognises a specified special character. +spec :: Char -> Parser Token Char +spec c = fromSpec <$> + satisfy (\tok -> isSpec tok && fromSpec tok == c) + [c] diff --git a/src/CCO/Arith/Parser.hs b/src/CCO/Arith/Parser.hs new file mode 100644 --- /dev/null +++ b/src/CCO/Arith/Parser.hs @@ -0,0 +1,52 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.Arith.Parser +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- A 'Parser' for simple arithmetic expressions. +-- +------------------------------------------------------------------------------- + +module CCO.Arith.Parser ( + -- * Parser + parser -- :: Component String Tm +) where + +import CCO.Arith.Base (Tm (Tm), Tm_ (Num, Add, Sub, Mul, Div)) +import CCO.Arith.Lexer (Token, lexer, num, operator, spec) +import CCO.Component (Component) +import qualified CCO.Component as C (parser) +import CCO.Parsing (Parser, sourcePos, eof, (), chainl) +import Control.Applicative + +------------------------------------------------------------------------------- +-- Token parsers +------------------------------------------------------------------------------- + +-- | Type of 'Parser's that consume symbols described by 'Token's. +type TokenParser = Parser Token + +------------------------------------------------------------------------------- +-- Parser +------------------------------------------------------------------------------- + +-- A 'Component' for parsing simple arithmetic expressions. +parser :: Component String Tm +parser = C.parser lexer (pTm <* eof) + +-- | Parses a 'Tm'. +pTm :: TokenParser Tm +pTm = pAddPrio "term" + where + pAddPrio = chainl (pOp Add "+" <|> pOp Sub "-") pMulPrio + pMulPrio = chainl (pOp Mul "*" <|> pOp Div "/") pBase + pBase = pPos (Num <$> num) <|> spec '(' *> pTm <* spec ')' "term" + pPos p = Tm <$> sourcePos <*> p + pOp f op = (\t1@(Tm pos _) t2 -> Tm pos (f t1 t2)) <$ operator op + "operator" + diff --git a/src/CCO/ArithBool.hs b/src/CCO/ArithBool.hs new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool.hs @@ -0,0 +1,34 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.ArithBool +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- Arithmetic and boolean expressions. +-- +------------------------------------------------------------------------------- + +module CCO.ArithBool ( + -- * Syntax + Num_ -- = Int + , Tm (Tm) -- instances: Tree + , Tm_ (..) -- instances: Tree + + -- * Parser + , parser -- :: Component String Tm + + -- * Type checking + , Ty (Nat, Bool) -- instances: Eq, Show, Tree + , checkTy -- :: Tm -> Feedback Ty + + -- * Evaluation + , Val (VNum, VFalse, VTrue) -- instances: Tree, Printable + , eval -- :: Tm -> Feedback Val +) where + +import CCO.ArithBool.Base +import CCO.ArithBool.Parser (parser) diff --git a/src/CCO/ArithBool/AG.ag b/src/CCO/ArithBool/AG.ag new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool/AG.ag @@ -0,0 +1,21 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.ArithBool.AG +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- Attribute grammar for arithmetic and boolean expressions. +-- +------------------------------------------------------------------------------- + +module {CCO.ArithBool.AG} {} {} + +include "AG/Base.ag" +include "AG/Evaluation.ag" +include "AG/Pos.ag" +include "AG/Printing.ag" +include "AG/Typing.ag" diff --git a/src/CCO/ArithBool/AG/Base.ag b/src/CCO/ArithBool/AG/Base.ag new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool/AG/Base.ag @@ -0,0 +1,29 @@ +imports +{ +import CCO.SourcePos (SourcePos) +} + +------------------------------------------------------------------------------- +-- Syntax +------------------------------------------------------------------------------- + +{ +-- | Type of numerals. +type Num_ = Int +} + +data Tm + | Tm pos :: {SourcePos} t :: Tm_ + +data Tm_ + | Num n :: {Num_} + | False_ + | True_ + | If t1 :: Tm t2 :: Tm t3 :: Tm + | Add t1 :: Tm t2 :: Tm + | Sub t1 :: Tm t2 :: Tm + | Mul t1 :: Tm t2 :: Tm + | Div t1 :: Tm t2 :: Tm + | Lt t1 :: Tm t2 :: Tm + | Eq t1 :: Tm t2 :: Tm + | Gt t1 :: Tm t2 :: Tm diff --git a/src/CCO/ArithBool/AG/Evaluation.ag b/src/CCO/ArithBool/AG/Evaluation.ag new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool/AG/Evaluation.ag @@ -0,0 +1,147 @@ +imports +{ +import CCO.Feedback (Feedback, errorMessage) +import CCO.Printing +import CCO.SourcePos (Source (..), Pos (..), SourcePos (..)) +import CCO.Tree (ATerm (App), Tree (fromTree, toTree)) +import CCO.Tree.Parser (parseTree, app, arg) +import Control.Applicative (Applicative (pure), (<$>)) +import Control.Monad (when, unless) +} + +------------------------------------------------------------------------------- +-- Syntax +------------------------------------------------------------------------------- + +{ +-- | Type of values. +data Val + = VNum Num_ -- ^ Numeral. + | VFalse -- ^ False. + | VTrue -- ^ True. + +instance Tree Val where + fromTree (VNum n) = App "Num" [fromTree n] + fromTree VFalse = App "False" [] + fromTree VTrue = App "True" [] + + toTree = parseTree [ app "Num" (VNum <$> arg) + , app "False" (pure VFalse) + , app "True" (pure VTrue) + ] + +instance Printable Val where + pp (VNum n) = showable n + pp VFalse = text "false" + pp VTrue = text "true" + +-- | Retrieves whether a 'Val' is a 'VNum'. +isVNum :: Val -> Bool +isVNum (VNum _) = True +isVNum _ = False + +-- | Retrieves whether a 'Val' is 'VFalse'. +isVFalse :: Val -> Bool +isVFalse VFalse = True +isVFalse _ = False + +-- | Retrieves whether a 'Val' is 'VTrue'. +isVTrue :: Val -> Bool +isVTrue VTrue = True +isVTrue _ = False + +-- | Retrieves whether a 'Val' is either 'VFalse' or 'VTrue'. +isBool :: Val -> Bool +isBool v = isVFalse v || isVTrue v + +-- | Retrieves a textual description of the type of a 'Val'. +describeTy :: Val -> String +describeTy (VNum _) = "natural number" +describeTy VFalse = "boolean" +describeTy VTrue = "boolean" +} + +------------------------------------------------------------------------------- +-- Evaluation +------------------------------------------------------------------------------- + +attr Tm Tm_ + syn val :: {Feedback Val} + +sem Tm_ + | Num lhs.val = return (VNum @n) + | False_ lhs.val = return VFalse + | True_ lhs.val = return VTrue + | If lhs.val = matchBool @t1.pos @t1.val @t2.val @t3.val + | Add lhs.val = do n1 <- matchNat @t1.pos @t1.val + n2 <- matchNat @t2.pos @t2.val + return (VNum (n1 + n2)) + | Sub lhs.val = do n1 <- matchNat @t1.pos @t1.val + n2 <- matchNat @t2.pos @t2.val + return (VNum (if n2 > n1 then 0 else n1 - n2)) + | Mul lhs.val = do n1 <- matchNat @t1.pos @t1.val + n2 <- matchNat @t2.pos @t2.val + return (VNum (n1 * n2)) + | Div lhs.val = do n1 <- matchNat @t1.pos @t1.val + n2 <- matchNat @t2.pos @t2.val + when (n2 == 0) (errDivByZero @lhs.pos) + return (VNum (n1 `div` n2)) + | Lt lhs.val = do n1 <- matchNat @t1.pos @t1.val + n2 <- matchNat @t2.pos @t2.val + return (if n1 < n2 then VTrue else VFalse) + | Eq lhs.val = do n1 <- matchNat @t1.pos @t1.val + n2 <- matchNat @t2.pos @t2.val + return (if n1 == n2 then VTrue else VFalse) + | Gt lhs.val = do n1 <- matchNat @t1.pos @t1.val + n2 <- matchNat @t2.pos @t2.val + return (if n1 > n2 then VTrue else VFalse) + +------------------------------------------------------------------------------- +-- Run-time type checking +------------------------------------------------------------------------------- + +{ +-- | Checks whether a 'Val' is a numeral. +-- If the check succeeds, the numeral is returned; if not, a run-time type +-- error is issued. +matchNat :: SourcePos -> Feedback Val -> Feedback Num_ +matchNat pos fv = do + v@(~(VNum n)) <- fv + unless (isVNum v) (errTyMismatch pos "natural number" (describeTy v)) + return n + +-- | Checks whether a 'Val' is a boolean constant. +-- If the check succeeds, one of two continuations (for 'VTrue' and 'VFalse', +-- respectively) is selected; if not, a run-time type error is issued. +matchBool :: SourcePos -> Feedback Val -> Feedback a -> Feedback a -> + Feedback a +matchBool pos fv ft ff = do + v <- fv + unless (isBool v) (errTyMismatch pos "boolean" (describeTy v)) + case v of + VFalse -> ff + VTrue -> ft +} + +------------------------------------------------------------------------------- +-- Run-time errors +------------------------------------------------------------------------------- + +{ +-- | Produces a division-by-zero error. +errDivByZero :: SourcePos -> Feedback () +errDivByZero pos = + errorMessage . wrapped $ + describeSourcePos pos ++ ": Run-time error: division by zero." + +-- | Given a source position, a textual description of the expected type, and +-- a textual description of the actual type, produces a run-time type error. +errTyMismatch :: SourcePos -> String -> String -> Feedback () +errTyMismatch pos expected encountered + = errorMessage (ppHeader >-< text " " >-< ppExpected >-< ppEncountered) + where + ppHeader = wrapped $ + describeSourcePos pos ++ ": Run-time error: type mismatch." + ppExpected = text "? expected : " >|< wrapped expected + ppEncountered = text "? encountered : " >|< wrapped encountered +} diff --git a/src/CCO/ArithBool/AG/Pos.ag b/src/CCO/ArithBool/AG/Pos.ag new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool/AG/Pos.ag @@ -0,0 +1,38 @@ +imports +{ +import CCO.SourcePos (SourcePos) +} + +------------------------------------------------------------------------------- +-- Source positions +------------------------------------------------------------------------------- + +attr Tm + syn pos :: {SourcePos} + +sem Tm + | Tm lhs.pos = @pos + +attr Tm_ + inh pos :: {SourcePos} + +sem Tm + | Tm t.pos = @pos + +------------------------------------------------------------------------------- +-- Utilities +------------------------------------------------------------------------------- + +{ +-- | Retrieves a textual description of a 'SourcePos'. +describeSourcePos :: SourcePos -> String +describeSourcePos (SourcePos (File file) (Pos ln col)) + = file ++ + ":line " ++ show ln ++ + ":column " ++ show col +describeSourcePos (SourcePos (File file) EOF) = file ++ + ":" +describeSourcePos (SourcePos Stdin (Pos ln col)) = "line " ++ show ln ++ + ":column " ++ show col +describeSourcePos (SourcePos Stdin EOF) = "" +} diff --git a/src/CCO/ArithBool/AG/Printing.ag b/src/CCO/ArithBool/AG/Printing.ag new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool/AG/Printing.ag @@ -0,0 +1,88 @@ +imports +{ +import CCO.Printing +} + +------------------------------------------------------------------------------- +-- Pretty printing +------------------------------------------------------------------------------- + +attr Tm Tm_ + syn pp :: Doc + +sem Tm_ + | Num lhs.pp = showable @n + | False_ lhs.pp = text "false" + | True_ lhs.pp = text "true" + +sem Tm_ + | If lhs.pp = ppIf @t1.pp @t2.pp @t3.pp + +{ +-- | Pretty prints a conditional. +ppIf :: Doc -> Doc -> Doc -> Doc +ppIf guard then_ else_ = singleLine >//< multiLine >//< indented + where + singleLine = ppIf_ >#< guard >#< + ppThen >#< then_ >#< + ppElse >#< else_ >#< + ppFi + multiLine = ppIf_ >|< text " " >|< guard >-< + ppThen >#< then_ >-< + ppElse >#< else_ >-< + ppFi + indented = ppIf_ >-< indent 2 guard >-< + ppThen >-< indent 2 then_ >-< + ppElse >-< indent 2 else_ >-< + ppFi + ppIf_ = text "if" + ppThen = text "then" + ppElse = text "else" + ppFi = text "fi" +} + +sem Tm_ + | Add lhs.pp = ppInfix @lhs.prec ("+" , 6) @t1.pp @t2.pp + | Sub lhs.pp = ppInfix @lhs.prec ("-" , 6) @t1.pp @t2.pp + | Mul lhs.pp = ppInfix @lhs.prec ("*" , 7) @t1.pp @t2.pp + | Div lhs.pp = ppInfix @lhs.prec ("/" , 7) @t1.pp @t2.pp + | Lt lhs.pp = ppInfix @lhs.prec ("<" , 4) @t1.pp @t2.pp + | Eq lhs.pp = ppInfix @lhs.prec ("==", 4) @t1.pp @t2.pp + | Gt lhs.pp = ppInfix @lhs.prec (">" , 4) @t1.pp @t2.pp + +------------------------------------------------------------------------------- +-- Precedence levels +------------------------------------------------------------------------------- + +{ +-- | Type of precedence levels. +type Prec = Int +} + +attr Tm Tm_ + inh prec :: Int + +sem Tm_ + | If t1.prec = 0 + t2.prec = 0 + t3.prec = 0 + | Add Sub t1.prec = 6 + t2.prec = 7 + | Mul Div t1.prec = 7 + t2.prec = 8 + | Lt Eq Gt t1.prec = 4 + t2.prec = 4 + +{ +-- | Pretty prints, given the precedence level of its immediate context, a term +-- constructed from a binary operator of a specified precedence level. +-- +-- A term is enclosed in parentheses if the precedence level of its operator +-- is less than the precedence level of the enclosing context. + +ppInfix :: Prec -> (String, Prec) -> Doc -> Doc -> Doc +ppInfix ctx (op, prec) l r = modifier $ l >#< ppOp >#< r + where + modifier = if prec < ctx then parens else id + ppOp = text op +} diff --git a/src/CCO/ArithBool/AG/Typing.ag b/src/CCO/ArithBool/AG/Typing.ag new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool/AG/Typing.ag @@ -0,0 +1,135 @@ +imports +{ +import CCO.Printing +import CCO.SourcePos (SourcePos) +import CCO.Tree (ATerm (App), Tree (fromTree, toTree)) +import CCO.Tree.Parser (parseTree, app) +import Control.Applicative (Applicative (pure)) +} + +------------------------------------------------------------------------------- +-- Syntax +------------------------------------------------------------------------------- + +{ +-- | Type of types. +-- Join-semilattice with greatest element 'Top'. +data Ty = Nat | Bool | Top deriving (Eq, Show) + +instance Tree Ty where + fromTree Nat = App "Nat" [] + fromTree Bool = App "Bool" [] + fromTree Top = App "Top" [] + + toTree = parseTree [ app "Nat" (pure Nat ) + , app "Bool" (pure Bool) + , app "Top" (pure Top ) + ] + +-- | Retrieves whether two 'Ty's match. +-- Two 'Ty's match if they are the same or if one of them is 'Top'. +match :: Ty -> Ty -> Bool +match Top _ = True +match _ Top = True +match ty1 ty2 = ty1 == ty2 + +-- | Retrieves the least upper bound of two 'Ty's. +lub :: Ty -> Ty -> Ty +lub ty1 ty2 = if ty1 == ty2 then ty1 else Top +} + +------------------------------------------------------------------------------- +-- Typing +------------------------------------------------------------------------------- + +attr Tm Tm_ + syn ty :: {Ty} + syn tyErrs use {++} {[]} :: {[TyErr]} + +sem Tm_ + | Num lhs.ty = Nat + | False_ True_ lhs.ty = Bool + | If lhs.ty = @t2.ty `lub` @t3.ty + | Add Sub Mul Div lhs.ty = Nat + | Lt Eq Gt lhs.ty = Bool + +sem Tm_ + | If lhs.tyErrs = @t1.tyErrs ++ @t2.tyErrs ++ @t3.tyErrs ++ + checkTyGuard @t1.pos @t1.ty ++ + checkTyBranches @t3.pos @t2.ty @t3.ty + +{ +-- | Checks the type of the guard of a conditional. +checkTyGuard :: SourcePos -> Ty -> [TyErr] +checkTyGuard _ ty | ty `match` Bool = [] +checkTyGuard pos ty = [TyErr pos descr Bool ty] + where + descr = "guard of a conditional should be a boolean" + +-- | Checks that both branches of a conditional have the same type. +checkTyBranches :: SourcePos -> Ty -> Ty -> [TyErr] +checkTyBranches pos tyThen tyElse + | tyThen `match` tyElse = [] + | otherwise = [TyErr pos descr tyThen tyElse] + where + descr = "branches of a conditional should have the same type" +} + +sem Tm_ + | Add Sub Mul Div lhs.tyErrs = @t1.tyErrs ++ @t2.tyErrs ++ + checkTyArithOp @t1.pos @t1.ty ++ + checkTyArithOp @t2.pos @t2.ty + +{ +-- | Checks the type of an operand of an arithmetic operator. +checkTyArithOp :: SourcePos -> Ty -> [TyErr] +checkTyArithOp _ ty | ty `match` Nat = [] +checkTyArithOp pos ty = [TyErr pos descr Nat ty] + where + descr = "operand of an arithmetic operator should be a natural number" +} + +sem Tm_ + | Lt Eq Gt lhs.tyErrs = @t1.tyErrs ++ @t2.tyErrs ++ + checkTyRelOp @t1.pos @t1.ty ++ + checkTyRelOp @t2.pos @t2.ty + +{ +-- | Checks the type of an operand of a relational operator. +checkTyRelOp :: SourcePos -> Ty -> [TyErr] +checkTyRelOp _ ty | ty `match` Nat = [] +checkTyRelOp pos ty = [TyErr pos descr Nat ty] + where + descr = "operand of a relational operator should be a natural number" +} + +------------------------------------------------------------------------------- +-- Type errors +------------------------------------------------------------------------------- + +{ +-- | Type of type errors. +data TyErr + = TyErr SourcePos String Ty Ty -- ^ Holds a source position, a description, + -- the expected type and the inferred + -- type. + +instance Printable TyErr where + pp = ppTyErr +} + +------------------------------------------------------------------------------- +-- Pretty printing type errors +------------------------------------------------------------------------------- + +{ +-- | Pretty prints a type error message. +ppTyErr :: TyErr -> Doc +ppTyErr (TyErr pos descr expected inferred) + = above [ppHeader, text " ", ppExpected, ppInferred] + where + ppHeader = wrapped $ + describeSourcePos pos ++ ": Type error: " ++ descr ++ "." + ppExpected = text "? expected : " >|< showable expected + ppInferred = text "? inferred : " >|< showable inferred +} diff --git a/src/CCO/ArithBool/Base.hs b/src/CCO/ArithBool/Base.hs new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool/Base.hs @@ -0,0 +1,103 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.ArithBool.Base +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- Arithmetic and boolean expressions. +-- +------------------------------------------------------------------------------- + +module CCO.ArithBool.Base ( + -- * Syntax + Num_ -- = Int + , Tm (Tm) -- instances: Tree + , Tm_ (..) -- instances: Tree + + -- * Type checking + , Ty (Nat, Bool) -- instances: Eq, Show, Tree + , checkTy -- :: Tm -> Feedback Ty + + -- * Evaluation + , Val (VNum, VFalse, VTrue) -- instances: Tree, Printable + , eval -- :: Tm -> Feedback Val +) where + +import CCO.ArithBool.AG +import CCO.Feedback (Feedback, Message (Error), messages) +import CCO.Printing (Printable (pp)) +import CCO.Tree (ATerm (App), Tree (fromTree, toTree)) +import CCO.Tree.Parser (parseTree, app, arg) +import Control.Applicative (Applicative (pure, (<*>)), (<$>)) + +------------------------------------------------------------------------------- +-- Tree instances +------------------------------------------------------------------------------- + +instance Tree Tm where + fromTree (Tm pos t) = App "Tm" [fromTree pos, fromTree t] + toTree = parseTree [app "Tm" (Tm <$> arg <*> arg)] + +instance Tree Tm_ where + fromTree (Num n) = App "Num" [fromTree n] + fromTree False_ = App "False" [] + fromTree True_ = App "True" [] + fromTree (If t1 t2 t3) = App "If" [fromTree t1, fromTree t2, fromTree t3] + fromTree (Add t1 t2) = App "Add" [fromTree t1, fromTree t2] + fromTree (Sub t1 t2) = App "Sub" [fromTree t1, fromTree t2] + fromTree (Mul t1 t2) = App "Mul" [fromTree t1, fromTree t2] + fromTree (Div t1 t2) = App "Div" [fromTree t1, fromTree t2] + fromTree (Lt t1 t2) = App "Lt" [fromTree t1, fromTree t2] + fromTree (Eq t1 t2) = App "Eq" [fromTree t1, fromTree t2] + fromTree (Gt t1 t2) = App "Gt" [fromTree t1, fromTree t2] + + toTree = parseTree [ app "Num" (Num <$> arg) + , app "False" (pure False_) + , app "True" (pure True_) + , app "If" (If <$> arg <*> arg <*> arg) + , app "Add" (Add <$> arg <*> arg) + , app "Sub" (Sub <$> arg <*> arg) + , app "Mul" (Mul <$> arg <*> arg) + , app "Div" (Div <$> arg <*> arg) + , app "Lt" (Lt <$> arg <*> arg) + , app "Eq" (Eq <$> arg <*> arg) + , app "Gt" (Gt <$> arg <*> arg) + ] + +------------------------------------------------------------------------------- +-- Pretty printing +------------------------------------------------------------------------------- + +instance Printable Tm where + pp t = pp_Syn_Tm (wrap_Tm (sem_Tm t) inh_Tm) + +------------------------------------------------------------------------------- +-- Typing +------------------------------------------------------------------------------- + +-- | Typechecks a 'Tm'. +checkTy :: Tm -> Feedback Ty +checkTy t = do let syn = wrap_Tm (sem_Tm t) inh_Tm + messages [Error (pp tyErr) | tyErr <- tyErrs_Syn_Tm syn] + return (ty_Syn_Tm syn) + +------------------------------------------------------------------------------- +-- Evaluation +------------------------------------------------------------------------------- + +-- | Evaluates a 'Tm'. +eval :: Tm -> Feedback Val +eval t = val_Syn_Tm (wrap_Tm (sem_Tm t) inh_Tm) + +------------------------------------------------------------------------------- +-- Top-level inherited attributes +------------------------------------------------------------------------------- + +-- | The top-level inherited attributes to be passed to an attribute grammar +-- for arithmetic and boolean expressions. +inh_Tm :: Inh_Tm +inh_Tm = Inh_Tm { prec_Inh_Tm = 0 } diff --git a/src/CCO/ArithBool/Lexer.hs b/src/CCO/ArithBool/Lexer.hs new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool/Lexer.hs @@ -0,0 +1,126 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.ArithBool.Lexer +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- A 'Lexer' for arithmetic and boolean expressions. +-- +------------------------------------------------------------------------------- + +module CCO.ArithBool.Lexer ( + -- * Tokens + Token -- abstract, instance: Symbol + + -- * Lexer + , lexer -- :: Lexer Token + + -- * Token parser + , num -- :: Parser Token Num_ + , keyword -- :: String -> Parser Token String + , operator -- :: String -> Parser Token String + , spec -- :: Char -> Parser Token Char +) where + +import CCO.ArithBool.Base (Num_) +import CCO.Lexing (Lexer, ignore, anyCharFrom, string, digit_) +import CCO.Parsing (Symbol (describe), Parser, satisfy, ()) +import Control.Applicative (Alternative ((<|>)), (<$>), some) + +------------------------------------------------------------------------------- +-- Tokens +------------------------------------------------------------------------------- + +-- | Type of tokens for arithmetic and boolean expressions. +data Token + = Num { fromNum :: Num_ } -- ^ Numeral. + | Keyword { fromKeyword :: String } -- ^ Keyword. + | Operator { fromOperator :: String } -- ^ Operator. + | Spec { fromSpec :: Char } -- ^ Special character. + +instance Symbol Token where + describe (Num _) lexeme = "numeral " ++ lexeme + describe (Keyword _) lexeme = "keyword " ++ lexeme + describe (Operator _) lexeme = "operator " ++ lexeme + describe (Spec _) lexeme = lexeme + +-- | Retrieves wehter a 'Token' is a 'Num'. +isNum :: Token -> Bool +isNum (Num _) = True +isNum _ = False + +-- | Retrieves wehter a 'Token' is a 'Keyword'. +isKeyword :: Token -> Bool +isKeyword (Keyword _) = True +isKeyword _ = False + +-- | Retrieves wehter a 'Token' is an 'Operator'. +isOperator :: Token -> Bool +isOperator (Operator _) = True +isOperator _ = False + +-- | Retrieves wehter a 'Token' is a 'Spec'. +isSpec :: Token -> Bool +isSpec (Spec _) = True +isSpec _ = False + +------------------------------------------------------------------------------- +-- Lexer +------------------------------------------------------------------------------- + +-- | A 'Lexer' that recognises (and ignores) whitespace. +layout_ :: Lexer Token +layout_ = ignore (some (anyCharFrom " \n\t")) + +-- | A 'Lexer' that recognises 'Num' tokens. +num_ :: Lexer Token +num_ = (Num . foldl (\n i -> 10 * n + i) 0) <$> some digit_ + +-- | A 'Lexer' that recognises 'Keyword' tokens. +keyword_ :: Lexer Token +keyword_ = fmap Keyword $ + string "else" <|> string "false" <|> string "fi" <|> string "if" <|> + string "then" <|> string "true" + +-- | A 'Lexer' that recognises 'Operator' tokens. +operator_ :: Lexer Token +operator_ = fmap Operator $ + string "*" <|> string "-" <|> string "==" <|> string "+" <|> + string "<" <|> string ">" <|> string "/" + +-- | A 'Lexer' that recognises 'Spec' tokens. +spec_ :: Lexer Token +spec_ = Spec <$> anyCharFrom "()" + +-- | A 'Lexer' for simple arithmetic expressions. +lexer :: Lexer Token +lexer = layout_ <|> num_ <|> keyword_ <|> operator_ <|> spec_ + +------------------------------------------------------------------------------- +-- Token parsers +------------------------------------------------------------------------------- + +-- | A 'Parser' that recognises numerals. +num :: Parser Token Num_ +num = fromNum <$> satisfy isNum "numeral" + +-- | A 'Parser' that recognises a specified keyword. +keyword :: String -> Parser Token String +keyword key = fromKeyword <$> + satisfy (\tok -> isKeyword tok && fromKeyword tok == key) + "keyword " ++ key + +-- | A 'Parser' that recognises a specified operator. +operator :: String -> Parser Token String +operator op = fromOperator <$> + satisfy (\tok -> isOperator tok && fromOperator tok == op) + "operator " ++ op + +-- | A 'Parser' that recognises a specified special character. +spec :: Char -> Parser Token Char +spec c = fromSpec <$> satisfy (\tok -> isSpec tok && fromSpec tok == c) + [c] diff --git a/src/CCO/ArithBool/Parser.hs b/src/CCO/ArithBool/Parser.hs new file mode 100644 --- /dev/null +++ b/src/CCO/ArithBool/Parser.hs @@ -0,0 +1,64 @@ +------------------------------------------------------------------------------- +-- | +-- Module : CCO.ArithBool.Parser +-- Copyright : (c) 2008 Utrecht University +-- License : All rights reserved +-- +-- Maintainer : stefan@cs.uu.nl +-- Stability : provisional +-- Portability : portable +-- +-- A 'Parser' for arithmetic and boolean expressions. +-- +------------------------------------------------------------------------------- + +module CCO.ArithBool.Parser ( + -- * Parser + parser -- :: Component String Tm +) where + +import CCO.ArithBool.Base (Tm (Tm), Tm_ (..)) +import CCO.ArithBool.Lexer +import CCO.Component (Component) +import qualified CCO.Component as C (parser) +import CCO.Parsing (Parser, sourcePos, eof, (), chainl) +import Control.Applicative + +------------------------------------------------------------------------------- +-- Token parsers +------------------------------------------------------------------------------- + +-- | Type of 'Parser's that consume symbols described by 'Token's. +type TokenParser = Parser Token + +------------------------------------------------------------------------------- +-- Parser +------------------------------------------------------------------------------- + +-- A 'Component' for parsing arithmetic and boolean expressions. +parser :: Component String Tm +parser = C.parser lexer (pTm <* eof) + +-- | Parses a 'Tm'. +pTm :: TokenParser Tm +pTm = pEqPrio "term" + where + pEqPrio = + (\t1 op t2 -> op t1 t2) <$> + pAddPrio <*> + (pOp Lt "<" <|> pOp Eq "==" <|> pOp Gt ">" "relational operator") <*> + pAddPrio <|> + pAddPrio + pAddPrio = + chainl (pOp Add "+" <|> pOp Sub "-" "arithmetic operator") pMulPrio + pMulPrio = + chainl (pOp Mul "*" <|> pOp Div "/" "arithmetic operator") pBase + pBase = pPos (Num <$> num) <|> + pPos (False_ <$ keyword "false") <|> + pPos (True_ <$ keyword "true") <|> + pPos (If <$ keyword "if" <*> pTm <* keyword "then" <*> pTm <* + keyword "else" <*> pTm <* keyword "fi") <|> + spec '(' *> pTm <* spec ')' + "term" + pPos p = Tm <$> sourcePos <*> p + pOp f op = (\t1@(Tm pos _) t2 -> Tm pos (f t1 t2)) <$ operator op diff --git a/src/EvalArith.hs b/src/EvalArith.hs new file mode 100644 --- /dev/null +++ b/src/EvalArith.hs @@ -0,0 +1,7 @@ +import CCO.Arith (eval) +import CCO.Component (component, printer, ioWrap) +import CCO.Tree (parser, Tree (fromTree, toTree)) +import Control.Arrow (Arrow (arr), (>>>)) + +main = ioWrap $ + parser >>> component toTree >>> component eval >>> arr fromTree >>> printer diff --git a/src/EvalArithBool.hs b/src/EvalArithBool.hs new file mode 100644 --- /dev/null +++ b/src/EvalArithBool.hs @@ -0,0 +1,7 @@ +import CCO.ArithBool (eval) +import CCO.Component (component, printer, ioWrap) +import CCO.Tree (parser, Tree (fromTree, toTree)) +import Control.Arrow (Arrow (arr), (>>>)) + +main = ioWrap $ + parser >>> component toTree >>> component eval >>> arr fromTree >>> printer diff --git a/src/InterpArith.hs b/src/InterpArith.hs new file mode 100644 --- /dev/null +++ b/src/InterpArith.hs @@ -0,0 +1,5 @@ +import CCO.Arith (parser, eval) +import CCO.Component (component, printer, ioWrap) +import Control.Arrow ((>>>)) + +main = ioWrap (parser >>> component eval >>> printer) diff --git a/src/InterpArithBool.hs b/src/InterpArithBool.hs new file mode 100644 --- /dev/null +++ b/src/InterpArithBool.hs @@ -0,0 +1,5 @@ +import CCO.ArithBool (parser, checkTy, eval) +import CCO.Component (component, printer, ioWrap) +import Control.Arrow ((>>>)) + +main = ioWrap (parser >>> component (\t -> checkTy t >> eval t) >>> printer) diff --git a/src/ParseArith.hs b/src/ParseArith.hs new file mode 100644 --- /dev/null +++ b/src/ParseArith.hs @@ -0,0 +1,6 @@ +import CCO.Arith (parser) +import CCO.Component (printer, ioWrap) +import CCO.Tree (Tree (fromTree)) +import Control.Arrow (Arrow (arr), (>>>)) + +main = ioWrap (parser >>> arr fromTree >>> printer) diff --git a/src/ParseArithBool.hs b/src/ParseArithBool.hs new file mode 100644 --- /dev/null +++ b/src/ParseArithBool.hs @@ -0,0 +1,6 @@ +import CCO.ArithBool (parser) +import CCO.Component (printer, ioWrap) +import CCO.Tree (Tree (fromTree)) +import Control.Arrow (Arrow (arr), (>>>)) + +main = ioWrap (parser >>> arr fromTree >>> printer) diff --git a/src/PpArith.hs b/src/PpArith.hs new file mode 100644 --- /dev/null +++ b/src/PpArith.hs @@ -0,0 +1,7 @@ +import CCO.Arith (Tm) +import CCO.Component (Component, component, printer, ioWrap) +import CCO.Tree (parser, Tree (toTree)) +import Control.Arrow ((>>>)) + +main = ioWrap $ parser >>> component toTree >>> + (printer :: Component Tm String) diff --git a/src/PpArithBool.hs b/src/PpArithBool.hs new file mode 100644 --- /dev/null +++ b/src/PpArithBool.hs @@ -0,0 +1,7 @@ +import CCO.ArithBool (Tm) +import CCO.Component (Component, component, printer, ioWrap) +import CCO.Tree (parser, Tree (toTree)) +import Control.Arrow ((>>>)) + +main = ioWrap $ parser >>> component toTree >>> + (printer :: Component Tm String) diff --git a/src/TcArithBool.hs b/src/TcArithBool.hs new file mode 100644 --- /dev/null +++ b/src/TcArithBool.hs @@ -0,0 +1,8 @@ +import CCO.ArithBool (checkTy) +import CCO.Component (component, printer, ioWrap) +import CCO.Tree (parser, Tree (fromTree, toTree)) +import Control.Arrow (Arrow (arr), (>>>)) + +main = ioWrap $ parser >>> component toTree >>> + component checkTy >>> + arr fromTree >>> printer diff --git a/uu-cco-examples.cabal b/uu-cco-examples.cabal --- a/uu-cco-examples.cabal +++ b/uu-cco-examples.cabal @@ -1,6 +1,6 @@ name: uu-cco-examples -version: 0.1.0.0 -synopsis: Utilities for compiler construction +version: 0.1.0.1 +synopsis: Utilities for compiler construction: example programs description: A small utility library accompanying the course on Compiler Construction (INFOMCCO) at Utrecht Univerity. license: BSD3 @@ -11,16 +11,101 @@ maintainer: Atze Dijkstra stability: provisional homepage: https://github.com/UU-ComputerScience/uu-cco -build-type: Simple -cabal-version: >= 1.6 -extra-source-files: AUTHORS +build-type: Custom +cabal-version: >= 1.8 +extra-source-files: AUTHORS, + uuagc_options, + src/CCO/Arith/AG.ag, + src/CCO/Arith/AG/Base.ag, + src/CCO/Arith/AG/Evaluation.ag, + src/CCO/Arith/AG/Pos.ag, + src/CCO/Arith/AG/Printing.ag, + src/CCO/ArithBool/AG.ag, + src/CCO/ArithBool/AG/Base.ag, + src/CCO/ArithBool/AG/Evaluation.ag, + src/CCO/ArithBool/AG/Pos.ag, + src/CCO/ArithBool/AG/Printing.ag, + src/CCO/ArithBool/AG/Typing.ag source-repository head type: git location: git://github.com/UU-ComputerScience/uu-cco.git +executable uu-cco-parse-arith + main-is: ParseArith.hs + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0, + uuagc >= 0.9.40.3, uuagc-cabal >= 1.0.3.0 + other-modules: CCO.Arith, CCO.Arith.AG, CCO.Arith.Base, + CCO.Arith.Lexer, CCO.Arith.Parser + hs-source-dirs: src + +executable uu-cco-parse-arithbool + main-is: ParseArithBool.hs + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0, + uuagc >= 0.9.40.3, uuagc-cabal >= 1.0.3.0 + other-modules: CCO.ArithBool, CCO.ArithBool.AG, CCO.ArithBool.Base, + CCO.ArithBool.Lexer, CCO.ArithBool.Parser + hs-source-dirs: src + +executable uu-cco-pp-arith + main-is: PpArith.hs + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0, + uuagc >= 0.9.40.3, uuagc-cabal >= 1.0.3.0 + other-modules: CCO.Arith, CCO.Arith.AG, CCO.Arith.Base, + CCO.Arith.Lexer, CCO.Arith.Parser + hs-source-dirs: src + +executable uu-cco-pp-arithbool + main-is: PpArithBool.hs + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0, + uuagc >= 0.9.40.3, uuagc-cabal >= 1.0.3.0 + other-modules: CCO.ArithBool, CCO.ArithBool.AG, CCO.ArithBool.Base, + CCO.ArithBool.Lexer, CCO.ArithBool.Parser + hs-source-dirs: src + +executable uu-cco-eval-arith + main-is: EvalArith.hs + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0, + uuagc >= 0.9.40.3, uuagc-cabal >= 1.0.3.0 + other-modules: CCO.Arith, CCO.Arith.AG, CCO.Arith.Base, + CCO.Arith.Lexer, CCO.Arith.Parser + hs-source-dirs: src + +executable uu-cco-eval-arithbool + main-is: EvalArithBool.hs + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0, + uuagc >= 0.9.40.3, uuagc-cabal >= 1.0.3.0 + other-modules: CCO.ArithBool, CCO.ArithBool.AG, CCO.ArithBool.Base, + CCO.ArithBool.Lexer, CCO.ArithBool.Parser + hs-source-dirs: src + +executable uu-cco-interp-arith + main-is: InterpArith.hs + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0, + uuagc >= 0.9.40.3, uuagc-cabal >= 1.0.3.0 + other-modules: CCO.Arith, CCO.Arith.AG, CCO.Arith.Base, + CCO.Arith.Lexer, CCO.Arith.Parser + hs-source-dirs: src + +executable uu-cco-interp-arithbool + main-is: InterpArithBool.hs + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0, + uuagc >= 0.9.40.3, uuagc-cabal >= 1.0.3.0 + other-modules: CCO.ArithBool, CCO.ArithBool.AG, CCO.ArithBool.Base, + CCO.ArithBool.Lexer, CCO.ArithBool.Parser + hs-source-dirs: src + +executable uu-cco-tc-arithbool + main-is: TcArithBool.hs + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0, + uuagc >= 0.9.40.3, uuagc-cabal >= 1.0.3.0 + other-modules: CCO.ArithBool, CCO.ArithBool.AG, CCO.ArithBool.Base, + CCO.ArithBool.Lexer, CCO.ArithBool.Parser + hs-source-dirs: src + executable uu-cco-pp-aterm main-is: PpATerm.hs - build-depends: base >= 4 && < 5, ansi-terminal >= 0.5.0, uu-cco >= 0.1.0.0 + build-depends: base >= 4 && < 5, uu-cco >= 0.1.0.0 other-modules: hs-source-dirs: src + diff --git a/uuagc_options b/uuagc_options new file mode 100644 --- /dev/null +++ b/uuagc_options @@ -0,0 +1,6 @@ +file : "src/CCO/ArithBool/AG.ag" +options : catas, semfuns, signatures, pretty, data, haskellsyntax, wrappers + +file : "src/CCO/Arith/AG.ag" +options : catas, semfuns, signatures, pretty, data, haskellsyntax, wrappers +