curly-core-0.7.2: The core libraries for the Curly compiler.

Safe HaskellNone
LanguageHaskell2010

Curly.Core

Contents

Synopsis

Expressions

data ExprNode s a Source #

The type of an expression node

This type is used in combination with others within Free functors to model expressions with different attributes.

Constructors

Apply a a 
Lambda s a 

Instances

HasIdents s s' (ExprNode s a) (ExprNode s' a) Source # 

Methods

ff'idents :: FixFold s s' (ExprNode s a) (ExprNode s' a) Source #

(Serializable Bytes a, Serializable Bytes s) => Serializable Bytes (Free (ExprNode s) a) Source # 
(Serializable Bytes a, Serializable Bytes s) => Serializable Bytes (ExprNode s a) Source # 
(Format Bytes a, Format Bytes s) => Format Bytes (Free (ExprNode s) a) Source # 

Methods

datum :: Parser Bytes (Free (ExprNode s) a) #

(Format Bytes a, Format Bytes s) => Format Bytes (ExprNode s a) Source # 

Methods

datum :: Parser Bytes (ExprNode s a) #

Functor (ExprNode s) Source # 

Methods

map :: (a -> b) -> ExprNode s a -> ExprNode s b #

Foldable (ExprNode s) Source # 

Methods

fold :: Monoid m => ExprNode s m -> m #

Traversable (ExprNode s) Source # 

Methods

sequence :: Applicative f => ExprNode s (f a) -> f (ExprNode s a) #

(Eq s, Eq a) => Eq (ExprNode s a) Source # 

Methods

(==) :: ExprNode s a -> ExprNode s a -> Bool #

(/=) :: ExprNode s a -> ExprNode s a -> Bool #

(Ord s, Ord a) => Ord (ExprNode s a) Source # 

Methods

compare :: ExprNode s a -> ExprNode s a -> Ordering #

(<) :: ExprNode s a -> ExprNode s a -> Bool #

(<=) :: ExprNode s a -> ExprNode s a -> Bool #

(>) :: ExprNode s a -> ExprNode s a -> Bool #

(>=) :: ExprNode s a -> ExprNode s a -> Bool #

max :: ExprNode s a -> ExprNode s a -> ExprNode s a #

min :: ExprNode s a -> ExprNode s a -> ExprNode s a #

(Show s, Show a) => Show (ExprNode s a) Source # 

Methods

showsPrec :: Int -> ExprNode s a -> ShowS #

show :: ExprNode s a -> String #

showList :: [ExprNode s a] -> ShowS #

Generic (ExprNode s a) Source # 

Associated Types

type Rep (ExprNode s a) :: * -> * #

Methods

from :: ExprNode s a -> Rep (ExprNode s a) x #

to :: Rep (ExprNode s a) x -> ExprNode s a #

(NFData s, NFData a) => NFData (ExprNode s a) Source # 

Methods

rnf :: ExprNode s a -> () #

(Documented s, Documented a) => Documented (Expression s a) Source # 
Semantic (Free (ExprNode s) a) s a Source # 

Methods

semNode :: Iso' (Free (ExprNode s) a) (SemanticT (Free (ExprNode s) a) s a) Source #

type Rep (ExprNode s a) Source # 

type Expression s a = Free (ExprNode s) a Source #

The type of a simple Curly expression

class (Ord s, Show s, NFData s) => Identifier s where Source #

The class of Curly identifiers, used mainly to simplify type signatures.

Minimal complete definition

pureIdent, identName

class HasIdents s s' t t' | t t' -> s s' where Source #

A useful class for identifier-filled types

Minimal complete definition

ff'idents

Methods

ff'idents :: FixFold s s' t t' Source #

Instances

HasIdents s s' t t' => HasIdents s s' (Maybe t) (Maybe t') Source # 

Methods

