feat: treat keywords as symbols (#1190)

src/Commands.hs

@@ -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 =

src/Expand.hs

@@ -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) =

src/Obj.hs

@@ -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

src/Parsing.hs

@@ -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

src/StartingEnv.hs

@@ -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))]

test/output/test/test-for-errors/return_ref_in_do.carp.output.expected

@@ -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.

test/output/test/test-for-errors/return_ref_to_array_literal.carp.output.expected

@@ -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.

test/output/test/test-for-errors/return_ref_to_function_result.carp.output.expected

@@ -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.

test/output/test/test-for-errors/wrong_sig_for_def.carp.output.expected

@@ -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.

test/output/test/test-for-errors/wrong_sig_for_defn.carp.output.expected

@@ -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).