carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-10-12 04:58:18 +03:00
Code Issues Projects Releases Wiki Activity

Expand command.

Browse Source
This commit is contained in:
Erik Svedäng 2017-11-30 08:12:53 +01:00
parent 92419a4a76
commit 7ea89e0369
2 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
app/Main.hs
View File

@ -156,6 +156,7 @@ startingGlobalEnv noArray =
, addCommand "project" (CommandFunction commandProject)
, addCommand "load" (CommandFunction commandLoad)
, addCommand "macro-log" (CommandFunction commandPrint)
, addCommand "expand" (CommandFunction commandExpand)
] ++ (if noArray then [] else [("Array", Binder (XObj (Mod arrayModule) Nothing Nothing))])
startingTypeEnv :: Env

27
src/Commands.hs
View File

@ -35,7 +35,6 @@ data ReplCommand = Define XObj
| DefineDynamic String XObj XObj
| DefineAlias String XObj
| DefineInterface String XObj (Maybe Info)
| Expand XObj
| Type XObj
| GetInfo XObj
| InstantiateTemplate XObj XObj
@ -89,7 +88,6 @@ objToCommand ctx xobj =
[XObj (Sym (SymPath _ "defalias")) _ _, XObj (Sym (SymPath _ name)) _ _, t] ->return $ DefineAlias name t
[XObj (Sym (SymPath _ "definterface")) _ _, XObj (Sym (SymPath _ name)) _ _, t] ->return $ DefineInterface name t (info xobj)
[XObj (Sym (SymPath _ "eval")) _ _, form] ->return $ Eval form
[XObj (Sym (SymPath _ "expand")) _ _, form] ->return $ Expand form
[XObj (Sym (SymPath _ "instantiate")) _ _, name, signature] ->return $ InstantiateTemplate name signature
[XObj (Sym (SymPath _ "type")) _ _, form] ->return $ Type form
[XObj (Sym (SymPath _ "info")) _ _, form] ->return $ GetInfo form
@ -371,16 +369,6 @@ executeCommand ctx@(Context env typeEnv pathStrings proj lastInput execMode) cmd
do putStrLnWithColor Yellow ("=> " ++ (pretty evaled))
return newCtx
Expand xobj ->
do (result, newCtx) <- runStateT (expandAll env xobj) ctx
case result of
Left e ->
do putStrLnWithColor Red (show e)
return newCtx
Right expanded ->
do putStrLnWithColor Yellow (pretty expanded)
return newCtx
Use path xobj ->
let e = getEnv env pathStrings
useThese = envUseModules e
@ -743,3 +731,18 @@ commandPrint :: CommandCallback
commandPrint args =
do liftIO $ mapM_ (putStrLn . pretty) args
return dynamicNil
commandExpand :: CommandCallback
commandExpand [xobj] =
do ctx <- get
result <-expandAll (contextGlobalEnv ctx) xobj
case result of
Left e ->
liftIO $ do putStrLnWithColor Red (show e)
return dynamicNil
Right expanded ->
liftIO $ do putStrLnWithColor Yellow (pretty expanded)
return dynamicNil
commandExpand args =
liftIO $ do putStrLnWithColor Red ("Invalid args to 'commandExpand':" ++ joinWithComma (map pretty args))
return dynamicNil