diff --git a/Egison.hs b/Egison.hs --- a/Egison.hs +++ b/Egison.hs @@ -11,7 +11,7 @@ import Paths_egison welcomeMsg :: String -welcomeMsg = "Egison, version 1.0.6 : http://hagi.is.s.u-tokyo.ac.jp/~egi/egison/\nWelcome to Egison Interpreter!\n" +welcomeMsg = "Egison, version 1.0.7 : http://hagi.is.s.u-tokyo.ac.jp/~egi/egison/\nWelcome to Egison Interpreter!\n" byebyeMsg :: String byebyeMsg = "\nLeaving Egison.\nByebye. See you again! (^^)/\n" @@ -218,6 +218,7 @@ | MatchExp Expression Expression [MatchClause] | MatchAllExp Expression Expression MatchClause | ApplyExp Expression Expression + | ApplyListExp Expression [Expression] data InnerExp = ElementExp Expression | SubCollectionExp Expression @@ -327,7 +328,7 @@ obj <- liftIO (readIORef objRef) case obj of Value (Integer n) -> return n - _ -> throwError (Default "objectRefToInteger: not Integer value") + _ -> throwError (Default "ojectRefToInteger: not Integer value") -- -- Environment @@ -347,6 +348,16 @@ Nothing -> getValue env (var,nums) Just objRef -> Just objRef +makeExpression :: Expression -> IO ObjectRef +makeExpression expr = newIORef (Value (Expression expr)) + +makeExpressionList :: [Expression] -> IO [ObjectRef] +makeExpressionList [] = return [] +makeExpressionList (expr:exprs) = do + obj <- makeExpression expr + objs <- makeExpressionList exprs + return (obj:objs) + makeClosure :: Environment -> Expression -> IO ObjectRef makeClosure env expr = newIORef (Closure env expr) @@ -699,8 +710,8 @@ return (ApplyExp fn args) <|> do fn <- parseExpression spaces - args <- sepEndBy parseInnerExp spaces - return (ApplyExp fn (TupleExp args))) + args <- sepEndBy parseExpression spaces + return (ApplyListExp fn args)) parseIndexNums :: Parser [Expression] parseIndexNums = do try (do char '_' @@ -844,7 +855,7 @@ showExpression (DestructorExp deconsInfoExp) = "(destructor " ++ showDestructInfoExp deconsInfoExp ++ ")" showExpression (MatchExp tgt typ clss) = "(match " ++ show tgt ++ " " ++ show typ ++ " {" ++ unwordsList clss ++ "})" showExpression (MatchAllExp tgt typ cls) = "(match-all " ++ show tgt ++ " " ++ show typ ++ " " ++ show cls ++ ")" -showExpression (ApplyExp fn args) = "(apply " ++ show fn ++ " " ++ show args ++ ")" +showExpression (ApplyListExp fn args) = "(apply " ++ show fn ++ " " ++ unwordsList args ++ ")" instance Show Expression where show = showExpression @@ -1042,6 +1053,8 @@ Just objRef -> do val <- cEval1 objRef case val of Loop _ _ _ _ _ _ -> eval1Loop env val + Expression expr -> do liftIO $ putStrLn "here" + eval1 env expr _ -> return val Nothing -> let mBuiltinFn = getBuiltin name in case mBuiltinFn of @@ -1076,6 +1089,7 @@ objRefs <- liftIO (makeClosureList env exprs) return (OrPat objRefs) eval1 env (FunctionExp args body) = return (Function env args body) +eval1 _ (MacroExp args body) = return (Macro args body) eval1 env (DoExp [] body) = eval1 env body eval1 env (DoExp ((fpat,expr):assocs) body) = do objRef <- liftIO (makeClosure env expr) @@ -1116,16 +1130,22 @@ typObj <- liftIO (makeClosure env typExp) tgtObj <- liftIO (makeClosure env tgtExp) evalMatchAllExp env typObj tgtObj mC -eval1 env expr@(ApplyExp fnExp argsExp) = do +eval1 env expr@(ApplyListExp fnExp argsExps) = do fnVal <- eval1 env fnExp - argsObjRef <- liftIO (makeClosure env argsExp) case fnVal of - BuiltinFunction builtinFn -> do argsVal <- cEval argsObjRef - argsVals <- tupleToValueList argsVal + BuiltinFunction builtinFn -> do argsObjRefs <- liftIO (makeClosureList env argsExps) + argsVals <- cEvalList argsObjRefs builtinFn argsVals - Function funEnv fpat body -> do frame <- makeFrame fpat argsObjRef + Function funEnv fpat body -> do argsObjRefs <- liftIO (makeClosureList env argsExps) + arg <- liftIO (newIORef (Value (Tuple argsObjRefs))) + frame <- makeFrame fpat arg objRef <- liftIO (makeClosure (frame:funEnv) body) cEval1 objRef + Macro fpat body -> do argsObjRefs <- liftIO (makeExpressionList argsExps) + arg <- liftIO (newIORef (Value (Tuple argsObjRefs))) + frame <- makeFrame fpat arg + objRef <- liftIO (makeClosure (frame:env) body) + cEval1 objRef _ -> throwError (WithExpression "applying non-functional object" expr) @@ -1302,8 +1322,7 @@ do retFrames <- patternMatch1 [(MState frame ((MAtom (PClosure bf pat) tgtObjRef typObjRef):atoms))] case retFrames of [] -> return [] - _ -> do restFrames <- patternMatch1 states - return (retFrames ++ restFrames) + _ -> do return retFrames Closure env expr -> do patObj2 <- eval1 (bf:env) expr patObjRef2 <- liftIO (newIORef (Value patObj2)) diff --git a/egison.cabal b/egison.cabal --- a/egison.cabal +++ b/egison.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 1.0.6 +Version: 1.0.7 -- A short (one-line) description of the package. Synopsis: An Interpreter for the Programming Language Egison diff --git a/etc/elisp/egison-mode.el b/etc/elisp/egison-mode.el --- a/etc/elisp/egison-mode.el +++ b/etc/elisp/egison-mode.el @@ -8,6 +8,7 @@ "\\" "\\" + "\\" "\\" "\\" "\\" @@ -90,6 +91,7 @@ (defun keyword-indent-point (name) (cond ((equal "define" name) 2) ((equal "lambda" name) 2) + ((equal "macro" name) 2) ((equal "let" name) 2) ((equal "match" name) 2) ((equal "match-all" name) 2) diff --git a/etc/lib/graph.egi b/etc/lib/graph.egi --- a/etc/lib/graph.egi +++ b/etc/lib/graph.egi @@ -25,7 +25,8 @@ l> _> _>)> - (loop $l $i [1 n] {a_i @l} {})])))) + [@(loop $l $i [1 n] {a_i @l} {})] + ])))) (define $hamilton-path (lambda [$g] @@ -37,5 +38,6 @@ l> >)> - (loop $l $i [1 n] {a_i @l} {})])))) + [@(loop $l $i [1 n] {a_i @l} {})] + ])))) diff --git a/etc/sample/graph-test.egi b/etc/sample/graph-test.egi --- a/etc/sample/graph-test.egi +++ b/etc/sample/graph-test.egi @@ -24,7 +24,7 @@ _> _> _> - _>>>>> + _>>>>> [n1 n2 n3 n4 n5]])) (test (match-all g2 Graph