Aelve Codesearch

grep over package repositories
Please provide a string to search for.
3+ characters are required.
Index updated 5 hours ago

total matches: more than 1000

Advise-me-0.1
15 matches
src/Recognize/Model/Connectives.hs

-- | Negate the results of the predicate within a constraint.
negateConstraint :: Constraint EvBuilder [Attribute] -> Constraint EvBuilder [Attribute]
negateConstraint c = Constraint $ \xs -> fmap R.negate (getResult c xs)

-- Or for constraints
(<||>) :: Constraint EvBuilder [Attribute] -> Constraint EvBuilder [Attribute] -> Constraint EvBuilder [Attribute]
c1 <||> c2 = Constraint $ \xs -> do
  r1 <- getResult c1 xs

            
src/Recognize/Strategy/Derivation.hs

-- | For each step in a given derivation produce an attribute
fromDerivation :: (ToAttribute e, Show e) => Derivation (Rule (Context e)) (Context e) -> Maybe [Attribute]
fromDerivation = mapM ( \(a,r,b) -> fromRule r a b) . triples

-- | Given a rule, some type that the rule is applied to and the same type that is the result after applying the rule
-- produce an attribute describing this rule.
fromRule :: ToAttribute e => Rule (Context e) -> Context e -> Context e -> Maybe Attribute
fromRule r a b = matchRuleId (show $ getId r) >>= \rid -> toAttribute rid a b

            
src/Task/MagicTrick/Assess.hs
  generateEvidence (`buildStepsEvidence` me) appr attrs
  where
    -- sd = firstDiagnosis md
    attrs = map (snd . getValue) $ steps sd
    me = payload sd --Get the magic expression
    appr = approach sd

-- Unnecessary to verify arithmetic strategy constraints when the category is algebraic and vice versa.
buildStepsEvidence :: Approach -> Maybe Expr -> EvBuilder ()

            
src/Task/MagicTrick/Recognizer.hs
whereDidWeGoWrong ev =
   if nodeIsSet ans1 ev
   then ev
   else mappend ev . additionalEvidence . flip map [strat1,strat2,strat3,strat4] $ \strat ->
      if studentTried strat ev
      then whereDidItGoWrong strat
      else Nothing

   where

            
src/Task/MagicTrick/Recognizer.hs
   where

   additionalEvidence nodes = mconcat $ case catMaybes nodes of
      [] -> map (.=~ probMediumLow) [ans1Strat1Step1, ans1Strat2Step1, ans1Strat3Step1, ans1Strat4Step1]
      other -> map (.=~ probLow) other

   studentTried :: [Node a] -> Evidence -> Bool
   studentTried strat ev' = any (flip nodeIsSet ev') strat 

   whereDidItGoWrong :: [Node a] -> Maybe (Node a)

            
src/Task/MagicTrick/Recognizer.hs
   applyTransformation :: (Evidence -> Bool, Evidence) -> Evidence -> Evidence
   applyTransformation (ante, post) ev = 
      case ante ev of
         True -> ev `mappend` post
         False -> ev



