CASC added to tools

.gitignore

@@ -10,6 +10,7 @@ browser/BrowserGUI
 browser/GenInt
 browser/ShowFlatCurry
 browser/SourceProgGUI
+casc/CASC
 CASS/cass
 CASS/cass_worker
 createmakefile/CreateMakefile

casc/AST/ASM.curry

+{- |
+    Module      :  AST.ASM
+    Description :  Add Span Monad
+
+    This module contains the Add Span Monad, which contains the token stream,
+    some functions on the ASM and functions for parsing the token stream.
+-}
+module AST.ASM where
+
+import AST.AST
+import AST.Span  (Span)
+import AST.Token
+
+-- -----------------------------------------------------------------------------
+-- *A*dd *P*osition *M*onad with functions
+-- -----------------------------------------------------------------------------
+
+-- |List containing tuples of positions and tokens: the token stream
+type SpanTokens = [(Span, Token)]
+
+-- |*A*dd *P*osition *M*onad
+type ASM a = SpanTokens -> (a, SpanTokens)
+
+returnP :: a -> ASM a
+returnP x ts = (x, ts)
+
+(>+=) :: ASM a -> (a -> ASM b) -> ASM b
+m >+= f = \ts -> let (a, ts') = m ts in f a ts'
+
+(>+) :: ASM a -> ASM b -> ASM b
+m >+ m' = m >+= \ _ -> m'
+
+(<$>) :: (a -> b) -> ASM a -> ASM b
+f <$> m = m >+= \x -> returnP (f x)
+
+(<*>) :: ASM (a -> b) -> ASM a -> ASM b
+mf <*> mx = mf >+= \f -> mx >+= \x -> returnP (f x)
+
+mapM :: (a -> ASM b) -> [a] -> ASM [b]
+mapM _ []     = returnP []
+mapM f (x:xs) = f x       >+= \ y  ->
+                mapM f xs >+= \ ys ->
+                returnP (y : ys)
+
+
+-- -----------------------------------------------------------------------------
+-- Functions for parsing the token stream
+-- -----------------------------------------------------------------------------
+
+-- |Read the next position without changing the state
+readSpan :: ASM Span
+readSpan ts@((p, _) : _) = (p, ts)
+readSpan [] = error "Token stream is empty."
+
+-- |Read the next token without changing the state
+readToken :: ASM Token
+readToken ts@((_, t) : _) = (t, ts)
+readToken [] = error "Token stream is empty."
+
+-- |Ensure a predicate. If predicate is `False`, fail.
+ensure :: Bool -> a -> ASM a
+ensure b x = if b
+               then returnP x
+               else error $ "Function `ensure` failed (AST.ASM). "
+                         ++ "This should have been returned: " ++ show x
+
+-- |Return position of token t
+tokenSpan :: Token -> ASM Span
+tokenSpan t = getTokenSpan >+= \(p, t') -> ensure (t == t') p
+
+-- |Get the next position, removing it from the state
+getTokenSpan :: ASM (Span, Token)
+getTokenSpan (t : ts) = (t, ts)
+getTokenSpan [] = error "Token stream is empty."
+
+-- |Get position of the next token which can be one of two possible alternatives
+tokenSpanOneOf :: Token -> Token -> ASM Span
+tokenSpanOneOf t1 t2 ((p,t') : ts)
+  | t1 == t'  = (p, ts)
+  | t2 == t'  = (p, ts)
+  | otherwise = error $ "expexted " ++ show t1 ++ " or "
+                     ++ show t2 ++ ", got " ++ show t'
+tokenSpanOneOf _ _ []  = error "Token stream is empty."
+
+-- |Parse a chain of expressions, separated by a Token, e.g. a list: [1,2,3]
+--  Process the expressions further with a function f, e.g. apLit
+sepBy :: (a -> ASM b) -> ASM Span -> [a] -> ASM ([b], [Span])
+sepBy f s ys = case ys of
+  []     -> returnP ([], [])
+  [x]    -> f x >+= \ px -> returnP ([px], [])
+  (x:xs) -> f     x      >+= \ px         ->
+            s            >+= \ ps         ->
+            sepBy f s xs >+= \ (pxs, pss) ->
+            returnP (px : pxs, ps : pss)
+
+-- |Parse an expression surrounded by some kind of opening and closing symbols
+between :: ASM a -> ASM b -> ASM c -> ASM (a, b, c)
+between open f close =
+  open  >+= \ po ->
+  f     >+= \ pf ->
+  close >+= \ pc ->
+  returnP (po, pf, pc)
+
+-- |Parse an expression that is surrounded by parens
+parens :: ASM a -> ASM (Span, a, Span)
+parens f = between (tokenSpan LeftParen) f (tokenSpan RightParen)
+
+-- |Parse an expression that is surrounded by brackets
+brackets :: ASM a -> ASM (Span, a, Span)
+brackets f = between (tokenSpan LeftBracket) f (tokenSpan RightBracket)
+
+-- |Parse an expression that is surrounded by braces
+braces :: ASM a -> ASM (Span, a, Span)
+braces f = between (tokenSpan LeftBrace) f (tokenSpan RightBrace)
+
+-- |Apply function to `Maybe`
+optional :: (a -> ASM b) -> Maybe a -> ASM (Maybe b)
+optional _ Nothing  = returnP Nothing
+optional f (Just x) = Just <$> f x
+
+-- |Get position of next token which is optional and one of two alternatives
+maybeOneOf :: Token -> Token -> ASM (Maybe Span)
+maybeOneOf t1 t2 ts@((p,t) : ts')
+  | t1 == t   = (Just p, ts')
+  | t2 == t   = (Just p, ts')
+  | otherwise = (Nothing, ts)
+maybeOneOf _ _ []  = error "Token stream is empty."
+
+-- |Return `Just` position of optional token or `Nothing`
+maybeTokenSpan :: Token -> ASM (Maybe Span)
+maybeTokenSpan t ts@((p,t') : ts')
+  | t == t'   = (Just p , ts')
+  | otherwise = (Nothing, ts )
+maybeTokenSpan _ []  = error "Token stream is empty."
+
+-- |Parse an expression that might be surrounded
+-- |by any kind of opening and closing symbols
+maybeEnclosedBy :: [(Token, Token)] -> ASM a
+                     -> ASM ((Maybe Span), a, (Maybe Span))
+maybeEnclosedBy [] f = f >+= \ pf -> returnP (Nothing, pf, Nothing)
+maybeEnclosedBy ((o, c):ocs) f =
+  readToken >+= \t -> if (t == o)
+                        then between (maybeTokenSpan o) f (maybeTokenSpan c)
+                        else maybeEnclosedBy ocs f
+
+-- |Parse an expression that might be surrounded by parens
+maybeParens :: ASM a -> ASM ((Maybe Span), a, (Maybe Span))
+maybeParens f = maybeEnclosedBy [(LeftParen, RightParen)] f

casc/AST/AST.curry

+{- |
+    Module      :  AST
+    Description :  Abstract Syntax Tree
+
+    This module contains the description of the curry abstract syntax tree (AST)
+    and useful functions on the elements of the AST.
+-}
+module AST.AST where
+
+import Char (isAlphaNum)
+import List (intercalate)
+
+import AST.Span (Pos)
+
+-- ---------------------------------------------------------------------------
+-- Types
+-- ---------------------------------------------------------------------------
+
+-- |Simple identifier
+data Ident = Ident
+  { idPosition :: Pos      -- ^ Source code 'Position'
+  , idName     :: String   -- ^ Name of the identifier
+  , idUnique   :: Int      -- ^ Unique number of the identifier
+  }
+
+-- |Qualified identifier
+data QualIdent = QualIdent
+  { qidModule :: Maybe ModuleIdent -- ^ optional module identifier
+  , qidIdent  :: Ident             -- ^ identifier itself
+  }
+
+-- | Module identifier
+data ModuleIdent = ModuleIdent
+  { midPosition   :: Pos      -- ^ source code 'Position'
+  , midQualifiers :: [String] -- ^ hierarchical idenfiers
+  }
+
+-- |Specified language extensions, either known or unknown.
+data Extension
+  = KnownExtension   Pos KnownExtension -- ^ a known extension
+  | UnknownExtension Pos String         -- ^ an unknown extension
+
+data KnownExtension
+  = AnonFreeVars       -- ^ anonymous free variables
+  | FunctionalPatterns -- ^ functional patterns
+  | NegativeLiterals   -- ^ negative literals
+  | NoImplicitPrelude  -- ^ no implicit import of the prelude
+
+-- |Different Curry tools which may accept compiler options.
+data Tool = KICS2 | PAKCS | CYMAKE | UnknownTool String
+
+
+-- ---------------------------------------------------------------------------
+-- Functions
+-- ---------------------------------------------------------------------------
+
+-- |Hierarchical module name
+moduleName :: ModuleIdent -> String
+moduleName = intercalate "." . midQualifiers
+
+-- |Hierarchical name of qualified Ident
+qidName :: QualIdent -> String
+qidName q = case q of
+  (QualIdent Nothing  i) -> idName i
+  (QualIdent (Just m) i) -> intercalate "." [(moduleName m), (idName i)]
+
+-- |Set position of ModuleIdent
+setMIdPos :: Pos -> ModuleIdent -> ModuleIdent
+setMIdPos p m = m { midPosition = p }
+
+-- |Set position of Ident
+setIdPos :: Pos -> Ident -> Ident
+setIdPos p i = i { idPosition = p }
+
+-- |Set position of QualIdent
+setQIdPos :: Pos -> QualIdent -> QualIdent
+setQIdPos p q = q { qidIdent = setIdPos p (qidIdent q) }
+
+-- |Check whether an 'Ident' identifies an infix operation
+isInfixOp :: Ident -> Bool
+isInfixOp (Ident _ s _) = all (`elem` "~!@#$%^&*+-=<>:?./|\\") s
+
+
+-- ---------------------------------------------------------------------------
+-- Definition of AST: Module
+-- ---------------------------------------------------------------------------
+
+-- |Curry module
+data Module = Module [ModulePragma] ModuleIdent (Maybe ExportSpec)
+                     [ImportDecl] [Decl]
+
+-- |Module pragma
+data ModulePragma
+  = LanguagePragma Pos [Extension]
+  | OptionsPragma  Pos (Maybe Tool) String
+
+
+-- |Export specification
+data ExportSpec = Exporting Pos [Export]
+
+-- |Single exported entity
+data Export
+  = Export         QualIdent
+  | ExportTypeWith QualIdent [Ident]
+  | ExportTypeAll  QualIdent
+  | ExportModule   ModuleIdent
+
+-- |Import declaration
+data ImportDecl = ImportDecl Pos ModuleIdent Qualified
+                             (Maybe ModuleIdent) (Maybe ImportSpec)
+
+-- |Flag to signal qualified import
+type Qualified = Bool
+
+-- |Import specification
+data ImportSpec
+  = Importing Pos [Import]
+  | Hiding    Pos [Import]
+
+-- |Single imported entity
+data Import
+  = Import         Ident
+  | ImportTypeWith Ident [Ident]
+  | ImportTypeAll  Ident
+
+-- ---------------------------------------------------------------------------
+-- Module interfaces
+-- ---------------------------------------------------------------------------
+
+-- | Module interface
+data Interface = Interface ModuleIdent [IImportDecl] [IDecl]
+
+-- |Interface import declaration
+data IImportDecl = IImportDecl Pos ModuleIdent
+
+-- |Arity of a function
+type Arity = Int
+
+-- |Interface declaration
+data IDecl
+  = IInfixDecl     Pos Infix Precedence  QualIdent
+  | HidingDataDecl Pos QualIdent [Ident]
+  | IDataDecl      Pos QualIdent [Ident] [ConstrDecl]  [Ident]
+  | INewtypeDecl   Pos QualIdent [Ident] NewConstrDecl [Ident]
+  | ITypeDecl      Pos QualIdent [Ident] TypeExpr
+  | IFunctionDecl  Pos QualIdent Arity   TypeExpr
+
+-- ---------------------------------------------------------------------------
+-- Declarations (local or top-level)
+-- ---------------------------------------------------------------------------
+
+-- |Declaration in a module
+data Decl
+  = InfixDecl    Pos Infix (Maybe Precedence) [Ident]
+  | DataDecl     Pos Ident [Ident] [ConstrDecl]
+  | NewtypeDecl  Pos Ident [Ident] NewConstrDecl
+  | TypeDecl     Pos Ident [Ident] TypeExpr
+  | TypeSig      Pos [Ident] TypeExpr
+  | FunctionDecl Pos Ident [Equation]
+  | ForeignDecl  Pos CallConv (Maybe String) Ident TypeExpr
+  | ExternalDecl Pos [Ident]
+  | PatternDecl  Pos Pattern Rhs
+  | FreeDecl     Pos [Ident]
+
+-- ---------------------------------------------------------------------------
+-- Infix declaration
+-- ---------------------------------------------------------------------------
+
+-- |Operator precedence
+type Precedence = Int
+
+-- |Fixity of operators
+data Infix
+  = InfixL -- ^ left-associative
+  | InfixR -- ^ right-associative
+  | Infix  -- ^ no associativity
+
+-- |Constructor declaration for algebraic data types
+data ConstrDecl
+  = ConstrDecl Pos [Ident] Ident [TypeExpr]
+  | ConOpDecl  Pos [Ident] TypeExpr Ident TypeExpr
+  | RecordDecl Pos [Ident] Ident [FieldDecl]
+
+-- |Constructor declaration for renaming types (newtypes)
+data NewConstrDecl
+  = NewConstrDecl Pos [Ident] Ident TypeExpr
+  | NewRecordDecl Pos [Ident] Ident (Ident, TypeExpr)
+
+-- |Declaration for labelled fields
+data FieldDecl = FieldDecl Pos [Ident] TypeExpr
+
+-- |Calling convention for C code
+data CallConv
+  = CallConvPrimitive
+  | CallConvCCall
+
+-- |Type expressions
+data TypeExpr
+  = ConstructorType QualIdent [TypeExpr]
+  | VariableType    Ident
+  | TupleType       [TypeExpr]
+  | ListType        TypeExpr
+  | ArrowType       TypeExpr TypeExpr
+  | ParenType       TypeExpr
+
+-- ---------------------------------------------------------------------------
+-- Functions
+-- ---------------------------------------------------------------------------
+
+-- |Equation
+data Equation = Equation Pos Lhs Rhs
+
+-- |Left-hand-side of an `Equation` (function identifier and patterns)
+data Lhs
+  = FunLhs Ident [Pattern]
+  | OpLhs  Pattern Ident Pattern
+  | ApLhs  Lhs [Pattern]
+
+-- |Right-hand-side of an `Equation`
+data Rhs
+  = SimpleRhs  Pos Expression [Decl]
+  | GuardedRhs [CondExpr] [Decl]
+
+-- |Conditional expression (expression conditioned by a guard)
+data CondExpr = CondExpr Pos Expression Expression
+
+-- |Literal
+data Literal
+  = Char   Char
+  | Int    Ident  Int
+  | Float  Float
+  | String String
+
+-- |Constructor term (used for patterns)
+data Pattern
+  = LiteralPattern     Literal
+  | NegativePattern    Ident Literal
+  | VariablePattern    Ident
+  | ConstructorPattern QualIdent [Pattern]
+  | InfixPattern       Pattern QualIdent Pattern
+  | ParenPattern       Pattern
+  | RecordPattern      QualIdent [Field Pattern]
+  | TuplePattern       [Pattern]
+  | ListPattern        [Pattern]
+  | AsPattern          Ident Pattern
+  | LazyPattern        Pattern
+  | FunctionPattern    QualIdent [Pattern]
+  | InfixFuncPattern   Pattern QualIdent Pattern
+
+-- |Expression
+data Expression
+  = Literal           Literal
+  | Variable          QualIdent
+  | Constructor       QualIdent
+  | Paren             Expression
+  | Typed             Expression TypeExpr
+  | Record            QualIdent [Field Expression]
+  | RecordUpdate      Expression [Field Expression]
+  | Tuple             [Expression]
+  | List              [Expression]
+  | ListCompr         Expression [Statement]
+  | EnumFrom          Expression
+  | EnumFromThen      Expression Expression
+  | EnumFromTo        Expression Expression
+  | EnumFromThenTo    Expression Expression Expression
+  | UnaryMinus        Ident Expression
+  | Apply             Expression Expression
+  | InfixApply        Expression InfixOp Expression
+  | LeftSection       Expression InfixOp
+  | RightSection      InfixOp Expression
+  | Lambda            [Pattern] Expression
+  | Let               [Decl] Expression
+  | Do                [Statement] Expression
+  | IfThenElse        Expression Expression Expression
+  | Case              CaseType Expression [Alt]
+
+-- |Infix operation
+data InfixOp
+  = InfixOp     QualIdent
+  | InfixConstr QualIdent
+
+-- |Statement (used for do-sequence and list comprehensions)
+data Statement
+  = StmtExpr Expression
+  | StmtDecl [Decl]
+  | StmtBind Pattern Expression
+
+-- |Type of case expressions
+data CaseType
+  = Rigid
+  | Flex
+
+-- |Single case alternative
+data Alt = Alt Pos Pattern Rhs
+
+-- |Record field
+data Field a = Field Pos QualIdent a

casc/AST/Ident.curry

+module AST.Ident where
+
+import AST.Span (Span, virtualSpan)
+
+-- |Simple identifier
+data Ident = Ident
+  { idSpan   :: Span     -- ^ Source code 'Span'
+  , idName   :: String   -- ^ Name of the identifier
+  , idUnique :: Int      -- ^ Unique number of the identifier
+  }
+
+-- |Qualified identifier
+data QualIdent = QualIdent
+  { qidModule :: Maybe ModuleIdent -- ^ optional module identifier
+  , qidIdent  :: Ident             -- ^ identifier itself
+  }
+
+-- | Module identifier
+data ModuleIdent = ModuleIdent
+  { midSpan       :: Span     -- ^ source code 'Span'
+  , midQualifiers :: [String] -- ^ hierarchical idenfiers
+  }
+
+-- |QualIdent that might have some kind of surrounding symbols,
+-- |e.g. parens or backticks
+-- 1. (Maybe Span) -  opening symbol like LeftParen or Backtick
+-- 2. (Maybe Span) -  closing symbol like RightParen or Backtick
+data SymIdent = SymIdent (Maybe Span) Ident (Maybe Span)
+
+data SymQualIdent = SymQualIdent (Maybe Span) QualIdent (Maybe Span)
+
+-- |Global scope for renaming
+globalScope :: Int
+globalScope = 0
+
+-- |Construct an 'Ident' from a 'String'
+mkIdent :: String -> Ident
+mkIdent x = Ident virtualSpan x globalScope
+
+mkSQIdent :: QualIdent -> SymQualIdent
+mkSQIdent qi = SymQualIdent Nothing qi Nothing
+
+-- | Convert an 'Ident' to a 'QualIdent'
+qualify :: Ident -> QualIdent
+qualify = QualIdent Nothing
+
+-- | Convert an 'Ident' to a 'QualIdent' with a given 'ModuleIdent'
+qualifyWith :: ModuleIdent -> Ident -> QualIdent
+qualifyWith = QualIdent . Just
+
+-- | Construct an 'Ident' for an n-ary tuple where n > 1
+tupleId :: Int -> Ident
+tupleId n
+  | n > 1     = mkIdent $ '(' : replicate (n - 1) ',' ++ ")"
+  | otherwise = error $ "ExtendAbstractCurry.tupleId: wrong arity " ++ show n
+
+-- | 'Ident' for the value '[]'
+nilId :: Ident
+nilId = mkIdent "[]"
+
+-- | 'Ident' for the function ':'
+consId :: Ident
+consId = mkIdent ":"
+
+-- | 'Ident' for the type/value unit ('()')
+unitId :: Ident
+unitId = mkIdent "()"
+
+-- | 'Ident' for the type '[]'
+listId :: Ident
+listId = mkIdent "[]"
+
+-- | 'QualIdent' for the type/value unit ('()')
+qUnitId :: QualIdent
+qUnitId = qualify unitId
+
+-- | 'QualIdent' for the type '[]'
+qListId :: QualIdent
+qListId = qualify listId
+
+-- | 'QualIdent' for the type of n-ary tuples
+qTupleId :: Int -> QualIdent
+qTupleId = qualify . tupleId
+
+-- | 'QualIdent' for the constructor '[]'
+qNilId :: QualIdent
+qNilId = qualify nilId
+
+-- | 'QualIdent' for the constructor ':'
+qConsId :: QualIdent
+qConsId = qualify consId
+
+qEnumFromId :: QualIdent
+qEnumFromId = qualifyWith preludeMIdent (mkIdent "enumFrom")
+
+qEnumFromThenId :: QualIdent
+qEnumFromThenId = qualifyWith preludeMIdent (mkIdent "enumFromThen")
+
+qEnumFromToId :: QualIdent
+qEnumFromToId = qualifyWith preludeMIdent (mkIdent "enumFromTo")
+
+qEnumFromThenToId :: QualIdent
+qEnumFromThenToId = qualifyWith preludeMIdent (mkIdent "enumFromThenTo")
+
+qNegateId :: QualIdent
+qNegateId = qualifyWith preludeMIdent (mkIdent "negate")
+
+qFlip :: QualIdent
+qFlip = qualifyWith preludeMIdent (mkIdent "flip")
+
+qIfThenElseId :: QualIdent
+qIfThenElseId = qualifyWith preludeMIdent (mkIdent "if_then_else")
+
+-- | 'ModuleIdent' for the Prelude
+preludeMIdent :: ModuleIdent
+preludeMIdent = ModuleIdent virtualSpan ["Prelude"]

casc/AST/PositionUtils.curry

+{- |
+    Module      :  AST.PositionUtils
+    Description :  Auxiliary functions for positions
+
+    This module provides some auxiliary functions concerning positions.
+-}
+module AST.PositionUtils where
+
+import qualified AST.Ident     as I
+import           AST.Span (Pos, Span, start, virtualPos)
+import           AST.SpanAST
+import           AST.Token
+
+-- |Return the line of a position
+line :: Pos -> Int
+line pos = fst pos
+
+-- |Return the column of a position
+col :: Pos -> Int
+col pos = snd pos
+
+-- |Check whether the columns in a list of positions are all equal
+allColEq :: [Pos] -> Bool
+allColEq xs = case xs of
+  [] -> True
+  _  -> all (== col (head xs)) (map col (tail xs))
+
+-- |Check whether the lines in a list of positions are all equal
+allLinesEq :: [Pos] -> Bool
+allLinesEq xs = case xs of
+  [] -> True
+  _  -> all (== line (head xs)) (map line (tail xs))
+
+-- |move given position by n columns
+moveColBy :: Pos -> Int -> Pos
+moveColBy (l,c) n = (l, c + n)
+
+--- |Change a position by a delta
+--- @param l  -  line
+--- @param c  -  column
+--- @param ml -  delta line
+--- @param mc -  delta column
+--- @return   -  input position changed by delta line and delta column
+
+relocate :: Pos -> (Int, Int) -> Pos
+relocate (l, c) (ml, mc) = (l + ml, c + mc)
+
+-- ----------------------------------------------------------------------------
+-- Get positions of AST elements
+-- ----------------------------------------------------------------------------
+
+-- |Get start position of QualIdent
+qidPos :: I.QualIdent -> Pos
+qidPos (I.QualIdent _ i) = idPos i
+
+-- |Get start position of Ident
+idPos :: I.Ident -> Pos
+idPos (I.Ident sp _ _) = start sp
+
+-- |Get start position of Ident that might be surrounded by
+-- |some kind of symbols, e.g. parens or backticks
+sidPos :: I.SymIdent -> Pos
+sidPos (I.SymIdent mpl i _) = case mpl of
+  Just pl -> start pl
+  Nothing -> idPos i
+
+-- |Get start position of QualIdent that might be surrounded by
+-- |some kind of symbols, e.g. parens or backticks
+sqidPos :: I.SymQualIdent -> Pos
+sqidPos (I.SymQualIdent mpl qi _) = case mpl of
+  Just pl -> start pl
+  Nothing -> qidPos qi
+
+-- |Get start position of Export
+exportPos :: Export -> Pos
+exportPos e = case e of
+  Export         qi          -> sqidPos qi
+  ExportTypeWith qi _  _ _ _ -> qidPos  qi
+  ExportTypeAll  qi _  _ _   -> qidPos  qi
+  ExportModule   _  mi       -> start (I.midSpan mi)
+
+-- |Get start position of Decl
+declPos :: Decl -> Pos