From 25839de02d60da0311530c559cd6065e778e45ad Mon Sep 17 00:00:00 2001 From: scottolsen Date: Fri, 2 Oct 2020 17:48:58 -0400 Subject: [PATCH 1/3] Enhance type reflection; get types of values, get kinds Extends Carp's support for type reflection by returning types for values as well as bindings. `type` now also returns a valid Carp expression/s-expression and so its output can be used as input to dynamic functions and macros (prior to this commit, `type` printed the type to the REPL but did not return a meaningful expression in Carp). Here are a few illustrations of the behavior: ``` (def x 1) ;; type now returns an s-expression/symbol (type x) => Int ;; It also works on values (type 1) => Int (type 2b) => Byte (type "foo") => (Ref String ) ;; It works on more complex values as well (type Maybe) => Module (type Maybe.Just) (Fn [a] (Maybe a) ) ;; reports honestly about polymorphism (type (Maybe.Nothing)) => (Maybe a) (type (Pair.init 1 2)) => (Pair Int Int) ;; What about the type of types? (type (type 2)) => Type ;; Or the type of types of types? (type (type (type 2))) => () ;; One more time! (type (type (type (type 2)))) => () ;; so, () is the fixpoint of type, and is reached after two applications (type zero) ;; the type of an interface is all of its implementations => (((Fn [] (Array a) ) (Fn [] Bool ) (Fn [] Byte ) (Fn [] Char ) (Fn [] Double ) (Fn [] Float ) (Fn [] Int ) (Fn [] Int16 ) (Fn [] Int32 ) (Fn [] Int64 ) (Fn [] Int8 ) (Fn [] Long ) (Fn [] (Maybe a) ) (Fn [] (Pair a b) ) (Fn [] (Quadruple a b c d) ) (Fn [] String ) (Fn [] (Triple a b c) ) (Fn [] Uint16 ) (Fn [] Uint32 ) (Fn [] Uint64 ) (Fn [] Uint8 ))) ``` As shown in the example above, this change also includes a cosmetic update to the representation of lifetime variables, which are surrounded in <> to distinguish them from type variables. This commit also adds a new `kind` primitive that reports on the kind of a binding or value: ``` (def x 3) (kind x) => Base (kind 2) => Base (kind Maybe.Just) => Higher (kind (Maybe.Just 2)) => Higher ``` `kind` and `type` both support interactive development in the repl, for example, a user can rely on `kind` to check the kind of a type they plan on using in an interface that demands a higher-kinded argument. Likewise, they both also support developing macros based on type information. --- CarpHask.cabal | 3 +- headerparse/Main.hs | 3 +- src/Commands.hs | 4 ++- src/Concretize.hs | 21 +++++++++++- src/Obj.hs | 29 ---------------- src/Primitives.hs | 83 +++++++++++++++++++++++++++++++++++---------- src/Reify.hs | 38 +++++++++++++++++++++ src/StartingEnv.hs | 3 +- src/Types.hs | 3 ++ 9 files changed, 135 insertions(+), 52 deletions(-) create mode 100644 src/Reify.hs diff --git a/CarpHask.cabal b/CarpHask.cabal index e4d2879f..314f6da0 100644 --- a/CarpHask.cabal +++ b/CarpHask.cabal @@ -54,7 +54,8 @@ library Path, Interfaces, Primitives, - Validate + Validate, + Reify build-depends: base >= 4.7 && < 5 , parsec == 3.1.* diff --git a/headerparse/Main.hs b/headerparse/Main.hs index c1275549..e0367fd7 100644 --- a/headerparse/Main.hs +++ b/headerparse/Main.hs @@ -11,6 +11,7 @@ import Util import Types import Obj import Path +import Reify data Args = Args { prefixToRemove :: String , kebabCase :: Bool @@ -159,7 +160,7 @@ createRegisterForm name tyXObj prefix kebab = toFnTypeXObj :: [(String, Int)] -> (String, Int) -> XObj toFnTypeXObj argTypeStrings returnTypeString = (XObj (Lst [ (XObj (Sym (SymPath [] "λ") Symbol) Nothing Nothing) - , (XObj (Arr (map (tyToXObj . cTypeToCarpType) argTypeStrings)) Nothing Nothing) + , (XObj (Arr (map (reify . cTypeToCarpType) argTypeStrings)) Nothing Nothing) , (XObj (Sym (SymPath [] (show (cTypeToCarpType returnTypeString))) Symbol) Nothing Nothing) ]) Nothing Nothing) diff --git a/src/Commands.hs b/src/Commands.hs index b6711426..669570b1 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -29,6 +29,8 @@ import TypeError import Path import Info import qualified Meta +import Reify + data CarpException = ShellOutException { shellOutMessage :: String, returnCode :: Int } @@ -910,7 +912,7 @@ commandSexpressionInternal ctx [xobj] bol = tyEnv = getTypeEnv $ contextTypeEnv ctx in case xobj of (XObj (Lst [inter@(XObj (Interface ty _) _ _), path]) i t) -> - return (ctx, Right (XObj (Lst [(toSymbols inter), path, (tyToXObj ty)]) i t)) + return (ctx, Right (XObj (Lst [(toSymbols inter), path, (reify ty)]) i t)) (XObj (Lst forms) i t) -> return (ctx, Right (XObj (Lst (map toSymbols forms)) i t)) mod@(XObj (Mod e) i t) -> diff --git a/src/Concretize.hs b/src/Concretize.hs index e3dc7dd6..40a3e1dc 100644 --- a/src/Concretize.hs +++ b/src/Concretize.hs @@ -23,6 +23,7 @@ import ToTemplate import Validate import SumtypeCase import Info +import Reify data Level = Toplevel | Inside @@ -130,7 +131,7 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root = -- The lambda will also carry with it a special made struct containing the variables it captures -- (if it captures at least one variable) structMemberPairs = concatMap (\(XObj (Sym path _) _ (Just symTy)) -> - [XObj (Sym path Symbol) Nothing Nothing, tyToXObj symTy]) + [XObj (Sym path Symbol) Nothing Nothing, reify symTy]) capturedVars environmentTypeName = pathToC lambdaPath ++ "_env" environmentStructTy = StructTy (ConcreteNameTy environmentTypeName) [] @@ -482,6 +483,24 @@ depsForCase typeEnv x@(XObj (Lst [_, XObj (Arr members) _ _]) _ _) = members depsForCase _ x = Left (InvalidSumtypeCase x) +replaceGenericTypeSymbolsOnMembers :: Map.Map String Ty -> [XObj] -> [XObj] +replaceGenericTypeSymbolsOnMembers mappings memberXObjs = + concatMap (\(v, t) -> [v, replaceGenericTypeSymbols mappings t]) (pairwise memberXObjs) + +replaceGenericTypeSymbols :: Map.Map String Ty -> XObj -> XObj +replaceGenericTypeSymbols mappings xobj@(XObj (Sym (SymPath pathStrings name) _) i t) = + let Just perhapsTyVar = xobjToTy xobj + in if isFullyGenericType perhapsTyVar + then case Map.lookup name mappings of + Just found -> reify found + Nothing -> xobj -- error ("Failed to concretize member '" ++ name ++ "' at " ++ prettyInfoFromXObj xobj ++ ", mappings: " ++ show mappings) + else xobj +replaceGenericTypeSymbols mappings (XObj (Lst lst) i t) = + XObj (Lst (map (replaceGenericTypeSymbols mappings) lst)) i t +replaceGenericTypeSymbols mappings (XObj (Arr arr) i t) = + XObj (Arr (map (replaceGenericTypeSymbols mappings) arr)) i t +replaceGenericTypeSymbols _ xobj = xobj + replaceGenericTypeSymbolsOnCase :: Map.Map String Ty -> XObj -> XObj replaceGenericTypeSymbolsOnCase mappings singleCase@(XObj (Lst (caseName : caseMembers)) i t) = XObj (Lst (caseName : map replacer caseMembers)) i t diff --git a/src/Obj.hs b/src/Obj.hs index e20be7fd..ff847870 100644 --- a/src/Obj.hs +++ b/src/Obj.hs @@ -494,35 +494,6 @@ fromJustWithErrorMessage :: Maybe Ty -> String -> Ty fromJustWithErrorMessage (Just x) _ = x fromJustWithErrorMessage Nothing msg = error msg -replaceGenericTypeSymbolsOnMembers :: Map.Map String Ty -> [XObj] -> [XObj] -replaceGenericTypeSymbolsOnMembers mappings memberXObjs = - concatMap (\(v, t) -> [v, replaceGenericTypeSymbols mappings t]) (pairwise memberXObjs) - -replaceGenericTypeSymbols :: Map.Map String Ty -> XObj -> XObj -replaceGenericTypeSymbols mappings xobj@(XObj (Sym (SymPath pathStrings name) _) i t) = - let Just perhapsTyVar = xobjToTy xobj - in if isFullyGenericType perhapsTyVar - then case Map.lookup name mappings of - Just found -> tyToXObj found - Nothing -> xobj -- error ("Failed to concretize member '" ++ name ++ "' at " ++ prettyInfoFromXObj xobj ++ ", mappings: " ++ show mappings) - else xobj -replaceGenericTypeSymbols mappings (XObj (Lst lst) i t) = - XObj (Lst (map (replaceGenericTypeSymbols mappings) lst)) i t -replaceGenericTypeSymbols mappings (XObj (Arr arr) i t) = - XObj (Arr (map (replaceGenericTypeSymbols mappings) arr)) i t -replaceGenericTypeSymbols _ xobj = xobj - --- | Convert a Ty to the s-expression that represents that type. --- | TODO: Add more cases and write tests for this. -tyToXObj :: Ty -> XObj -tyToXObj (StructTy n []) = tyToXObj n -tyToXObj (StructTy n vs) = XObj (Lst (tyToXObj n : map tyToXObj vs)) Nothing Nothing -tyToXObj (RefTy t lt) = XObj (Lst [XObj (Sym (SymPath [] "Ref") Symbol) Nothing Nothing, tyToXObj t, tyToXObj lt]) Nothing Nothing -tyToXObj (PointerTy t) = XObj (Lst [XObj (Sym (SymPath [] "Ptr") Symbol) Nothing Nothing, tyToXObj t]) Nothing Nothing -tyToXObj (FuncTy argTys returnTy StaticLifetimeTy) = XObj (Lst [XObj (Sym (SymPath [] "Fn") Symbol) Nothing Nothing, XObj (Arr (map tyToXObj argTys)) Nothing Nothing, tyToXObj returnTy]) Nothing Nothing -tyToXObj (FuncTy argTys returnTy lt) = XObj (Lst [XObj (Sym (SymPath [] "Fn") Symbol) Nothing Nothing, XObj (Arr (map tyToXObj argTys)) Nothing Nothing, tyToXObj returnTy, tyToXObj lt]) Nothing Nothing -tyToXObj x = XObj (Sym (SymPath [] (show x)) Symbol) Nothing Nothing - -- | Helper function to create binding pairs for registering external functions. register :: String -> Ty -> (String, Binder) register name t = (name, Binder emptyMeta diff --git a/src/Primitives.hs b/src/Primitives.hs index 1203bfdf..ee07f041 100644 --- a/src/Primitives.hs +++ b/src/Primitives.hs @@ -4,7 +4,7 @@ import Control.Monad (unless, when, foldM) import Control.Monad.IO.Class (liftIO) import Data.List (foldl') import Data.Maybe (fromMaybe) -import Data.Either (isRight) +import Data.Either (isRight, rights) import ColorText import Commands @@ -24,6 +24,8 @@ import ToTemplate import Info import qualified Meta as Meta import Interfaces +import Infer +import Reify import Debug.Trace @@ -320,22 +322,6 @@ dynamicOrMacroWith ctx producer ty name body = do meta = existingMeta globalEnv elem return (ctx { contextGlobalEnv = envInsertAt globalEnv path (Binder meta elem) }, dynamicNil) -primitiveType :: Primitive -primitiveType _ ctx [x@(XObj (Sym path@(SymPath [] name) _) _ _)] = - maybe otherDefs (found ctx . snd) (lookupInEnv path env) - where env = contextGlobalEnv ctx - otherDefs = case multiLookupALL name env of - [] -> - notFound ctx x path - binders -> - liftIO $ do mapM_ (\(env, binder) -> putStrLnWithColor White (show binder)) binders - return (ctx, dynamicNil) -primitiveType _ ctx [x@(XObj (Sym qualifiedPath _) _ _)] = - maybe (notFound ctx x qualifiedPath) (found ctx . snd) (lookupInEnv qualifiedPath env) - where env = contextGlobalEnv ctx -primitiveType _ ctx [x] = - return (evalError ctx ("Can't get the type of non-symbol: " ++ pretty x) (info x)) - primitiveMembers :: Primitive primitiveMembers _ ctx [target] = do let env = contextEnv ctx @@ -452,7 +438,7 @@ registerInternal ctx name ty override = registration = XObj (Lst [XObj (External override) Nothing Nothing ,XObj (Sym path Symbol) Nothing Nothing ,ty - ]) (info ty) (Just t) + ]) (info ty) (Just t) meta = existingMeta globalEnv registration env' = envInsertAt globalEnv path (Binder meta registration) in (ctx { contextGlobalEnv = env' }, dynamicNil) @@ -641,3 +627,64 @@ primitiveDeftemplate _ ctx [s@(XObj (Sym (SymPath _ _) _) _ _), _, _, _] = do argumentErr ctx "deftemplate" "a symbol without prefix" "first" s primitiveDeftemplate _ ctx [x, _, _, _] = argumentErr ctx "deftemplate" "a symbol" "first" x + +noTypeError :: Context -> XObj -> IO (Context, Either EvalError XObj) +noTypeError ctx x = return $ evalError ctx ("Can't get the type of: " ++ pretty x) (info x) + +primitiveType :: Primitive +-- A special case, the type of the type of types (type (type (type 1))) => () +primitiveType _ ctx [x@(XObj _ _ (Just Universe))] = + return (ctx, Right (XObj (Lst []) Nothing Nothing)) +primitiveType _ ctx [x@(XObj (Sym path@(SymPath [] name) _) _ _)] = + (maybe otherDefs (go ctx . snd) (lookupInEnv path env)) + where env = contextGlobalEnv ctx + otherDefs = case multiLookupALL name env of + [] -> + notFound ctx x path + binders -> + (sequence (map (go ctx . snd) binders)) + >>= return . Lst . rights . map snd + >>= \obj -> return (ctx, Right $ (XObj obj Nothing Nothing)) + go ctx binder = + case (ty (binderXObj binder))of + Nothing -> noTypeError ctx x + Just t -> return (ctx, Right (reify t)) +primitiveType _ ctx [x@(XObj (Sym qualifiedPath _) _ _)] = + maybe (notFound ctx x qualifiedPath) (go ctx . snd) (lookupInEnv qualifiedPath env) + where env = contextGlobalEnv ctx + go ctx binder = + case (ty (binderXObj binder)) of + Nothing -> noTypeError ctx x + Just t -> return (ctx, Right $ reify t) +-- As a special case, we force evaluation on sequences such as (type (type 1)) +-- Because primitives don't evaluate their arguments, passing (type 1) to type would result in an error +-- However, such an invocation *is* meaningful, and returns Type (the type of types). (type (type 1)) => Type +-- Note that simply making type a command as an alternative leads to inconsistent behaviors whereby +-- (type 1) => Int +-- (type '1) => Int +-- (type (Pair.init 1 1)) => Error can't find symbol "type" +-- (type '(Pair.init 1 1)) => (Pair Int Int) +-- Contrarily the behavior is far more consistent as a primitive if we simply add this case, and from a user perspective, it makes more sense +-- that this function would be one that *doesn't* evaluate its arguments. +primitiveType any ctx [x@(XObj (Lst (XObj (Sym (SymPath [] "type") _) _ _: rest)) _ _)] = + primitiveType any ctx rest + >>= \result -> case snd result of + Right xobj -> primitiveType any (fst result) [xobj] + Left e -> return (ctx, Left e) +primitiveType _ ctx [x@(XObj _ _ (Just TypeTy))] = liftIO $ return (ctx, Right $ reify TypeTy) +primitiveType _ ctx [x@(XObj _ _ _)] = + let tenv = contextTypeEnv ctx + typed = annotate tenv (contextGlobalEnv ctx) x Nothing + in liftIO $ either fail ok typed + where fail e = return (evalError ctx ("Can't get the type of: " ++ pretty x) (info x)) + ok ((XObj _ _ (Just t)),_) = return (ctx, Right $ reify t) + ok (_,_) = return (evalError ctx ("Can't get the type of: " ++ pretty x) (info x)) + +primitiveKind :: Primitive +primitiveKind _ ctx [x@(XObj _ _ _)] = + let tenv = contextTypeEnv ctx + typed = annotate tenv (contextGlobalEnv ctx) x Nothing + in return (either fail ok typed) + where fail e = (evalError ctx ("Can't get the kind of: " ++ pretty x) (info x)) + ok (XObj _ _ (Just t), _) = (ctx, Right $ reify (tyToKind t)) + ok (_, _) = (evalError ctx ("Can't get the kind of: " ++ pretty x) (info x)) diff --git a/src/Reify.hs b/src/Reify.hs new file mode 100644 index 00000000..8a0f5bbb --- /dev/null +++ b/src/Reify.hs @@ -0,0 +1,38 @@ +-- | Module Reify provides a typeclass and instances for turning internal compiler types and data into +-- corresponding representations in the Carp language. +module Reify where + +import Types +import Obj + +-- | The Reifiable class ranges over internal Carp compiler types that +-- may have corresponding representations in Carp itself. +class Reifiable a where + reify :: a -> XObj + +symbol :: Show a => a -> XObj +symbol x = XObj (Sym (SymPath [] (show x)) Symbol) Nothing Nothing + +-- Show on strings results in a symbol that includes quotes "" +-- This function is the same as symbol, for string literals. +literal :: String -> XObj +literal x = XObj (Sym (SymPath [] x) Symbol) Nothing Nothing + +array :: (Reifiable a) => [a] -> XObj +array x = XObj (Arr (map reify x)) Nothing Nothing + +lifetime :: Show a => a -> XObj +lifetime x = literal ("<" ++ show x ++ ">") + +-- Types +instance Reifiable Kind where + reify k = symbol k + +instance Reifiable Ty where + reify (StructTy t []) = reify t + reify (StructTy t vs) = XObj (Lst (reify t : map reify vs)) Nothing (Just TypeTy) + reify (RefTy t lt) = XObj (Lst [literal "Ref", reify t, lifetime lt]) Nothing (Just TypeTy) + reify (PointerTy t) = XObj (Lst [literal "Ptr", reify t]) Nothing (Just TypeTy) + reify (FuncTy ats rt lt) = XObj (Lst [literal "Fn", array ats, reify rt, lifetime lt]) Nothing (Just TypeTy) + reify TypeTy = XObj (Sym (SymPath [] (show TypeTy)) Symbol) Nothing (Just Universe) + reify t = XObj (Sym (SymPath [] (show t)) Symbol) Nothing (Just TypeTy) diff --git a/src/StartingEnv.hs b/src/StartingEnv.hs index 24337afc..6a68432d 100644 --- a/src/StartingEnv.hs +++ b/src/StartingEnv.hs @@ -237,7 +237,6 @@ dynamicModule = Env { envBindings = bindings , makePrim "defmacro" 3 "defines a new macro." "(defmacro name [args :rest restargs] body)" primitiveDefmacro , makePrim "defndynamic" 3 "defines a new dynamic function, i.e. a function available at compile time." "(defndynamic name [args] body)" primitiveDefndynamic , makePrim "defdynamic" 2 "defines a new dynamic value, i.e. a value available at compile time." "(defdynamic name value)" primitiveDefdynamic - , makePrim "type" 1 "prints the type of a symbol." "(type mysymbol)" primitiveType , makePrim "members" 1 "returns the members of a type as an array." "(members MyType)" primitiveMembers , makeVarPrim "defmodule" "defines a new module in which `expressions` are defined." "(defmodule MyModule )" primitiveDefmodule , makePrim "meta-set!" 3 "sets a new key and value pair on the meta map associated with a symbol." "(meta-set! mysymbol \"mykey\" \"myval\")" primitiveMetaSet @@ -250,6 +249,8 @@ dynamicModule = Env { envBindings = bindings , makePrim "defined?" 1 "checks whether a symbol is defined." "(defined? mysymbol)" primitiveDefined , makePrim "deftemplate" 4 "defines a new C template." "(deftemplate symbol Type declString defString)" primitiveDeftemplate , makePrim "implements" 2 "designates a function as an implementation of an interface." "(implements zero Maybe.zero)" primitiveImplements + , makePrim "type" 1 "prints the type of a symbol." "(type mysymbol)" primitiveType + , makePrim "kind" 1 "prints the kind of a symbol." "(kind mysymbol)" primitiveKind ] ++ [("String", Binder emptyMeta (XObj (Mod dynamicStringModule) Nothing Nothing)) ,("Symbol", Binder emptyMeta (XObj (Mod dynamicSymModule) Nothing Nothing)) diff --git a/src/Types.hs b/src/Types.hs index 8059b012..94aa73d6 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -18,6 +18,8 @@ module Types ( TypeMappings , mangle , pathToC , consPath + , Kind + , tyToKind ) where import qualified Data.Map as Map @@ -49,6 +51,7 @@ data Ty = IntTy | MacroTy | DynamicTy -- the type of dynamic functions (used in REPL and macros) | InterfaceTy + | Universe -- the type of types of types (the type of TypeTy) deriving (Eq, Ord) -- | Kinds checking From 1206ad2309280f2198e107336902c524e4b3dab9 Mon Sep 17 00:00:00 2001 From: scottolsen Date: Fri, 2 Oct 2020 18:03:34 -0400 Subject: [PATCH 2/3] Update --- docs/core/Dynamic.html | 111 +++++++++++++++++++++-------------------- 1 file changed, 56 insertions(+), 55 deletions(-) diff --git a/docs/core/Dynamic.html b/docs/core/Dynamic.html index da439578..15b88c18 100644 --- a/docs/core/Dynamic.html +++ b/docs/core/Dynamic.html @@ -458,7 +458,14 @@ (all? f xs)