pDiagnosis :: SEParser Diagnosis

            
src/Task/MagicTrick/Recognizer.hs
       _ -> True) . universe) (take 3 es')

pMagicExpr :: SEParser Expr
pMagicExpr = withInputList (guessMagicExpr . mapMaybe getExpr)

pVars :: SEParser [String]
pVars = withInput (nub . concatMap vars . mapMaybe getExpr)

pAnnounce :: [String] -> Expr -> SEParser ()
pAnnounce vs x = () <$ many (() <$ pExpr x
                         <|> choice [ pEq $ Var v :==: x | v <-  vs ] )


            
src/Task/MagicTrick/Recognizer.hs
  (a,st) <- pStepsFor x x (if x == 0 then taskIfZero else task x)

  res <- pConclude vs (nub [x,a]) a
  let attrs = map getAttributes st
  return Diagnosis
    { category = case x of { (Var _) -> Algebraic ; _ -> Numerical }
    , correctResult = res == 7 -- result is correct
    , resultIsSimplified = nf res == res -- nf result == result
    , parenthesisMismatch = any (elem NonMatchingParentheses) attrs

            
src/Task/MagicTrick/Recognizer.hs
taskIfZero = [Add 8, Mul 3, Sub 4, Div 4, Add 2]

expandOps :: [Op] -> [Attribute]
expandOps = map Expand

taskExpand :: Expr -> [Attribute]
taskExpand = map Expand . task

taskForget :: Expr -> [Attribute]
taskForget = map Forget . task

-- | Pipeline for recognition
--
-- The pipeline consists of 4 phases:
--

            
src/Task/MagicTrick/Recognizer.hs
pStepOperators x a ops = do
  m <- withInput head
  (e,as) <- pStep x a ops
  let as' = map Expand ops ++ as
  return (e, smallStep (newId "") (m,as'))

pStepError :: Expr -- ^ magic expression
                -> Expr -- ^ the current expression
                -> [Op] -- ^ list of operators to be added

            
src/Task/MagicTrick/Recognizer.hs
    )
  |> pIf (not $ null ops) (pNextStepBuggyPars a b)
 where
   b' = foldl (flip fromOp') a (map (substOp x) ops) -- b is a buggy parenthesis step
   b = formExpr x a ops

pStepSimplify :: Expr -- ^ magic expression
              -> Expr -- ^ the current expression
              -> SEParser (Expr, [Attribute])

            
src/Task/MagicTrick/Recognizer.hs
-- quick and dirty
noPars :: Expr -> [Expr]
noPars e = (if oTryManyBuggyPars then id else take 1) $ -- use take 1 to speed up the recognizer
            mapMaybe f (dropParensString (show e))
  where
    f s = case myparseExpr s of
      Just new | new /= e -> Just new
      _ -> Nothing


            
src/Task/MagicTrick/Recognizer.hs
      _ -> Nothing

    myparseExpr s =
      case mapMaybe getExpr (snd $ parseMath mathParserOptions s) of
          [m] -> Just m
          _ -> Nothing


-- drop sets of corresponding parentheses

            
src/Task/MagicTrick/Recognizer.hs
  where
    rec ps [] = [ "" | null ps ]
    rec ps (x:xs)
      | x == '('  = rec (False:ps) xs ++ map (x:) (rec (True:ps) xs)
      | x == ')'  = if null ps
                    then []
                    else if head ps
                          then map (x:) (rec (drop 1 ps) xs)
                          else rec (drop 1 ps) xs
      | otherwise = map (x:) (rec ps xs)

pFixEqCom :: Equation Expr -- ^ expected
          -> SEParser (Expr, [Attribute])
pFixEqCom e = peekEq >>= \eq -> pLog ("pFixEqCom: " ++ show e ++ " | " ++ show eq) >> pMatchEq e eq


            
src/Task/MagicTrick/Recognizer.hs
-- This function will check that there was at least one common step in simplification.
hasCommonality :: [Attribute] -> [Attribute] -> Bool
hasCommonality xs ys =
  let xs' = map nfa xs
      ys' = map nfa ys
  in any (`elem` xs') ys'

  where
    nfa (ARule i a b) = ARule i (N.map nfComAssoc a) (nfComAssoc b)
    nfa r = r

            
Agda-2.6.0.1
1 matches
src/full/Agda/Compiler/Treeless/Identity.hs
        TVar x | x >= k    -> IdIn [x - k]
               | otherwise -> notId
        TLet _ b           -> go (k + 1) b
        TCase _ _ d bs     -> sconcat (go k d :| map (goAlt k) bs)
        TApp (TDef f) args
          | f == q         -> IdIn [ y | (TVar x, y) <- zip (reverse args) [0..], y + k == x ]
        TCoerce v          -> go k v
        TApp{}             -> notId
        TLam{}             -> notId

            
BNFC-2.8.3
14 matches
src/BNFC/Backend/Agda.hs
import qualified Data.List.NonEmpty as NEList
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (mapMaybe, isJust, fromJust)
import Data.Set (Set)
import qualified Data.Set as Set

import BNFC.CF
import BNFC.Backend.Base           (Backend, mkfile)

            
src/BNFC/Backend/Agda.hs
  , imports YesImportNumeric False
  , if usesString then hsep [ "String", equals, listT, charT ] else empty
  , importPragmas [amod, unwords [ pmod, "(printTree)" ]]
  , vsep $ map prToken tcats
  , absyn NamedArg dats
  -- , allTokenCats printToken tcats  -- seem to be included in printerCats
  , printers printerCats
  , empty -- Make sure we terminate the file with a new line.
  ]

            
src/BNFC/Backend/Agda.hs
  tcats = specialCats cf
  -- Bind printers for the following categories (involves lists and literals).
  printerCats :: [Cat]
  printerCats = map fst (getAbstractSyntax cf) ++ map TokenCat (cfgLiterals cf)
  usesString = "String" `elem` cfgLiterals cf


-- | Generate parser bindings for Agda.
--

            
src/BNFC/Backend/Agda.hs
  ]
  where
  cs :: [String]
  cs = mapMaybe baseCat cats
  baseCat :: Cat -> Maybe String
  baseCat = \case
    Cat s         -> Just s
    CoercCat s _  -> Just s
    TokenCat "Char" -> Nothing

            
src/BNFC/Backend/Agda.hs
  :: ImportNumeric -- ^ Import also numeric types?
  -> Bool          -- ^ If have layout, import booleans.
  -> Doc
imports numeric layout = vcat . map prettyImport . concat $
  [ when layout
    [ ("Agda.Builtin.Bool",   [("Bool", boolT)]) ]
  , [ ("Agda.Builtin.Char",   [("Char", charT)]) ]
  , when (numeric == YesImportNumeric) importNumeric
  , [ ("Agda.Builtin.List",   [("List", listT)])

            
src/BNFC/Backend/Agda.hs
    ]
  prettyImport :: (String, [(String, Doc)]) -> Doc
  prettyImport (m, ren) = prettyList 2 pre lparen rparen semi $
    map (\ (x, d) -> hsep [text x, "to", d ]) ren
    where
    pre = hsep [ "open", "import", text m, "using", "()", "renaming" ]

-- | Import Agda AST.
--

            
src/BNFC/Backend/Agda.hs
  :: String    -- ^ Module for Agda AST.
  -> [String]  -- ^ Agda data types to import.
  -> Doc
importCats m cs = prettyList 2 pre lparen rparen semi $ map text cs
  where
  pre = hsep [ "open", "import", text m, "using" ]

-- | Import pragmas.
--

            
src/BNFC/Backend/Agda.hs
importPragmas
  :: [String]  -- ^ Haskell modules to import.
  -> Doc
importPragmas mods = vcat $ map imp $ [ "qualified Data.Text" ] ++ mods
  where
  imp s = hsep [ "{-#", "FOREIGN", "GHC", "import", text s, "#-}" ]

-- * Bindings for the AST.


            
src/BNFC/Backend/Agda.hs
--
absyn :: ConstructorStyle -> [Data] -> Doc
absyn _style [] = empty
absyn style  ds = vsep . ("mutual" :) . concatMap (map (nest 2) . prData style) $ ds

-- | Pretty-print Agda data types and pragmas for AST.
--
-- >>> vsep $ prData UnnamedArg (Cat "Nat", [ ("Zero", []), ("Suc", [Cat "Nat"]) ])
-- data Nat : Set where

            
src/BNFC/Backend/Agda.hs
prettyData :: ConstructorStyle -> String -> [(Fun, [Cat])] -> Doc
prettyData style d cs = vcat $
  [ hsep [ "data", text d, colon, "Set", "where" ] ] ++
  map (nest 2 . prettyConstructor style d) cs

-- | Generate pragmas to bind Haskell AST to Agda.
--
-- >>> pragmaData "Empty" []
-- {-# COMPILE GHC Empty = data Empty () #-}

            
src/BNFC/Backend/Agda.hs
--
pragmaData :: String -> [(Fun, [Cat])] -> Doc
pragmaData d cs = prettyList 2 pre lparen (rparen <+> "#-}") "|" $
  map (prettyFun . fst) cs
  where
  pre = hsep [ "{-#", "COMPILE", "GHC", text d, equals, "data", text d ]

-- | Pretty-print since rule as Agda constructor declaration.
--

            
src/BNFC/Backend/Agda.hs
-- c : A → B → C → D
-- >>> prettyConstructor undefined  "D" ("c1", [])
-- c1 : D
-- >>> prettyConstructor NamedArg "Stm" ("SIf", map Cat ["Exp", "Stm", "Stm"])
-- sIf : (e : Exp) (s₁ s₂ : Stm) → Stm
--
prettyConstructor :: ConstructorStyle -> String -> (Fun,[Cat]) -> Doc
prettyConstructor _style d (c, []) = hsep $
  [ prettyCon c

            
src/BNFC/Backend/Agda.hs
-- >>> prettyConstructorArgs UnnamedArg [Cat "A", Cat "B", Cat "C"]
-- A → B → C
--
-- >>> prettyConstructorArgs NamedArg (map Cat ["Exp", "Stm", "Stm"])
-- (e : Exp) (s₁ s₂ : Stm)
--
prettyConstructorArgs :: ConstructorStyle -> [Cat] -> Doc
prettyConstructorArgs style as =
  case style of

            
src/BNFC/Backend/Agda.hs
prettyConstructorArgs style as =
  case style of
    UnnamedArg -> hsep $ List.intersperse arrow ts
    NamedArg   -> hsep $ map (\ (x :| xs, t) -> parens (hsep [x, hsep xs, colon, t])) tel
  where
  ts  = map prettyCat as
  ns  = map (text . subscript) $ numberUniquely $ map nameSuggestion as
  tel = aggregateOn (render . snd) $ zip ns ts
  subscript (m, s) = maybe s (\ i -> s ++ [chr (ord '₀' + i)]) m
  -- Aggregate consecutive arguments of the same type.
  aggregateOn :: Eq c => ((a,b) -> c) -> [(a,b)] -> [(NEList a,b)]
  aggregateOn f