mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
feat: treat keywords as symbols (#1190)
This commit is contained in:
parent
3d0fd558aa
commit
1f8c8765d3
@ -278,7 +278,7 @@ runExeWithArgs ctx exe args = liftIO $ do
|
||||
commandBuild :: VariadicCommandCallback
|
||||
commandBuild ctx [] = commandBuild ctx [falseXObj]
|
||||
commandBuild ctx [XObj (Bol shutUp) _ _] = do
|
||||
let env = contextGlobalEnv ctx
|
||||
let env = removeSpecials (contextGlobalEnv ctx)
|
||||
typeEnv = contextTypeEnv ctx
|
||||
proj = contextProj ctx
|
||||
execMode = contextExecMode ctx
|
||||
@ -343,6 +343,12 @@ commandBuild ctx [XObj (Bol shutUp) _ _] = do
|
||||
else case Map.lookup "main" (envBindings env) of
|
||||
Just _ -> compile True
|
||||
Nothing -> compile False
|
||||
where
|
||||
removeSpecials env =
|
||||
let binds = Map.filterWithKey filterSpecials (envBindings env)
|
||||
in env {envBindings = binds}
|
||||
filterSpecials k _ =
|
||||
not (isSpecialSym (XObj (Sym (SymPath [] k) Symbol) Nothing Nothing))
|
||||
commandBuild ctx [arg] =
|
||||
pure (evalError ctx ("`build` expected a boolean argument, but got `" ++ pretty arg ++ "`.") (xobjInfo arg))
|
||||
commandBuild ctx args =
|
||||
|
@ -224,43 +224,48 @@ expand eval ctx xobj =
|
||||
implicitInit = XObj (Sym (SymPath pathToModule "init") Symbol) i t
|
||||
in expand eval ctx (XObj (Lst (implicitInit : args)) (xobjInfo xobj) (xobjTy xobj))
|
||||
f : args ->
|
||||
do
|
||||
(_, expandedF) <- expand eval ctx f
|
||||
(ctx'', expandedArgs) <- foldlM successiveExpand (ctx, Right []) args
|
||||
case expandedF of
|
||||
Right (XObj (Lst [XObj Dynamic _ _, _, XObj (Arr _) _ _, _]) _ _) ->
|
||||
--trace ("Found dynamic: " ++ pretty xobj)
|
||||
eval ctx'' xobj
|
||||
Right (XObj (Lst [XObj Macro _ _, _, XObj (Arr _) _ _, _]) _ _) ->
|
||||
--trace ("Found macro: " ++ pretty xobj ++ " at " ++ prettyInfoFromXObj xobj)
|
||||
eval ctx'' xobj
|
||||
Right (XObj (Lst [XObj (Command (NullaryCommandFunction nullary)) _ _, _, _]) _ _) ->
|
||||
nullary ctx''
|
||||
Right (XObj (Lst [XObj (Command (UnaryCommandFunction unary)) _ _, _, _]) _ _) ->
|
||||
case expandedArgs of
|
||||
Right [x] -> unary ctx'' x
|
||||
_ -> error "expanding args"
|
||||
Right (XObj (Lst [XObj (Command (BinaryCommandFunction binary)) _ _, _, _]) _ _) ->
|
||||
case expandedArgs of
|
||||
Right [x, y] -> binary ctx'' x y
|
||||
_ -> error "expanding args"
|
||||
Right (XObj (Lst [XObj (Command (TernaryCommandFunction ternary)) _ _, _, _]) _ _) ->
|
||||
case expandedArgs of
|
||||
Right [x, y, z] -> ternary ctx'' x y z
|
||||
_ -> error "expanding args"
|
||||
Right (XObj (Lst [XObj (Command (VariadicCommandFunction variadic)) _ _, _, _]) _ _) ->
|
||||
case expandedArgs of
|
||||
Right ea -> variadic ctx'' ea
|
||||
_ -> error "expanding args"
|
||||
Right _ ->
|
||||
pure
|
||||
( ctx'',
|
||||
do
|
||||
okF <- expandedF
|
||||
okArgs <- expandedArgs
|
||||
Right (XObj (Lst (okF : okArgs)) i t)
|
||||
)
|
||||
Left err -> pure (ctx'', Left err)
|
||||
if isSpecialSym f
|
||||
then do
|
||||
(ctx', s) <- eval ctx f
|
||||
let Right sym = s
|
||||
expand eval ctx' (XObj (Lst (sym : args)) (xobjInfo xobj) (xobjTy xobj))
|
||||
else do
|
||||
(_, expandedF) <- expand eval ctx f
|
||||
(ctx'', expandedArgs) <- foldlM successiveExpand (ctx, Right []) args
|
||||
case expandedF of
|
||||
Right (XObj (Lst [XObj Dynamic _ _, _, XObj (Arr _) _ _, _]) _ _) ->
|
||||
--trace ("Found dynamic: " ++ pretty xobj)
|
||||
eval ctx'' xobj
|
||||
Right (XObj (Lst [XObj Macro _ _, _, XObj (Arr _) _ _, _]) _ _) ->
|
||||
--trace ("Found macro: " ++ pretty xobj ++ " at " ++ prettyInfoFromXObj xobj)
|
||||
eval ctx'' xobj
|
||||
Right (XObj (Lst [XObj (Command (NullaryCommandFunction nullary)) _ _, _, _]) _ _) ->
|
||||
nullary ctx''
|
||||
Right (XObj (Lst [XObj (Command (UnaryCommandFunction unary)) _ _, _, _]) _ _) ->
|
||||
case expandedArgs of
|
||||
Right [x] -> unary ctx'' x
|
||||
_ -> error "expanding args"
|
||||
Right (XObj (Lst [XObj (Command (BinaryCommandFunction binary)) _ _, _, _]) _ _) ->
|
||||
case expandedArgs of
|
||||
Right [x, y] -> binary ctx'' x y
|
||||
_ -> error "expanding args"
|
||||
Right (XObj (Lst [XObj (Command (TernaryCommandFunction ternary)) _ _, _, _]) _ _) ->
|
||||
case expandedArgs of
|
||||
Right [x, y, z] -> ternary ctx'' x y z
|
||||
_ -> error "expanding args"
|
||||
Right (XObj (Lst [XObj (Command (VariadicCommandFunction variadic)) _ _, _, _]) _ _) ->
|
||||
case expandedArgs of
|
||||
Right ea -> variadic ctx'' ea
|
||||
_ -> error "expanding args"
|
||||
Right _ ->
|
||||
pure
|
||||
( ctx'',
|
||||
do
|
||||
okF <- expandedF
|
||||
okArgs <- expandedArgs
|
||||
Right (XObj (Lst (okF : okArgs)) i t)
|
||||
)
|
||||
Left err -> pure (ctx'', Left err)
|
||||
expandList _ = error "Can't expand non-list in expandList."
|
||||
expandArray :: XObj -> IO (Context, Either EvalError XObj)
|
||||
expandArray (XObj (Arr xobjs) i t) =
|
||||
|
@ -199,6 +199,11 @@ isSym :: XObj -> Bool
|
||||
isSym (XObj (Sym (SymPath _ _) _) _ _) = True
|
||||
isSym _ = False
|
||||
|
||||
isSpecialSym :: XObj -> Bool
|
||||
isSpecialSym (XObj (Sym (SymPath [] s) _) _ _) =
|
||||
elem s ["defn", "def", "do", "while", "fn", "let", "break", "if", "match", "match-ref", "address", "set!", "the", "ref", "deref", "with"]
|
||||
isSpecialSym _ = False
|
||||
|
||||
isArray :: XObj -> Bool
|
||||
isArray (XObj (Arr _) _ _) = True
|
||||
isArray _ = False
|
||||
|
@ -412,25 +412,8 @@ symbol = do
|
||||
Nothing
|
||||
)
|
||||
else pure $ case last segments of
|
||||
"defn" -> XObj (Defn Nothing) i Nothing
|
||||
"def" -> XObj Def i Nothing
|
||||
-- TODO: What about the other def- forms?
|
||||
"do" -> XObj Do i Nothing
|
||||
"while" -> XObj While i Nothing
|
||||
"fn" -> XObj (Fn Nothing Set.empty) i Nothing
|
||||
"let" -> XObj Let i Nothing
|
||||
"break" -> XObj Break i Nothing
|
||||
"if" -> XObj If i Nothing
|
||||
"match" -> XObj (Match MatchValue) i Nothing
|
||||
"match-ref" -> XObj (Match MatchRef) i Nothing
|
||||
"true" -> XObj (Bol True) i Nothing
|
||||
"false" -> XObj (Bol False) i Nothing
|
||||
"address" -> XObj Address i Nothing
|
||||
"set!" -> XObj SetBang i Nothing
|
||||
"the" -> XObj The i Nothing
|
||||
"ref" -> XObj Ref i Nothing
|
||||
"deref" -> XObj Deref i Nothing
|
||||
"with" -> XObj With i Nothing
|
||||
name -> XObj (Sym (SymPath (init segments) name) Symbol) i Nothing
|
||||
|
||||
atom :: Parsec.Parsec String ParseState XObj
|
||||
|
@ -5,6 +5,7 @@ import Commands
|
||||
import Eval
|
||||
import Info
|
||||
import qualified Map
|
||||
import qualified Meta
|
||||
import Obj
|
||||
import Primitives
|
||||
import qualified Set
|
||||
@ -467,9 +468,31 @@ startingGlobalEnv noArray =
|
||||
envFunctionNestingLevel = 0
|
||||
}
|
||||
where
|
||||
makeSymbol s doc example o =
|
||||
(s, Binder (Meta.set "doc" (makeDoc doc example) emptyMeta) (XObj o Nothing Nothing))
|
||||
makeDoc doc example =
|
||||
(XObj (Str (doc ++ "\n\nExample:\n```\n" ++ example ++ "\n```")) Nothing Nothing)
|
||||
bindings =
|
||||
-- NOTE: special symbols that should be treated like keywords also need to
|
||||
-- be added to isSpecialSym in obj (to avoid emitting them as c etc.)
|
||||
Map.fromList $
|
||||
[ register "NULL" (PointerTy (VarTy "a"))
|
||||
[ register "NULL" (PointerTy (VarTy "a")),
|
||||
makeSymbol "defn" "is used to define a function." "(defn name [arg] body)" (Defn Nothing),
|
||||
makeSymbol "def" "is used to bind a variable." "(def variable \"value\")" Def,
|
||||
makeSymbol "do" "is used to group statements." "(do (println* \"hi\") 1) ; => 1" Do,
|
||||
makeSymbol "while" "is used for loops." "(while true\n (loop-forever))" While,
|
||||
makeSymbol "fn" "is used to define anonymous functions." "(fn [arg] body)" (Fn Nothing Set.empty),
|
||||
makeSymbol "let" "" "" Let,
|
||||
makeSymbol "break" "" "" Break,
|
||||
makeSymbol "if" "" "" If,
|
||||
makeSymbol "match" "" "" (Match MatchValue),
|
||||
makeSymbol "match-ref" "" "" (Match MatchRef),
|
||||
makeSymbol "address" "" "" Address,
|
||||
makeSymbol "set!" "" "" SetBang,
|
||||
makeSymbol "the" "" "" The,
|
||||
makeSymbol "ref" "" "" Ref,
|
||||
makeSymbol "deref" "" "" Deref,
|
||||
makeSymbol "with" "" "" With
|
||||
]
|
||||
++ [("Array", Binder emptyMeta (XObj (Mod arrayModule) Nothing Nothing)) | not noArray]
|
||||
++ [("StaticArray", Binder emptyMeta (XObj (Mod staticArrayModule) Nothing Nothing))]
|
||||
|
@ -1 +1 @@
|
||||
return_ref_in_do.carp:3:1 The reference '(defn f [] (do () () () () (ref [1 2 3])))' isn't alive.
|
||||
return_ref_in_do.carp:3:2 The reference '(defn f [] (do () () () () (ref [1 2 3])))' isn't alive.
|
||||
|
@ -1 +1 @@
|
||||
return_ref_to_array_literal.carp:3:1 The reference '(defn f [] (ref [1 2 3]))' isn't alive.
|
||||
return_ref_to_array_literal.carp:3:2 The reference '(defn f [] (ref [1 2 3]))' isn't alive.
|
||||
|
@ -1 +1 @@
|
||||
return_ref_to_function_result.carp:6:1 The reference '(defn f [] (ref (make-data)))' isn't alive.
|
||||
return_ref_to_function_result.carp:6:2 The reference '(defn f [] (ref (make-data)))' isn't alive.
|
||||
|
@ -1,2 +1,2 @@
|
||||
Inferred Macro, can't unify with Bool.
|
||||
wrong_sig_for_def.carp:4:1 Inferred Bool, can't unify with Int.
|
||||
wrong_sig_for_def.carp:4:2 Inferred Bool, can't unify with Int.
|
||||
|
@ -1,2 +1,2 @@
|
||||
Inferred Macro, can't unify with (Fn [] Bool).
|
||||
wrong_sig_for_defn.carp:4:1 Inferred (Fn [] Bool), can't unify with (Fn [Int] Float).
|
||||
wrong_sig_for_defn.carp:4:2 Inferred (Fn [] Bool), can't unify with (Fn [Int] Float).
|
||||
|
Loading…
Reference in New Issue
Block a user