carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-09-11 05:25:28 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #893 from scolsen/private

Browse Source 
Implement Privacy Checking
This commit is contained in:
Erik Svedäng 2020-06-22 20:51:08 +02:00 committed by GitHub
commit 73bb5735c1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 35 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
core/Format.carp
View File

@ -1,4 +1,3 @@
(private fmt-internal)
(hidden fmt-internal)
(defndynamic fmt-internal [s args]
(let [idx (String.index-of s \%)

5
src/Eval.hs
View File

@ -62,7 +62,10 @@ eval ctx xobj@(XObj o i t) =
Nothing -> Nothing
tryLookup path =
case lookupInEnv path (contextGlobalEnv ctx) of
Just (_, Binder _ found) -> return (ctx, Right (resolveDef found))
Just (_, Binder meta found) ->
if metaIsTrue meta "private"
then return (evalError ctx ("The binding: " ++ show (getPath found) ++ " is private; it may only be used within the module that defines it.") i)
else return (ctx, Right (resolveDef found))
Nothing ->
case lookupInEnv path (getTypeEnv (contextTypeEnv ctx)) of
Just (_, Binder _ found) -> return (ctx, Right (resolveDef found))

28
src/Expand.hs
View File

@ -36,7 +36,7 @@ expand eval ctx xobj =
--case obj (trace ("Expand: " ++ pretty xobj) xobj) of
Lst _ -> expandList xobj
Arr _ -> expandArray xobj
Sym _ _ -> return (ctx, expandSymbol xobj)
Sym _ _ -> expandSymbol xobj
_ -> return (ctx, Right xobj)
where
@ -169,18 +169,22 @@ expand eval ctx xobj =
Right (XObj (Arr okXObjs) i t))
expandArray _ = error "Can't expand non-array in expandArray."
expandSymbol :: XObj -> Either a XObj
expandSymbol (XObj (Sym path _) _ _) =
expandSymbol :: XObj -> IO (Context, Either EvalError XObj)
expandSymbol sym@(XObj (Sym path _) _ _) =
case lookupInEnv path (contextEnv ctx) of
Just (_, Binder _ (XObj (Lst (XObj (External _) _ _ : _)) _ _)) -> Right xobj
Just (_, Binder _ (XObj (Lst (XObj (Instantiate _) _ _ : _)) _ _)) -> Right xobj
Just (_, Binder _ (XObj (Lst (XObj (Deftemplate _) _ _ : _)) _ _)) -> Right xobj
Just (_, Binder _ (XObj (Lst (XObj (Defn _) _ _ : _)) _ _)) -> Right xobj
Just (_, Binder _ (XObj (Lst (XObj Def _ _ : _)) _ _)) -> Right xobj
Just (_, Binder _ (XObj (Lst (XObj (Defalias _) _ _ : _)) _ _)) -> Right xobj
Just (_, Binder _ found) -> Right found -- use the found value
Nothing -> Right xobj -- symbols that are not found are left as-is
expandSymbol _ = error "Can't expand non-symbol in expandSymbol."
Just (_, Binder meta (XObj (Lst (XObj (External _) _ _ : _)) _ _)) -> isPrivate meta xobj
Just (_, Binder meta (XObj (Lst (XObj (Instantiate _) _ _ : _)) _ _)) -> isPrivate meta xobj
Just (_, Binder meta (XObj (Lst (XObj (Deftemplate _) _ _ : _)) _ _)) -> isPrivate meta xobj
Just (_, Binder meta (XObj (Lst (XObj (Defn _) _ _ : _)) _ _)) -> isPrivate meta xobj
Just (_, Binder meta (XObj (Lst (XObj Def _ _ : _)) _ _)) -> isPrivate meta xobj
Just (_, Binder meta (XObj (Lst (XObj (Defalias _) _ _ : _)) _ _)) -> isPrivate meta xobj
Just (_, Binder meta found) -> isPrivate meta found -- use the found value
Nothing -> return (ctx, Right xobj) -- symbols that are not found are left as-is
where
isPrivate m x = if metaIsTrue m "private"
then return (evalError ctx ("The binding: " ++ pretty sym ++ " is private; it may only be used within the module that defines it.") (info sym))
else return (ctx, Right x)
expandSymbol _ = return (evalError ctx "Can't expand non-symbol in expandSymbol." Nothing)
successiveExpand (ctx, acc) e =
case acc of

13
test-for-errors/private-bindings.carp Normal file
View File

@ -0,0 +1,13 @@
(Project.config "file-path-print-length" "short")
(deftype Foo [bar Int])
(private Foo.bar)
(defmodule Foo
(defn get [foo]
(Foo.bar foo))
)
(defn boo [] @(Foo.bar &(Foo.init 1)))
(defn main [] (println* (Foo.bar &(Foo.init 1))))

2
test/output/test-for-errors/private-bindings.carp.output.expected Normal file
View File

@ -0,0 +1,2 @@
private-bindings.carp:11:16 The binding: Foo.bar is private; it may only be used within the module that defines it.
private-bindings.carp:13:26 The binding: Foo.bar is private; it may only be used within the module that defines it.