ff'idents :: FixFold s s' (Maybe t) (Maybe t') Source #

(Ord s, Ord s') => HasIdents s s' (Type s) (Type s') Source # 

Methods

ff'idents :: FixFold s s' (Type s) (Type s') Source #

Ord s' => HasIdents s s' (TypeShape s) (TypeShape s') Source # 

Methods

ff'idents :: FixFold s s' (TypeShape s) (TypeShape s') Source #

HasIdents s s' (TypeIndex s) (TypeIndex s') Source # 

Methods

ff'idents :: FixFold s s' (TypeIndex s) (TypeIndex s') Source #

HasIdents s s' (TypeClass s) (TypeClass s') Source # 

Methods

ff'idents :: FixFold s s' (TypeClass s) (TypeClass s') Source #

HasIdents s s' (Strictness s) (Strictness s') Source # 

Methods

ff'idents :: FixFold s s' (Strictness s) (Strictness s') Source #

(Identifier s, Identifier s') => HasIdents s s' (Symbol s) (Symbol s') Source # 

Methods

ff'idents :: FixFold s s' (Symbol s) (Symbol s') Source #

HasIdents s s' (s, a) (s', a) Source # 

Methods

ff'idents :: FixFold s s' (s, a) (s', a) Source #

HasIdents s s' (ExprNode s a) (ExprNode s' a) Source # 

Methods

ff'idents :: FixFold s s' (ExprNode s a) (ExprNode s' a) Source #

(Traversable f, HasIdents s s' (f (Free f' a)) (f' (Free f' a))) => HasIdents s s' (Free f a) (Free f' a) Source # 

Methods

ff'idents :: FixFold s s' (Free f a) (Free f' a) Source #

(Identifier s, Identifier s') => HasIdents s s' (InstanceMap s a) (InstanceMap s' a) Source # 

Methods

ff'idents :: FixFold s s' (InstanceMap s a) (InstanceMap s' a) Source #

(Identifier s, Identifier s') => HasIdents s s' (NameNode s a) (NameNode s' a) Source # 

Methods

ff'idents :: FixFold s s' (NameNode s a) (NameNode s' a) Source #

(Identifier s, Identifier s') => HasIdents s s' (AnnNode s a) (AnnNode s' a) Source # 

Methods

ff'idents :: FixFold s s' (AnnNode s a) (AnnNode s' a) Source #

(Identifier s, Identifier s') => HasIdents s s' (ModLeaf s a) (ModLeaf s' a) Source # 

Methods

ff'idents :: FixFold s s' (ModLeaf s a) (ModLeaf s' a) Source #

(Traversable f, HasIdents s s' (g a) (g' a), HasIdents s s' (f (g' a)) (f' (g' a))) => HasIdents s s' ((:.:) f g a) ((:.:) f' g' a) Source # 

Methods

ff'idents :: FixFold s s' ((f :.: g) a) ((f' :.: g') a) Source #

data Builtin Source #

The type of all Curly builtins

Instances

Eq Builtin Source # 

Methods

(==) :: Builtin -> Builtin -> Bool #

(/=) :: Builtin -> Builtin -> Bool #

Ord Builtin Source # 
Show Builtin Source # 
Generic Builtin Source # 

Associated Types

type Rep Builtin :: * -> * #

Methods

from :: Builtin -> Rep Builtin x #

to :: Rep Builtin x -> Builtin #

NFData Builtin Source # 

Methods

rnf :: Builtin -> () #

Documented Builtin Source # 
Serializable Bytes Builtin Source # 
Format Bytes Builtin Source # 
type Rep Builtin Source # 
type Rep Builtin = D1 (MetaData "Builtin" "Curly.Core" "curly-core-0.7.2-5Alk9IYXOqrI6xJCLJNJpU" False) ((:+:) ((:+:) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "B_Undefined" PrefixI False) U1) (C1 (MetaCons "B_Seq" PrefixI False) U1)) ((:+:) (C1 (MetaCons "B_Unit" PrefixI False) U1) (C1 (MetaCons "B_Number" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int))))) ((:+:) ((:+:) (C1 (MetaCons "B_AddInt" PrefixI False) U1) (C1 (MetaCons "B_SubInt" PrefixI False) U1)) ((:+:) (C1 (MetaCons "B_MulInt" PrefixI False) U1) ((:+:) (C1 (MetaCons "B_DivInt" PrefixI False) U1) (C1 (MetaCons "B_CmpInt_LT" PrefixI False) U1))))) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "B_CmpInt_EQ" PrefixI False) U1) (C1 (MetaCons "B_String" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)))) ((:+:) (C1 (MetaCons "B_StringLength" PrefixI False) U1) (C1 (MetaCons "B_AddString" PrefixI False) U1))) ((:+:) ((:+:) (C1 (MetaCons "B_ShowInt" PrefixI False) U1) (C1 (MetaCons "B_Bytes" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bytes)))) ((:+:) (C1 (MetaCons "B_MkArray" PrefixI False) U1) ((:+:) (C1 (MetaCons "B_ArrayLength" PrefixI False) U1) (C1 (MetaCons "B_ArrayAt" PrefixI False) U1)))))) ((:+:) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "B_ArraySet" PrefixI False) U1) (C1 (MetaCons "B_SyntaxNode" PrefixI False) U1)) ((:+:) (C1 (MetaCons "B_SyntaxSym" PrefixI False) U1) (C1 (MetaCons "B_SyntaxExpr" PrefixI False) U1))) ((:+:) ((:+:) (C1 (MetaCons "B_SyntaxInd" PrefixI False) U1) (C1 (MetaCons "B_ExprLambda" PrefixI False) U1)) ((:+:) (C1 (MetaCons "B_ExprApply" PrefixI False) U1) ((:+:) (C1 (MetaCons "B_ExprSym" PrefixI False) U1) (C1 (MetaCons "B_ExprInd" PrefixI False) U1))))) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "B_FileDesc" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int))) (C1 (MetaCons "B_Open" PrefixI False) U1)) ((:+:) (C1 (MetaCons "B_Read" PrefixI False) U1) ((:+:) (C1 (MetaCons "B_Write" PrefixI False) U1) (C1 (MetaCons "B_Close" PrefixI False) U1)))) ((:+:) ((:+:) (C1 (MetaCons "B_Foreign" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Map String GlobalID))) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 GlobalID)))) (C1 (MetaCons "B_Relocatable" PrefixI False) ((:*:) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Hash))) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [(Bytes, BinaryRelocation)])) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bytes)))))) ((:+:) (C1 (MetaCons "B_RawIndex" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int))) ((:+:) (C1 (MetaCons "B_ShowExpr" PrefixI False) U1) (C1 (MetaCons "B_ShowSyntax" PrefixI False) U1)))))))

