From 594ecf396cad8a38aac168062249ab3361c5b558 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Sun, 17 Dec 2017 22:30:06 +0100 Subject: Move old things out of the way --- interpreter.hs | 234 ----------------------------------------------------- main.hs | 55 ------------- old/interpreter.hs | 234 +++++++++++++++++++++++++++++++++++++++++++++++++++++ old/stdlib.hs | 16 ++++ stdlib.hs | 16 ---- test.hs | 16 ---- 6 files changed, 250 insertions(+), 321 deletions(-) delete mode 100644 interpreter.hs create mode 100644 old/interpreter.hs create mode 100644 old/stdlib.hs delete mode 100644 stdlib.hs delete mode 100644 test.hs diff --git a/interpreter.hs b/interpreter.hs deleted file mode 100644 index 4595035..0000000 --- a/interpreter.hs +++ /dev/null @@ -1,234 +0,0 @@ -{-# LANGUAGE TupleSections, DeriveFunctor, GeneralizedNewtypeDeriving #-} -module Interpreter(newContext, interpret, interpretProgram, Context) where - -import Control.Applicative -import Control.Monad -import Control.Monad.Except -import Control.Monad.State -import Data.List -import Data.Maybe -import qualified Data.Map.Strict as Map --- import Debug.Trace - -import AST -import Parser - - --- TODO: place bottom varmap separately for performance? (global define's in deeply nested contexts) -type VarMap = Map.Map Name Value -data Context = Context {varMapStk :: [VarMap]} - -newtype IM a = IM {unIM :: StateT Context (ExceptT String IO) a} - deriving (Functor, Applicative, Monad, MonadError String, MonadState Context, MonadIO) - -type Builtin = [Value] -> IM Value - -newContext :: Context -newContext = Context [Map.fromList [(k, VBuiltin k) | k <- Map.keys builtins]] - -lookupVar :: Name -> IM (Maybe Value) -lookupVar name = liftM (msum . map (Map.lookup name)) (gets varMapStk) - -withScopeMap :: VarMap -> IM a -> IM a -withScopeMap vm act = do - modify $ \ctx -> ctx {varMapStk = vm : varMapStk ctx} - x <- act - modify $ \ctx -> ctx {varMapStk = tail (varMapStk ctx)} - return x - -builtins :: Map.Map String Builtin -builtins = Map.fromList - [("read", readBuiltin), - ("eval", evalBuiltin), - ("print", printBuiltin), - ("getline", getlineBuiltin), - ("loop", loopBuiltin), - ("do", doBuiltin), - ("if", ifBuiltin), - ("define", defineBuiltin), - ("lambda", lambdaBuiltin), - ("match", matchBuiltin), - ("+", plusBuiltin), - ("-", arithBuiltin "-" (-) 0), ("*", arithBuiltin "*" (*) 1), - ("/", arithBuiltin "/" div 1), ("%", arithBuiltin "%" mod 1), - ("<", compareBuiltin "<" (<) (<)), ("<=", compareBuiltin "<=" (<=) (<=)), - (">", compareBuiltin ">" (>) (>)), (">=", compareBuiltin ">=" (>=) (>=)), - ("=", compareBuiltin "=" (==) (==)), ("!=", neqBuiltin)] - -nArguments :: String -> Int -> Bool -> Builtin -> Builtin -nArguments name n doeval f args - | length args /= n = - throwError $ "Function '" ++ name ++ "' expects " ++ naStr n ++ " but got " ++ naStr (length args) - | doeval = mapM evalValue args >>= f - | otherwise = f args - where - naStr 0 = "no arguments" - naStr 1 = "1 argument" - naStr num = show num ++ " arguments" - - -readBuiltin :: Builtin -readBuiltin = nArguments "read" 1 True go - where - go :: Builtin - go [VString s] = either (throwError . show) return $ parseExpression s - go _ = throwError "Can only 'read' a string" - -evalBuiltin :: Builtin -evalBuiltin = nArguments "eval" 1 True (evalValue . head) - -printBuiltin :: Builtin -printBuiltin args = do - args' <- mapM evalValue args - liftIO (putStrLn $ intercalate " " $ map printShow args') >> return (VList []) - where - printShow :: Value -> String - printShow (VString s) = s - printShow v = show v - -loopBuiltin :: Builtin -loopBuiltin = nArguments "loop" 1 False $ forever . evalValue . head - -getlineBuiltin :: Builtin -getlineBuiltin = nArguments "getline" 0 True $ const (liftIO getLine >>= return . VString) - -doBuiltin :: Builtin -doBuiltin [] = return (VList []) -doBuiltin args = fmap last $ mapM evalValue args - -ifBuiltin :: Builtin -ifBuiltin [cond, v1] = evalValue cond >>= \c -> if truthy c then evalValue v1 else return (VList []) -ifBuiltin [cond, v1, v2] = evalValue cond >>= \c -> if truthy c then evalValue v1 else evalValue v2 -ifBuiltin a = throwError $ "Cannot pass " ++ show (length a) ++ " arguments to 'if'" - -defineBuiltin :: Builtin -defineBuiltin [VName name, val] = do - val' <- evalValue val - stk <- gets varMapStk - let go [vm] _ = [Map.insert name val' vm] - go (vm : vms) (False : prs) = vm : go vms prs - go (vm : vms) (True : _) = Map.insert name val' vm : vms - go _ _ = undefined - modify $ \ctx -> ctx {varMapStk = go stk (map (isJust . Map.lookup name) stk)} - return (VList []) -defineBuiltin [name@(VName _), VList args, val] - | Just names <- mapM fromVName args = defineBuiltin [name, VLambda names val] - | otherwise = throwError "Invalid 'define' syntax: invalid argument list" -defineBuiltin _ = throwError "Invalid 'define' syntax" - -lambdaBuiltin :: Builtin -lambdaBuiltin = nArguments "lambda" 2 False go - where - go :: Builtin - go [VList args, body] - | Just names <- mapM fromVName args = return (VLambda names body) - | otherwise = throwError "Invalid 'lambda' syntax: invalid argument list" - go _ = throwError "Invalid 'lambda' syntax" - -matchBuiltin :: Builtin -matchBuiltin [] = throwError "Invalid 'match' syntax: empty match" -matchBuiltin [_] = throwError "Invalid 'match' syntax: no arms" -matchBuiltin (subject : arms) = do - subject' <- evalValue subject - go subject' arms - where - go :: Value -> [Value] -> IM Value - go _ [def] = evalValue def - go subject' (VList [pat, value] : rest) = - case match pat subject' Map.empty of - Nothing -> go subject' rest - Just mp -> withScopeMap mp (evalValue value) - go _ _ = throwError "Invalid 'match' syntax: invalid arm" - -plusBuiltin :: Builtin -plusBuiltin [] = return (VNum 0) -plusBuiltin args - | Just nums <- mapM fromVNum args = return (VNum (sum nums)) - | Just strs <- mapM maybeStrings args = return (VString (concat strs)) - | otherwise = throwError "Invalid argument types to operator '+'" - -arithBuiltin :: String -> (Int -> Int -> Int) -> Int -> Builtin -arithBuiltin name oper idelem args = do - args' <- mapM evalValue args - case mapM fromVNum args' of - Just [] -> return (VNum idelem) - Just (hd : tl) -> return (VNum (foldl oper hd tl)) - _ -> throwError $ "Invalid argument types to operator '" ++ name ++ "'" - -neqBuiltin :: Builtin -neqBuiltin = fmap (\(VNum x) -> VNum (1 - x)) . compareBuiltin "!=" (==) (==) - -compareBuiltin :: String -> (Int -> Int -> Bool) -> (String -> String -> Bool) -> Builtin -compareBuiltin name oper soper args = do - args' <- mapM evalValue args - res <- case () of - _ | Just nums <- mapM fromVNum args' -> return $ all (uncurry oper) (zip nums (tail nums)) - | Just strs <- mapM maybeStrings args' -> return $ all (uncurry soper) (zip strs (tail strs)) - | otherwise -> throwError $ "Invalid argument types to operator '" ++ name ++ "'" - return $ VNum $ fromIntegral $ fromEnum res - - -truthy :: Value -> Bool -truthy (VNum n) = n /= 0 -truthy _ = True - -match :: Value -> Value -> VarMap -> Maybe VarMap -match (VList []) (VList []) mp = Just mp -match (VList [VEllipsis]) (VList _) mp = Just mp -match (VList (pat : pats)) (VList (val : vals)) mp = match pat val mp >>= match (VList pats) (VList vals) -match (VName name) val mp = case Map.lookup name mp of - Nothing -> Just (Map.insert name val mp) - Just val' | val == val' -> Just mp - | otherwise -> Nothing -match (VQuoted a) (VQuoted b) mp = match a b mp -match (VLambda _ _) _ _ = Nothing -match a b mp | a == b = Just mp - | otherwise = Nothing - -maybeStrings :: Value -> Maybe String -maybeStrings = liftM2 (<|>) fromVString (fmap show . fromVNum) - - -evalValue :: Value -> IM Value --- evalValue v | traceShow v False = undefined -evalValue (VList exs) = listCall exs -evalValue e@(VNum _) = return e -evalValue e@(VString _) = return e -evalValue (VName name) = lookupVar name >>= \mval -> case mval of - Just value -> return value - Nothing -> throwError $ "Use of undefined variable '" ++ name ++ "'" -evalValue (VQuoted e) = return e -evalValue e@(VLambda _ _) = return e -evalValue e@(VBuiltin _) = return e -evalValue VEllipsis = throwError "Unexpected ellipsis in code" - -listCall :: [Value] -> IM Value -listCall [] = throwError "Cannot call ()" -listCall (hd : args) = evalValue hd >>= \hd' -> case hd' of - VLambda names body - | length names == length args -> do - args' <- mapM evalValue args - withScopeMap (Map.fromList (zip names args')) (evalValue body) - | otherwise -> throwError $ "Invalid number of arguments in call to lambda " ++ - "(" ++ show (length args) ++ " found, " ++ show (length names) ++ " needed)" - VBuiltin name -> - case Map.lookup name builtins of - Just f -> f args - Nothing -> throwError $ "Unknown builtin '" ++ name ++ "'" - v -> throwError $ "Cannot call value: " ++ show v - - -interpret :: Context -> Value -> IO (Either String (Value, Context)) -interpret ctx val = - runExceptT $ flip runStateT ctx $ unIM $ evalValue val - -interpretProgram :: Context -> Program -> IO (Either String Context) -interpretProgram rootctx (Program l) = go l rootctx - where - go :: [Value] -> Context -> IO (Either String Context) - go [] ctx = return (Right ctx) - go (val : vals) ctx = do - e <- interpret ctx val - case e of - Left err -> return (Left err) - Right (_, ctx') -> go vals ctx' diff --git a/main.hs b/main.hs index 51e5815..b7d351a 100644 --- a/main.hs +++ b/main.hs @@ -1,17 +1,11 @@ module Main where -import Data.Char -import Data.List -import System.Console.Readline import System.Environment import System.Exit -import System.IO.Error import Compiler -import Interpreter import Optimiser import Parser -import Stdlib import VM @@ -20,55 +14,6 @@ usage = do progname <- getProgName putStrLn $ "Usage: " ++ progname ++ " [filename.lisp]" -repl :: Context -> IO () -repl ctx = do - mline <- fmap (fmap strip) (readline "> ") - case mline of - Nothing -> putStrLn "" - Just "" -> repl ctx - Just (';' : _) -> repl ctx - Just line -> do - addHistory line - case parseExpression line of - Right val -> do - ires <- interpret ctx val - case ires of - Right (retval, ctx') -> do - putStrLn $ "\x1B[36m" ++ show retval ++ "\x1B[0m" - repl ctx' - Left err -> do - putStrLn $ "\x1B[31;1mError: " ++ err ++ "\x1B[0m" - repl ctx - Left err -> do - putStrLn $ "\x1B[31;1mParse error:\n" ++ show err ++ "\x1B[0m" - repl ctx - -runFile :: String -> Context -> IO () -runFile fname ctx = do - source <- readFile fname - case parseProgram source of - Right ast -> do - res <- interpretProgram ctx ast - case res of - Right _ -> return () - Left err -> die $ "Error: " ++ err - Left err -> die $ "Parse error:\n" ++ show err - -strip :: String -> String -strip = dropWhileEnd isSpace . dropWhile isSpace - -handleEOFError :: IO () -> IO () -handleEOFError op = catchIOError op (\e -> if isEOFError e then putStrLn "" else ioError e) - --- main :: IO () --- main = do --- clargs <- getArgs --- Right ctx <- interpretProgram newContext stdlib --- case clargs of --- [] -> handleEOFError (repl ctx) --- [fname] -> runFile fname ctx --- _ -> usage >> exitFailure - main :: IO () main = do clargs <- getArgs diff --git a/old/interpreter.hs b/old/interpreter.hs new file mode 100644 index 0000000..4595035 --- /dev/null +++ b/old/interpreter.hs @@ -0,0 +1,234 @@ +{-# LANGUAGE TupleSections, DeriveFunctor, GeneralizedNewtypeDeriving #-} +module Interpreter(newContext, interpret, interpretProgram, Context) where + +import Control.Applicative +import Control.Monad +import Control.Monad.Except +import Control.Monad.State +import Data.List +import Data.Maybe +import qualified Data.Map.Strict as Map +-- import Debug.Trace + +import AST +import Parser + + +-- TODO: place bottom varmap separately for performance? (global define's in deeply nested contexts) +type VarMap = Map.Map Name Value +data Context = Context {varMapStk :: [VarMap]} + +newtype IM a = IM {unIM :: StateT Context (ExceptT String IO) a} + deriving (Functor, Applicative, Monad, MonadError String, MonadState Context, MonadIO) + +type Builtin = [Value] -> IM Value + +newContext :: Context +newContext = Context [Map.fromList [(k, VBuiltin k) | k <- Map.keys builtins]] + +lookupVar :: Name -> IM (Maybe Value) +lookupVar name = liftM (msum . map (Map.lookup name)) (gets varMapStk) + +withScopeMap :: VarMap -> IM a -> IM a +withScopeMap vm act = do + modify $ \ctx -> ctx {varMapStk = vm : varMapStk ctx} + x <- act + modify $ \ctx -> ctx {varMapStk = tail (varMapStk ctx)} + return x + +builtins :: Map.Map String Builtin +builtins = Map.fromList + [("read", readBuiltin), + ("eval", evalBuiltin), + ("print", printBuiltin), + ("getline", getlineBuiltin), + ("loop", loopBuiltin), + ("do", doBuiltin), + ("if", ifBuiltin), + ("define", defineBuiltin), + ("lambda", lambdaBuiltin), + ("match", matchBuiltin), + ("+", plusBuiltin), + ("-", arithBuiltin "-" (-) 0), ("*", arithBuiltin "*" (*) 1), + ("/", arithBuiltin "/" div 1), ("%", arithBuiltin "%" mod 1), + ("<", compareBuiltin "<" (<) (<)), ("<=", compareBuiltin "<=" (<=) (<=)), + (">", compareBuiltin ">" (>) (>)), (">=", compareBuiltin ">=" (>=) (>=)), + ("=", compareBuiltin "=" (==) (==)), ("!=", neqBuiltin)] + +nArguments :: String -> Int -> Bool -> Builtin -> Builtin +nArguments name n doeval f args + | length args /= n = + throwError $ "Function '" ++ name ++ "' expects " ++ naStr n ++ " but got " ++ naStr (length args) + | doeval = mapM evalValue args >>= f + | otherwise = f args + where + naStr 0 = "no arguments" + naStr 1 = "1 argument" + naStr num = show num ++ " arguments" + + +readBuiltin :: Builtin +readBuiltin = nArguments "read" 1 True go + where + go :: Builtin + go [VString s] = either (throwError . show) return $ parseExpression s + go _ = throwError "Can only 'read' a string" + +evalBuiltin :: Builtin +evalBuiltin = nArguments "eval" 1 True (evalValue . head) + +printBuiltin :: Builtin +printBuiltin args = do + args' <- mapM evalValue args + liftIO (putStrLn $ intercalate " " $ map printShow args') >> return (VList []) + where + printShow :: Value -> String + printShow (VString s) = s + printShow v = show v + +loopBuiltin :: Builtin +loopBuiltin = nArguments "loop" 1 False $ forever . evalValue . head + +getlineBuiltin :: Builtin +getlineBuiltin = nArguments "getline" 0 True $ const (liftIO getLine >>= return . VString) + +doBuiltin :: Builtin +doBuiltin [] = return (VList []) +doBuiltin args = fmap last $ mapM evalValue args + +ifBuiltin :: Builtin +ifBuiltin [cond, v1] = evalValue cond >>= \c -> if truthy c then evalValue v1 else return (VList []) +ifBuiltin [cond, v1, v2] = evalValue cond >>= \c -> if truthy c then evalValue v1 else evalValue v2 +ifBuiltin a = throwError $ "Cannot pass " ++ show (length a) ++ " arguments to 'if'" + +defineBuiltin :: Builtin +defineBuiltin [VName name, val] = do + val' <- evalValue val + stk <- gets varMapStk + let go [vm] _ = [Map.insert name val' vm] + go (vm : vms) (False : prs) = vm : go vms prs + go (vm : vms) (True : _) = Map.insert name val' vm : vms + go _ _ = undefined + modify $ \ctx -> ctx {varMapStk = go stk (map (isJust . Map.lookup name) stk)} + return (VList []) +defineBuiltin [name@(VName _), VList args, val] + | Just names <- mapM fromVName args = defineBuiltin [name, VLambda names val] + | otherwise = throwError "Invalid 'define' syntax: invalid argument list" +defineBuiltin _ = throwError "Invalid 'define' syntax" + +lambdaBuiltin :: Builtin +lambdaBuiltin = nArguments "lambda" 2 False go + where + go :: Builtin + go [VList args, body] + | Just names <- mapM fromVName args = return (VLambda names body) + | otherwise = throwError "Invalid 'lambda' syntax: invalid argument list" + go _ = throwError "Invalid 'lambda' syntax" + +matchBuiltin :: Builtin +matchBuiltin [] = throwError "Invalid 'match' syntax: empty match" +matchBuiltin [_] = throwError "Invalid 'match' syntax: no arms" +matchBuiltin (subject : arms) = do + subject' <- evalValue subject + go subject' arms + where + go :: Value -> [Value] -> IM Value + go _ [def] = evalValue def + go subject' (VList [pat, value] : rest) = + case match pat subject' Map.empty of + Nothing -> go subject' rest + Just mp -> withScopeMap mp (evalValue value) + go _ _ = throwError "Invalid 'match' syntax: invalid arm" + +plusBuiltin :: Builtin +plusBuiltin [] = return (VNum 0) +plusBuiltin args + | Just nums <- mapM fromVNum args = return (VNum (sum nums)) + | Just strs <- mapM maybeStrings args = return (VString (concat strs)) + | otherwise = throwError "Invalid argument types to operator '+'" + +arithBuiltin :: String -> (Int -> Int -> Int) -> Int -> Builtin +arithBuiltin name oper idelem args = do + args' <- mapM evalValue args + case mapM fromVNum args' of + Just [] -> return (VNum idelem) + Just (hd : tl) -> return (VNum (foldl oper hd tl)) + _ -> throwError $ "Invalid argument types to operator '" ++ name ++ "'" + +neqBuiltin :: Builtin +neqBuiltin = fmap (\(VNum x) -> VNum (1 - x)) . compareBuiltin "!=" (==) (==) + +compareBuiltin :: String -> (Int -> Int -> Bool) -> (String -> String -> Bool) -> Builtin +compareBuiltin name oper soper args = do + args' <- mapM evalValue args + res <- case () of + _ | Just nums <- mapM fromVNum args' -> return $ all (uncurry oper) (zip nums (tail nums)) + | Just strs <- mapM maybeStrings args' -> return $ all (uncurry soper) (zip strs (tail strs)) + | otherwise -> throwError $ "Invalid argument types to operator '" ++ name ++ "'" + return $ VNum $ fromIntegral $ fromEnum res + + +truthy :: Value -> Bool +truthy (VNum n) = n /= 0 +truthy _ = True + +match :: Value -> Value -> VarMap -> Maybe VarMap +match (VList []) (VList []) mp = Just mp +match (VList [VEllipsis]) (VList _) mp = Just mp +match (VList (pat : pats)) (VList (val : vals)) mp = match pat val mp >>= match (VList pats) (VList vals) +match (VName name) val mp = case Map.lookup name mp of + Nothing -> Just (Map.insert name val mp) + Just val' | val == val' -> Just mp + | otherwise -> Nothing +match (VQuoted a) (VQuoted b) mp = match a b mp +match (VLambda _ _) _ _ = Nothing +match a b mp | a == b = Just mp + | otherwise = Nothing + +maybeStrings :: Value -> Maybe String +maybeStrings = liftM2 (<|>) fromVString (fmap show . fromVNum) + + +evalValue :: Value -> IM Value +-- evalValue v | traceShow v False = undefined +evalValue (VList exs) = listCall exs +evalValue e@(VNum _) = return e +evalValue e@(VString _) = return e +evalValue (VName name) = lookupVar name >>= \mval -> case mval of + Just value -> return value + Nothing -> throwError $ "Use of undefined variable '" ++ name ++ "'" +evalValue (VQuoted e) = return e +evalValue e@(VLambda _ _) = return e +evalValue e@(VBuiltin _) = return e +evalValue VEllipsis = throwError "Unexpected ellipsis in code" + +listCall :: [Value] -> IM Value +listCall [] = throwError "Cannot call ()" +listCall (hd : args) = evalValue hd >>= \hd' -> case hd' of + VLambda names body + | length names == length args -> do + args' <- mapM evalValue args + withScopeMap (Map.fromList (zip names args')) (evalValue body) + | otherwise -> throwError $ "Invalid number of arguments in call to lambda " ++ + "(" ++ show (length args) ++ " found, " ++ show (length names) ++ " needed)" + VBuiltin name -> + case Map.lookup name builtins of + Just f -> f args + Nothing -> throwError $ "Unknown builtin '" ++ name ++ "'" + v -> throwError $ "Cannot call value: " ++ show v + + +interpret :: Context -> Value -> IO (Either String (Value, Context)) +interpret ctx val = + runExceptT $ flip runStateT ctx $ unIM $ evalValue val + +interpretProgram :: Context -> Program -> IO (Either String Context) +interpretProgram rootctx (Program l) = go l rootctx + where + go :: [Value] -> Context -> IO (Either String Context) + go [] ctx = return (Right ctx) + go (val : vals) ctx = do + e <- interpret ctx val + case e of + Left err -> return (Left err) + Right (_, ctx') -> go vals ctx' diff --git a/old/stdlib.hs b/old/stdlib.hs new file mode 100644 index 0000000..6f7334f --- /dev/null +++ b/old/stdlib.hs @@ -0,0 +1,16 @@ +module Stdlib(stdlib) where + +import AST +import Parser + + +stdlib :: Program +stdlib = fromRight $ parseProgram + "(define not (x) (= x 0))\n\ + \(define id (x) x)\n\ + \(define nil (x) (= x '()))\n\ + \(define . (f g) (lambda (x) (f (g x))))\n" + +fromRight :: Show a => Either a b -> b +fromRight (Right b) = b +fromRight (Left a) = error $ "fromRight on Left: " ++ show a diff --git a/stdlib.hs b/stdlib.hs deleted file mode 100644 index 6f7334f..0000000 --- a/stdlib.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Stdlib(stdlib) where - -import AST -import Parser - - -stdlib :: Program -stdlib = fromRight $ parseProgram - "(define not (x) (= x 0))\n\ - \(define id (x) x)\n\ - \(define nil (x) (= x '()))\n\ - \(define . (f g) (lambda (x) (f (g x))))\n" - -fromRight :: Show a => Either a b -> b -fromRight (Right b) = b -fromRight (Left a) = error $ "fromRight on Left: " ++ show a diff --git a/test.hs b/test.hs deleted file mode 100644 index a763524..0000000 --- a/test.hs +++ /dev/null @@ -1,16 +0,0 @@ -import System.Exit - -import Compiler -import Optimiser -import Parser -import VM - -main :: IO () -main = do - -- let Right p = parseProgram "(print (lambda (n) ((lambda (helper) (if (<= n 0) 0 (if (<= n 2) 1 (helper helper 1 1 (- n 2))))) (lambda (recur a b n) (if (<= n 0) b (recur recur b (+ a b) (- n 1)))))))" - -- let Right p = parseProgram "(print ((lambda (n) ((lambda (helper) (if (<= n 0) 0 (if (<= n 2) 1 (helper helper 1 1 (- n 2))))) (lambda (recur a b n) (if (<= n 0) b (recur recur b (+ a b) (- n 1)))))) 6))" - let Right p = parseProgram "(do (define f (lambda (n) (+ n 1))) (print (f 10)))" - prog <- either die return (compileProgram p) - let opt = optimise prog - print opt - vmRun opt -- cgit v1.2.3