module Console.Garepinoh.Preludes
( abstractPrelude
, floatingPrelude
, boolPrelude
) where
import Console.Garepinoh.Types
import Console.Garepinoh.Utils
abstractPrelude :: (Read t, Show t, Eq t) => Prelude t
abstractPrelude =
[ Func
{ symb = NEL "swap" ["swp","s"]
, func = [ Fun $ const $ \case
(a:b:es) -> Right (b:a:es)
_ -> Left "swap expects two elements."
]
}
, Func
{ symb = NEL "drop" ["drp","d"]
, func = [ Fun $ const $ \case
(_:es) -> Right es
_ -> Left "drop expects an element."
]
}
, Func
{ symb = NEL "flip" []
, func = [ Fun $ const $ \case
(Fu (Func (NEL sy _) fu)):es -> Right $ (:es) $ Fu $ Func
(NEL ("flip "++sy) [])
(Ref "swap":fu)
_ -> Left "flip expects one argument, being a function."
]
}
, Func
{ symb = NEL "emptylist" ["el","[]"]
, func = [ Fun $ const $ Right . (Li []:)
]
}
, Func
{ symb = NEL "cons" ["#",":"]
, func = [ Fun $ const $ \case
x:Li l:es -> Right $ (:es) $ Li (l++[x])
_ -> Left "cons expects two arguments, the second being a list."
]
}
, Func
{ symb = NEL "dup" ["duplicate"]
, func = [ Fun $ const $ \case
a:es -> Right (a:a:es)
_ -> Left "dup expects one argument."
]
}
, Func
{ symb = NEL "map" []
, func = [ Fun $ \p -> \case
f:Li l:es ->
fmap
((:es) . Li . concat)
(mapM (apply p f . return) l)
_ -> Left "map expects two arguments, the second being a list."
]
}
, Func
{ symb = NEL "curry" [",","c"]
, func = [ Fun $ \p -> \case
(f@(Fu (Func (NEL sy _) fu)):x:es) ->
case apply p f [x] of
Right resultStack -> Right (resultStack++es)
Left _ -> Right $ (:es) $ Fu $
Func (NEL (sy++" "++show x) []) (Ele x:fu)
_ -> Left $ "curry expects two arguments, "
++ "the first being a function."
]
}
, Func
{ symb = NEL "apply" ["$","a"]
, func = [ Fun $ \p -> \case
(f:es) -> apply p f es
_ -> Left $ "apply expects two arguments, "
++ "the first being a function."
]
}
, Func
{ symb = NEL "id" ["identity"]
, func = [ Fun $ const Right
]
}
, Func
{ symb = NEL "geneq" ["generalequality"]
, func = [ Fun $ const $ \case
t:e:a:a':es -> Right $ (:es) $ if a == a' then t else e
_ -> Left $ "generalequality expects four arguments."
]
}
, Func
{ symb = NEL "appendlist" ["unlist"]
, func = [ Fun $ const $ \case
Li l:es -> Right $ l++es
_ -> Left $ "appendlist expects one argument, being a list."
]
}
, Func
{ symb = NEL "." ["functioncomposition","comp","∘"]
, func = [ Fun $ const $ \case
Fu (Func (NEL fsy _) fhs):Fu (Func (NEL gsy _) ghs):es ->
Right $ (:es) $ Fu $ Func (NEL ("("++unwords [gsy,fsy,"∘"]++")") []) (ghs++fhs)
_ -> Left $ "appendlist expects one argument, being a list."
]
}
]
floatingPrelude :: (Show t, Read t, Eq t, Floating t) => Prelude t
floatingPrelude = abstractPrelude ++
[ Func
{ symb = NEL "addition" ["add","plus","+"]
, func = [ Fun $ const $ \case
(Va a:Va b:es) -> Right $ (:es) $ Va $ a+b
_ -> Left "addition expects two arguments, both being values."
]
}
, Func
{ symb = NEL "subtraction" ["-","minus","take","subtract"]
, func = [ Fun $ const $ \case
(Va a:Va b:es) -> Right $ (:es) $ Va $ ab
_ -> Left "subtraction expects two arguments, both being values."
]
}
, Func
{ symb = NEL "multiplication" ["times","*","·","×"]
, func = [ Fun $ const $ \case
(Va a:Va b:es) -> Right $ (:es) $ Va $ a*b
_ -> Left "multiplication expects two arguments, both being values."
]
}
, Func
{ symb = NEL "division" ["div","/","%","\\","÷"]
, func = [ Fun $ const $ \case
(Va a:Va b:es) -> Right $ (:es) $ Va $ a/b
_ -> Left "division expects two arguments, both being values."
]
}
, Func
{ symb = NEL "exponentiation" ["pow","power","^","**"]
, func = [ Fun $ const $ \case
(Va a:Va b:es) -> Right $ (:es) $ Va $ a**b
_ -> Left "exponentiation expects two arguments, both being values."
]
}
, Func
{ symb = NEL "logarithm" ["log","logbase","?"]
, func = [ Fun $ const $ \case
(Va a:Va b:es) -> Right $ (:es) $ Va $ logBase a b
_ -> Left "logarithm expects two arguments, both being values."
]
}
, Func
{ symb = NEL "pi" ["π"]
, func = [ Fun $ const $ Right . (Va pi:)
]
}
, Func
{ symb = NEL "e" ["euler"]
, func = [ Fun $ const $ Right . (Va (exp 1):)
]
}
, Func
{ symb = NEL "i" []
, func = [ Ele $ Va $ sqrt (1)
]
}
, Func
{ symb = NEL "sqrt" []
, func = [ Fun $ const $ \case
(Va a:es) -> Right $ (:es) $ Va $ sqrt a
_ -> Left "sqrt expects one argument, being a value."
]
}
, Func
{ symb = NEL "bool" ["tei","thenelseif"]
, func = [ Fun $ const $ \case
t:e:Va i:es -> Right $ if i /= 0 then t:es else e:es
_ -> Left "bool expects three argument, the third being a value."
]
}
]
boolPrelude :: Prelude Bool
boolPrelude = abstractPrelude ++
[ Func
{ symb = NEL "conjunction" ["and","&","&&","∧"]
, func = [ Fun $ const $ \case
(Va a:Va b:es) -> Right (Va (a && b):es)
_ -> Left "conjunction expects two arguments, both being values."
]
}
, Func
{ symb = NEL "disjunction" ["or","|","||","∨"]
, func = [ Fun $ const $ \case
(Va a:Va b:es) -> Right (Va (a || b):es)
_ -> Left "disjunction expects two arguments, both being values."
]
}
, Func
{ symb = NEL "not" ["-","~","¬"]
, func = [ Fun $ const $ \case
(Va a:es) -> Right (Va (not a):es)
_ -> Left "not expects one arguments, being a value."
]
}
, Func
{ symb = NEL "nand" []
, func = [ Ref "and"
, Ref "not"
]
}
, Func
{ symb = NEL "bool" ["tei","thenelseif"]
, func = [ Fun $ const $ \case
t:e:Va i:es -> Right $ if i then t:es else e:es
_ -> Left "bool expects one argument, being a value."
]
}
, Func
{ symb = NEL "true" ["t","1"]
, func = [ Ele (Va True)
]
}
, Func
{ symb = NEL "false" ["f","0"]
, func = [ Ele (Va False)
]
}
]