data SemanticT e i o Source #

Constructors

SemApply e e 
SemAbstract i e 
SemSymbol o 

class Semantic e i o | e -> i o where Source #

The class of all lambda-like expressions.

This class provides an abstraction of the different types used to represent expressions at the different stages of compilation.

This class provides three constructors and a destructor for its target type, allowing abstract pattern-matching to take place.

Minimal complete definition

semNode

Methods

semNode :: Iso' e (SemanticT e i o) Source #

Instances

Identifier s => Semantic (AnnExpr s) s (Symbol s) Source # 

Methods

semNode :: Iso' (AnnExpr s) (SemanticT (AnnExpr s) s (Symbol s)) Source #

Identifier s => Semantic (RawNameExpr s) s (s, NameTail s) Source # 
Identifier s => Semantic (NameExpr s) s (s, NameTail s) Source # 

Methods

semNode :: Iso' (NameExpr s) (SemanticT (NameExpr s) s (s, NameTail s)) Source #

Semantic (Free (ExprNode s) a) s a Source # 

Methods

semNode :: Iso' (Free (ExprNode s) a) (SemanticT (Free (ExprNode s) a) s a) Source #

mkAbstract :: Semantic e i o => i -> e -> e Source #

mkSymbol :: Semantic e i o => o -> e Source #

mkApply :: Semantic e i o => e -> e -> e Source #

sem :: Semantic e i o => e -> SemanticT e i o Source #

newtype LibraryID Source #

Constructors

LibraryID Chunk 

Instances

data GlobalID Source #

Constructors

GlobalID String (Maybe (String, LibraryID)) 

Instances

Eq GlobalID Source # 
Ord GlobalID Source # 
Show GlobalID Source # 
Generic GlobalID Source # 