- +

Checks whether all of the elements in xs conform to the predicate +function f.

+
(all? (fn [x] (< 1 x)) '(2 3 4))
+=> true
+(all? (fn [x] (< 1 x)) '(-1 0 1))
+=> false
+
+

@@ -477,11 +484,12 @@ (any? f xs)

-

checks whether all of the elements in xs conform to the predicate +

Checks whether any of the elements in xs conforms to the predicate function f.

-

Example:

-
(all? (fn [x] (< 1 x)) '(2 3 4)) ; => true
-(all? (fn [x] (< 1 x)) '(-1 0 1)) ; => false
+
(any? (fn [x] (= 'a x)) '(a b c))
+=> true
+(any? (fn [x] (= 'a x)) '(e f g))
+=> false
 

 
                 

@@ -1331,7 +1339,6 @@ result.

 
If you only need to compose functions that take a single argument (unary arity)
 see comp. Comp also generates the form that corresponds to the composition,
 compose contrarily evaluates 'eagerly' and returns a computed symbol.

-
For exmaple:

 
;; a silly composition
 ((compose empty take) 3 [1 2 3 4 5])
 ;; => []
@@ -1408,11 +1415,10 @@ compose contrarily evaluates 'eagerly' and returns a computed symbol.

                     (curry f x)
                 

                 

-                    
Returns a curried function accepting a single argument, that applies f to x
+                    
Returns a curried function accepting a single argument, that applies f to x
 and then to the following argument.

-
For example,

 
(map (curry Symbol.prefix 'Foo) '(bar baz))
-;; => (Foo.bar Foo.baz)
+=> (Foo.bar Foo.baz)
 

 
                 

@@ -1434,16 +1440,15 @@ and then to the following argument.

Curry functions of any airity.

-

For example:

(map (curry* Dynamic.zip + '(1 2 3)) '((4 5) (6)))
-;; => (((+ 1 4) (+ 2 5)) ((+ 1 6)))
+=> (((+ 1 4) (+ 2 5)) ((+ 1 6)))
 
 ((curry Dynamic.zip cons '(1 2 3)) '((4 5) (6)))
-;; => ((cons 1 (4 5)) (cons (2 (6))))
+=> ((cons 1 (4 5)) (cons (2 (6))))
 
 (defndynamic add-em-up [x y z] (+ (+ x y) z))
 (map (curry* add-em-up 1 2) '(1 2 3))
-;; => (4 5 6)
+=> (4 5 6)

@@ -1730,11 +1735,10 @@ and then to the following argument.

Returns the empty form of xs.

-

For example:

(empty '(1 2 3 4))
-;; => ()
+=> ()
 (empty '[1 2 3 4])
-;; => []
+=> []

@@ -1907,9 +1911,8 @@ and then to the following argument.

Returns a list containing only the elements of xs that satisify predicate p.

-

For example:

(filter (fn [x] (= 'a x)) '(a b a b a b a b))
-;; => (a a a a)
+=> (a a a a)

@@ -1930,10 +1933,9 @@ predicate p.

(flatten l)

-

flattens a list recursively.

-

For example:

+

Flattens a list recursively.

(flatten '(1 2 (3 (4))))
-; => '(1 2 3 4)
+=> '(1 2 3 4)

@@ -1955,9 +1957,8 @@ predicate p.

Flips the arguments of a function f.

-

For example,

((flip Symbol.prefix) 'Bar 'Foo)
-=> ;; (Foo.Bar)
+=> (Foo.Bar)

@@ -2046,6 +2047,29 @@ predicate p.

prints all information associated with a symbol.

Example Usage:

(info mysymbol)
+
+ +

+
+
+ +

+ kind +

+ +
+ primitive +
+

+ Dynamic +

+ + + +

+

prints the kind of a symbol.

+

Example Usage:

+
(kind mysymbol)

@@ -2142,25 +2166,6 @@ predicate p.

-
- -

- list-to-array-internal -

- -
- dynamic -
-

- Dynamic -

- 
-                    (list-to-array-internal xs acc)
-
-

- -

-

@@ -2295,8 +2300,7 @@ predicate p.

Applies a function f to each element in the list or array xs and returns a list dynamic data literal containing the result of the function applications.

-

For example:

-
'(map symbol? '(a b c))
+
'(map symbol? '(a b c))
 => (true true true)
 '(map (curry + 1) '(1 2 3))
 => (2 3 4)
@@ -2875,10 +2879,9 @@ value through successive applications of f.

                     (take n xs)
                 

                 

-                    
Returns a list containing the first n eleements of a list.

-
For example:

+                    
Returns a list containing the first n elements of a list.

 
(take 3 '(1 2 3 4 5))
-;; => (1 2 3)
+=> (1 2 3)
 

 
                 

@@ -2925,9 +2928,8 @@ value through successive applications of f.

                     
Applies f to a starting value x, then generates a sequence of values
 by successively applying f to the result lim-1 times.
 Collects results in the structure given by acc.

-
For example:

 
(unreduce (curry + 1) 0 10 (list))
-;; => (1 2 3 4 5 6 7 8 9 10)
+=> (1 2 3 4 5 6 7 8 9 10)
 

 
                 

@@ -2995,22 +2997,21 @@ Collects results in the structure given by acc.

Returns the form that results from applying a function f to each of -the values supplied in forms.

-

If the members of a single form are exhuasted, the result of the +the values supplied in forms. +If the members of a single form are exhuasted, the result of the applications thus far is returned, and any remaining members in the other forms are ignored.

-

For example,

(zip + '(1 2 3) '(4 5 6))
-;; => ((+ 1 4) (+ 2 5) (+ 3 6))
+=> ((+ 1 4) (+ 2 5) (+ 3 6))

It's important to note that zip operates on forms, and that the form returned by zip may not be evaluable by itself. For instance, to actually transform the result in the example above into something Carp can evaluate, we need to wrap each member of the list in a do:

(append (list 'do) (zip + '(1 2 3) '(4 5 6)))
-;; => (do (+ 1 4) (+ 2 5) (+ 3 6))
+=> (do (+ 1 4) (+ 2 5) (+ 3 6))
 (eval (append (list 'do) (zip + '(1 2 3) '(4 5 6))))
-;; => 9 ;; do returns the value of the last form in its body
+=> 9 ;; do returns the value of the last form in its body

From 4519b77161bead9847b9669424415ce5306e7cd6 Mon Sep 17 00:00:00 2001 From: scottolsen Date: Sat, 3 Oct 2020 12:48:59 -0400 Subject: [PATCH 3/3] Promote type's matching on types of Carp types This is necessary to ensure we distinguish between the symbol "Type" as returned by `type` from the type/module "Type" potentially defined by a user: ``` (deftype Type) (type Type) => Module (type (type 1)) => Type ;; Even though the symbol conflicts with the module defined above, ;; subsequent calls to type return the correct result. (type (type (type 1))) => () ``` --- src/Primitives.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Primitives.hs b/src/Primitives.hs index ee07f041..a05b661d 100644 --- a/src/Primitives.hs +++ b/src/Primitives.hs @@ -635,6 +635,7 @@ primitiveType :: Primitive -- A special case, the type of the type of types (type (type (type 1))) => () primitiveType _ ctx [x@(XObj _ _ (Just Universe))] = return (ctx, Right (XObj (Lst []) Nothing Nothing)) +primitiveType _ ctx [x@(XObj _ _ (Just TypeTy))] = liftIO $ return (ctx, Right $ reify TypeTy) primitiveType _ ctx [x@(XObj (Sym path@(SymPath [] name) _) _ _)] = (maybe otherDefs (go ctx . snd) (lookupInEnv path env)) where env = contextGlobalEnv ctx @@ -671,7 +672,6 @@ primitiveType any ctx [x@(XObj (Lst (XObj (Sym (SymPath [] "type") _) _ _: rest) >>= \result -> case snd result of Right xobj -> primitiveType any (fst result) [xobj] Left e -> return (ctx, Left e) -primitiveType _ ctx [x@(XObj _ _ (Just TypeTy))] = liftIO $ return (ctx, Right $ reify TypeTy) primitiveType _ ctx [x@(XObj _ _ _)] = let tenv = contextTypeEnv ctx typed = annotate tenv (contextGlobalEnv ctx) x Nothing