mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Evaluate Int literals.
This commit is contained in:
parent
99109bb57e
commit
694f73650a
@ -83,7 +83,7 @@ lineCol :: (Floating a, Ord a) => Colour a
|
||||
lineCol = lineC colorScheme
|
||||
|
||||
-- FUNCTIONS --
|
||||
|
||||
-- Optimization: The apply0NDia's can be memoized.
|
||||
iconToDiagram ::
|
||||
(RealFloat n, Typeable n, Renderable (Path V2 n) b,
|
||||
Renderable (Text n) b) =>
|
||||
|
30
app/Main.hs
30
app/Main.hs
@ -260,6 +260,8 @@ main3 = do
|
||||
]
|
||||
|
||||
testDecls = [
|
||||
"fact x = if ((==) 0 x) then 1 else (fact x ((-) 1 x))",
|
||||
"y x = if x then (if z then q else x) else w",
|
||||
"y x1 x2 x3 = if f x1 then g x2 else h x3",
|
||||
"y x1 x2 x3 = if x1 then x2 else x3",
|
||||
"y = if b then x else n",
|
||||
@ -269,20 +271,20 @@ testDecls = [
|
||||
"y = (\\x1 -> (\\x2 -> (\\x3 -> x1 x2 x3)))",
|
||||
"y x = (\\z -> x)",
|
||||
"y = (\\x -> (\\z -> x))",
|
||||
"y x = x"
|
||||
-- "y x = y x",
|
||||
-- "y x = g y y",
|
||||
-- "y f x = f x",
|
||||
-- "y x = x y"
|
||||
-- "y x1 x2 = f x1 x3 x2",
|
||||
-- "y x1 x2 = f x1 x2",
|
||||
-- "y x = f x1 x2",
|
||||
-- "y2 = f x1 x2 x3 x4",
|
||||
-- "y = x",
|
||||
-- "y = f x",
|
||||
-- "y = f (g x)",
|
||||
-- "y = f (g x1 x2) x3",
|
||||
-- "y = (f x1 x2) (g x1 x2)"
|
||||
"y x = x",
|
||||
"y x = y x",
|
||||
"y x = g y y",
|
||||
"y f x = f x",
|
||||
"y x = x y",
|
||||
"y x1 x2 = f x1 x3 x2",
|
||||
"y x1 x2 = f x1 x2",
|
||||
"y x = f x1 x2",
|
||||
"y2 = f x1 x2 x3 x4",
|
||||
"y = x",
|
||||
"y = f x",
|
||||
"y = f (g x)",
|
||||
"y = f (g x1 x2) x3",
|
||||
"y = (f x1 x2) (g x1 x2)"
|
||||
]
|
||||
|
||||
translateStringToDrawing :: String -> IO (Diagram B)
|
||||
|
@ -8,6 +8,7 @@ import Diagrams.Prelude((<>))
|
||||
|
||||
import Language.Haskell.Exts(Decl(..), parseDecl,
|
||||
Name(..), Pat(..), Rhs(..), Exp(..), QName(..), fromParseResult, Match(..)) --(parseFile, parse, ParseResult, Module)
|
||||
import qualified Language.Haskell.Exts as Exts
|
||||
import Control.Monad.State(State, evalState)
|
||||
import Data.List(partition)
|
||||
import qualified Control.Arrow
|
||||
@ -90,6 +91,13 @@ evalIf c e1 e2 e3 = do
|
||||
newGraph = IconGraph icons mempty mempty mempty <> combinedGraph
|
||||
pure (newGraph, NameAndPort guardName (Just 0))
|
||||
|
||||
evalLit :: Exts.Literal -> State IDState (IconGraph, NameAndPort)
|
||||
evalLit (Exts.Int x) = do
|
||||
let str = show x
|
||||
name <- DIA.toName <$> getUniqueName str
|
||||
let graph = IconGraph [(DIA.toName name, TextBoxIcon str)] mempty mempty mempty
|
||||
pure (graph, justName name)
|
||||
|
||||
evalExp :: EvalContext -> Exp -> State IDState (Either String (IconGraph, NameAndPort))
|
||||
evalExp c x = case x of
|
||||
Var n -> pure $ evalQName n c
|
||||
@ -97,6 +105,7 @@ evalExp c x = case x of
|
||||
Paren e -> evalExp c e
|
||||
Lambda _ patterns e -> Right <$> evalLambda c patterns e
|
||||
If e1 e2 e3 -> Right <$> evalIf c e1 e2 e3
|
||||
Lit l -> Right <$> evalLit l
|
||||
-- TODO other cases
|
||||
|
||||
-- | This is used by the rhs for identity (eg. y x = x)
|
||||
@ -220,6 +229,7 @@ evalDecl d = iconGraphToDrawing $ evalState evaluatedDecl initialIdState where
|
||||
FunBind matches -> evalMatches matches
|
||||
-- TODO other cases
|
||||
|
||||
-- Profiling: about 1.5% of time.
|
||||
translateString :: String -> (Drawing, Decl)
|
||||
translateString s = (drawing, decl) where
|
||||
parseResult = parseDecl s -- :: ParseResult Module
|
||||
|
Loading…
Reference in New Issue
Block a user