Associated Types

type Rep GlobalID :: * -> * #

Methods

from :: GlobalID -> Rep GlobalID x #

to :: Rep GlobalID x -> GlobalID #

NFData GlobalID Source # 

Methods

rnf :: GlobalID -> () #

Documented GlobalID Source # 
Identifier GlobalID Source # 
Serializable Bytes GlobalID Source # 
Format Bytes GlobalID Source # 
type Rep GlobalID Source # 

pattern PatSymbol :: forall e i o. Semantic e i o => o -> e Source #

pattern PatAbstract :: forall e i o. Semantic e i o => i -> e -> e Source #

pattern PatApply :: forall e i o. Semantic e i o => e -> e -> e Source #

pattern PatApply2 :: forall e i o. Semantic e i o => e -> e -> e -> e Source #

t'Apply :: Semantic e i o => Traversal' e (e, e) Source #

t'Abstract :: Semantic e i o => Traversal' e (i, e) Source #

Utilities

syntax :: (Semantic e i o, Semantic e' i o'', Ord i) => (o -> o' -> o'') -> (o -> o') -> (o -> i) -> (Int -> o') -> e -> e' Source #

Tranform an expression into another, annotating it with contextual information.

semantic :: (Semantic e i o, Semantic e' i o) => e -> e' Source #

Transform a lambda-like expression into another

mapParams :: (Semantic e i o, Semantic e' i' o) => (i -> i') -> e -> e' Source #

Maps a function over lambda parameters in an expression

Environment

envVar :: String -> String -> String Source #

`envVar def var` retrieves a var from the environment, or returns def if the former doesn't exist

curlyKeysFile :: FilePath Source #

The path of the Curly key wallet

curlyCacheDir :: FilePath Source #

The path to the user's cache directory

curlyPort :: PortNumber Source #

The default Curly port for library proxies and the portmapper

Logging facilities

data LogLevel Source #

A Curly log level

Constructors

Quiet 
Chatty 
Verbose 
Debug 

Instances

addLogCallback :: (LogMessage -> IO ()) -> IO LogCallbackID Source #

removeLogCallback :: LogCallbackID -> IO () Source #

withLogCallback :: (LogMessage -> IO ()) -> IO a -> IO a Source #

logLine :: MonadIO m => LogLevel -> String -> m () Source #

Logs a line to stderr if the environment log level is greater than the given threshold

logAction :: MonadIO m => String -> IO a -> m a Source #

trylogLevel :: LogLevel -> IO a -> IO a -> IO a Source #

Runs an IO action, logging its errors if the given log level is lower than the environment

trylog :: IO a -> IO a -> IO a Source #

Same as tryLogLevel, with a log level of Debug

liftIOLog :: MonadIO m => IO () -> m () Source #

A utility function that lifts its argument while logging its errors

cyDebug :: Show a => a -> a Source #

Misc

data PortNumber :: * #

Use the Num instance (i.e. use a literal) to create a PortNumber value with the correct network-byte-ordering. You should not use the PortNum constructor. It will be removed in the next release.

>>> 1 :: PortNumber
1
>>> read "1" :: PortNumber
1

Instances

Enum PortNumber 
Eq PortNumber 
Integral PortNumber 
Num PortNumber 
Ord PortNumber 
Read PortNumber 
Real PortNumber 
Show PortNumber 
Storable PortNumber 
FormatArg PortNumber Source # 

watchFile :: FilePath -> IO () -> IO (IO ()) Source #

Sets a watch on the given file, on the usual signals

connectTo :: String -> PortNumber -> IO Handle Source #

A utility function that opens a client socket to the given server and port

(*+) :: (Ord k, Semigroup m) => Map k m -> Map k m -> Map k m Source #

Inclusive-or for Maps

cacheFileName Source #

Arguments

:: FilePath

A base directory

-> String

A file name

-> String

An extension

-> FilePath 

(</>) :: FilePath -> FilePath -> FilePath infixr 5 #

format :: FormatType r => String -> r Source #

A function that mimics sprintf-style formatting for Haskell