mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
vector2: integrated test suite
This commit is contained in:
parent
81c2af23f1
commit
120116a70a
@ -156,9 +156,9 @@ preludeModules carpDir = map (\s -> carpDir ++ "/core/" ++ s ++ ".carp") [ "Macr
|
||||
, "Bool"
|
||||
, "IO"
|
||||
, "System"
|
||||
, "Test"
|
||||
, "Vector"
|
||||
, "Geometry"
|
||||
, "Test"
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
|
@ -1,5 +1,6 @@
|
||||
(defmodule Double
|
||||
(def π 3.1415926536)
|
||||
(register = (Fn [Double Double] Bool))
|
||||
(register < (Fn [Double Double] Bool))
|
||||
(register > (Fn [Double Double] Bool))
|
||||
(register + (Fn [Double Double] Double))
|
||||
@ -22,4 +23,10 @@
|
||||
(if (< val min)
|
||||
min
|
||||
val)))
|
||||
)
|
||||
|
||||
(defn approx [x y]
|
||||
(if (> x y)
|
||||
(< (- x y) 0.00001)
|
||||
(< (- y x) 0.00001)))
|
||||
|
||||
)
|
||||
|
@ -1,7 +1,3 @@
|
||||
(use Bool)
|
||||
(use Int)
|
||||
(use String)
|
||||
|
||||
(defmodule IO
|
||||
(defn color-table []
|
||||
[[@"black" @"30"]
|
||||
@ -47,7 +43,7 @@
|
||||
(defmodule Test
|
||||
(deftype State [passed Int, failed Int])
|
||||
|
||||
(defn handler [state expected actual descr what op]
|
||||
(defn handler [state expected actual descr what op str]
|
||||
(if (op expected actual)
|
||||
(do
|
||||
(IO.color "green")
|
||||
@ -62,29 +58,29 @@
|
||||
(IO.color "reset")
|
||||
(State.update-failed (State.copy state) Int.inc))))
|
||||
|
||||
(defn assert-equal [state x y descr op]
|
||||
(handler state x y descr "value" op))
|
||||
(defn assert-equal [state x y descr op str]
|
||||
(handler state x y descr "value" op str))
|
||||
|
||||
(defn assert-str-equal [state x y descr]
|
||||
(assert-equal state x y descr String.=))
|
||||
(assert-equal state x y descr String.= String.str))
|
||||
|
||||
(defn assert-int-equal [state x y descr]
|
||||
(assert-equal state x y descr Int.=))
|
||||
(assert-equal state x y descr Int.= Int.str))
|
||||
|
||||
(defn assert-bool-equal [state x y descr]
|
||||
(assert-equal state x y descr Bool.=))
|
||||
(assert-equal state x y descr Bool.= Bool.str))
|
||||
|
||||
(defn assert-not-equal [state x y descr op]
|
||||
(handler state x y descr "not value" op))
|
||||
(defn assert-not-equal [state x y descr op str]
|
||||
(handler state x y descr "not value" op str))
|
||||
|
||||
(defn assert-bool-not-equal [state x y descr]
|
||||
(assert-equal state x y descr Bool./=))
|
||||
(assert-equal state x y descr Bool./= Bool.str))
|
||||
|
||||
(defn assert-str-not-equal [state x y descr]
|
||||
(assert-equal state x y descr String./=))
|
||||
(assert-equal state x y descr String./= String.str))
|
||||
|
||||
(defn assert-int-not-equal [state x y descr]
|
||||
(assert-equal state x y descr Int./=))
|
||||
(assert-equal state x y descr Int./= Int.str))
|
||||
|
||||
(defn assert-true [state x descr]
|
||||
(assert-bool-equal state true x descr))
|
||||
|
107
core/Vector.carp
107
core/Vector.carp
@ -1,46 +1,55 @@
|
||||
; missing: lerp
|
||||
|
||||
(defdynamic append-multi- [strs]
|
||||
(if (= (count strs) 0)
|
||||
'@""
|
||||
(list 'String.append (car strs) (append-multi- (cdr strs)))))
|
||||
|
||||
(defmacro append-multi [:rest strs]
|
||||
(append-multi- strs))
|
||||
|
||||
(defn doubleq [a, b]
|
||||
(if (Double.> a b)
|
||||
(Double.< (Double.- a b) 0.00001)
|
||||
(Double.< (Double.- b a) 0.00001)))
|
||||
|
||||
(defmodule Vector2
|
||||
(deftype V [x Double, y Double])
|
||||
|
||||
(defn init [x, y]
|
||||
(defn init [x y]
|
||||
(V.init x y))
|
||||
|
||||
(defn str [o]
|
||||
(append-multi @"Vector2(" (Double.str (V.x o)) @", " (Double.str (V.y o)) @")"))
|
||||
(defn copy [v]
|
||||
(V.copy v))
|
||||
|
||||
(defn + [a, b]
|
||||
(defn get-x [o]
|
||||
(V.x o))
|
||||
|
||||
(defn get-y [o]
|
||||
(V.y o))
|
||||
|
||||
(defn set-x [o v]
|
||||
(V.set-x o v))
|
||||
|
||||
(defn set-y [o v]
|
||||
(V.set-y o v))
|
||||
|
||||
(defn str [o]
|
||||
(string-join @"Vector2(" (Double.str (V.x o)) @", " (Double.str (V.y o)) @")"))
|
||||
|
||||
(defn + [a b]
|
||||
(V.init (Double.+ (V.x a) (V.x b))
|
||||
(Double.+ (V.y a) (V.y b))))
|
||||
|
||||
(defn - [a, b]
|
||||
(defn - [a b]
|
||||
(V.init (Double.- (V.x a) (V.x b))
|
||||
(Double.- (V.y a) (V.y b))))
|
||||
|
||||
(defn * [a, n]
|
||||
(defn * [a n]
|
||||
(V.init (Double.* (V.x a) n)
|
||||
(Double.* (V.y a) n)))
|
||||
|
||||
(defn / [a, n]
|
||||
(defn / [a n]
|
||||
(V.init (Double./ (V.x a) n)
|
||||
(Double./ (V.y a) n)))
|
||||
|
||||
(defn = [a, b]
|
||||
(and (doubleq (V.x a) (V.x b))
|
||||
(doubleq (V.y a) (V.y b))))
|
||||
(defn = [a b]
|
||||
(and (Double.= (V.x a) (V.x b))
|
||||
(Double.= (V.y a) (V.y b))))
|
||||
|
||||
(defn /= [a b]
|
||||
(not (= a b)))
|
||||
|
||||
(defn approx [a b]
|
||||
(and (Double.approx (V.x a) (V.x b))
|
||||
(Double.approx (V.y a) (V.y b))))
|
||||
|
||||
(defn mag-sq [o]
|
||||
(let [x (V.x o)
|
||||
@ -52,12 +61,12 @@
|
||||
|
||||
(defn normalize [o]
|
||||
(let [m (mag o)]
|
||||
(if (doubleq m 0.0)
|
||||
(if (Double.= m 0.0)
|
||||
(V.copy o)
|
||||
(/ o m))))
|
||||
|
||||
(defn dist [a, b]
|
||||
(let [s (- &b &a)]
|
||||
(defn dist [a b]
|
||||
(let [s (- b a)]
|
||||
(mag &s)))
|
||||
|
||||
(defn heading [a]
|
||||
@ -68,7 +77,7 @@
|
||||
m (mag a)]
|
||||
(V.init (Double.* (Double.cos h) m) (Double.* (Double.sin h) m))))
|
||||
|
||||
(defn dot [x, y]
|
||||
(defn dot [x y]
|
||||
(Double.+ (Double.* (V.x x) (V.x y))
|
||||
(Double.* (V.y x) (V.y y))))
|
||||
|
||||
@ -80,28 +89,32 @@
|
||||
(defmodule Vector3
|
||||
(deftype V [x Double, y Double, z Double])
|
||||
|
||||
(defn init [x, y, z]
|
||||
(defn init [x y z]
|
||||
(V.init x y z))
|
||||
|
||||
(defn str [o]
|
||||
(append-multi @"Vector2(" (Double.str (V.x o)) @", " (Double.str (V.y o)) @", " (Double.str (V.z o)) @")"))
|
||||
(defn copy [v]
|
||||
(V.copy v))
|
||||
|
||||
(defn + [a, b]
|
||||
(defn str [o]
|
||||
(string-join @"Vector2(" (Double.str (V.x o)) @", " (Double.str (V.y o))
|
||||
@", " (Double.str (V.z o)) @")"))
|
||||
|
||||
(defn + [a b]
|
||||
(V.init (Double.+ (V.x a) (V.x b))
|
||||
(Double.+ (V.y a) (V.y b))
|
||||
(Double.+ (V.z a) (V.z b))))
|
||||
|
||||
(defn - [a, b]
|
||||
(defn - [a b]
|
||||
(V.init (Double.- (V.x a) (V.x b))
|
||||
(Double.- (V.y a) (V.y b))
|
||||
(Double.- (V.z a) (V.z b))))
|
||||
|
||||
(defn * [a, n]
|
||||
(defn * [a n]
|
||||
(V.init (Double.* (V.x a) n)
|
||||
(Double.* (V.y a) n)
|
||||
(Double.* (V.z a) n)))
|
||||
|
||||
(defn / [a, n]
|
||||
(defn / [a n]
|
||||
(V.init (Double./ (V.x a) n)
|
||||
(Double./ (V.y a) n)
|
||||
(Double./ (V.z a) n)))
|
||||
@ -117,11 +130,11 @@
|
||||
|
||||
(defn normalize [o]
|
||||
(let [m (mag o)]
|
||||
(if (doubleq m 0.0)
|
||||
(if (Double.= m 0.0)
|
||||
(V.copy o)
|
||||
(/ o m))))
|
||||
|
||||
(defn cross [x, y]
|
||||
(defn cross [x y]
|
||||
(V.init
|
||||
(Double.- (Double.* (V.y x) (V.z y))
|
||||
(Double.* (V.z x) (V.y y)))
|
||||
@ -130,7 +143,7 @@
|
||||
(Double.- (Double.* (V.x x) (V.y y))
|
||||
(Double.* (V.y x) (V.x y)))))
|
||||
|
||||
(defn dot [x, y]
|
||||
(defn dot [x y]
|
||||
(Double.+ (Double.* (V.x x) (V.x y))
|
||||
(Double.+ (Double.* (V.y x) (V.y y))
|
||||
(Double.* (V.z x) (V.z y)))))
|
||||
@ -143,15 +156,15 @@
|
||||
;(defmodule VectorN
|
||||
; (deftype V [n Int, v (Array Double)])
|
||||
;
|
||||
; (defn init [n, v]
|
||||
; (defn init [n v]
|
||||
; (V.init n v))
|
||||
;
|
||||
; (defn str [o]
|
||||
; (append-multi @"VectorN(dim=" (Int.str (V.n o)) ;", vals=" (Array.str (V.v o))
|
||||
; (string-join @"VectorN(dim=" (Int.str (V.n o)) ;", vals=" (Array.str (V.v o))
|
||||
; @")"))
|
||||
;
|
||||
; (register zip- (Fn [(Fn [Double, Double] Double) &(Array Double) &(Array Double)] V))
|
||||
; (defn zip- [f, a, b]
|
||||
; (defn zip- [f a b]
|
||||
; (let [total []]
|
||||
; (do
|
||||
; (for [i 0 (Array.count a)]
|
||||
@ -159,29 +172,29 @@
|
||||
; (V.init (Array.count a) total))))
|
||||
;
|
||||
; (register zip (Fn [(Fn [Double, Double] Double) &V &V] V))
|
||||
; (defn zip [f, a, b]
|
||||
; (defn zip [f a b]
|
||||
; (if (Int.= (V.n a) (V.n b))
|
||||
; (zip- f (V.v a) (V.v b))
|
||||
; (do
|
||||
; (IO.println "Error: vectors are of wrong dimensionality")
|
||||
; (V.copy a))))
|
||||
;
|
||||
; (defn + [a, b]
|
||||
; (defn + [a b]
|
||||
; (zip add- a b))
|
||||
;
|
||||
; (defn - [a, b]
|
||||
; (defn - [a b]
|
||||
; (zip Double.- a b))
|
||||
;
|
||||
; (defn * [a, n]
|
||||
; (defn * [a n]
|
||||
; (zip- Double.* (V.v a) &(Array.repeat (V.n a) n)))
|
||||
;
|
||||
; (defn / [a, n]
|
||||
; (defn / [a n]
|
||||
; (zip- Double./ (V.v a) &(Array.repeat (V.n a) n)))
|
||||
;
|
||||
; (defn square- [n]
|
||||
; (Double.* (Double.copy n) (Double.copy n)))
|
||||
;
|
||||
; (defn add- [x, y]
|
||||
; (defn add- [x y]
|
||||
; (Double.+ (Double.copy x) (Double.copy y)))
|
||||
;
|
||||
; (defn mag-sq [o]
|
||||
@ -190,7 +203,7 @@
|
||||
; ;(defn mag [o]
|
||||
; ; (Double.sqrt (mag-sq o)))
|
||||
;
|
||||
; ;(defn dist [a, b]
|
||||
; ;(defn dist [a b]
|
||||
; ; (let [b (- b a)]
|
||||
; ; (mag b)))
|
||||
;
|
||||
|
@ -59,17 +59,18 @@ int Int_copy(int *x) { return *x; }
|
||||
float Float_copy(float *x) { return *x; }
|
||||
double Double_copy(double *x) { return *x; }
|
||||
|
||||
#define Double__PLUS_(x, y) ((x) + (y))
|
||||
#define Double__MINUS_(x, y) ((x) - (y))
|
||||
#define Double__MUL_(x, y) ((x) * (y))
|
||||
#define Double__DIV_(x, y) ((x) / (y))
|
||||
#define Double__LT_(x, y) ((x) < (y))
|
||||
#define Double__GT_(x, y) ((x) > (y))
|
||||
double Double__PLUS_(double x, double y) { return x + y; }
|
||||
double Double__MINUS_(double x, double y) { return x - y; }
|
||||
double Double__MUL_(double x, double y) { return x * y; }
|
||||
double Double__DIV_(double x, double y) { return x / y; }
|
||||
bool Double__LT_(double x, double y) { return x < y; }
|
||||
bool Double__GT_(double x, double y) { return x > y; }
|
||||
bool Double__EQ_(double x, double y) { return x == y; }
|
||||
|
||||
#define Float__PLUS_(x, y) ((x) + (y))
|
||||
#define Float__MINUS_(x, y) ((x) - (y))
|
||||
#define Float__MUL_(x, y) ((x) * (y))
|
||||
#define Float__DIV_(x, y) ((x) / (y))
|
||||
float Float__PLUS_(float x, float y) { return x + y; }
|
||||
float Float__MINUS_(float x, float y) { return x - y; }
|
||||
float Float__MUL_(float x, float y) { return x * y; }
|
||||
float Float__DIV_(float x, float y) { return x / y; }
|
||||
|
||||
#define and(x, y) ((x) && (y))
|
||||
#define or(x, y) ((x) || (y))
|
||||
|
56
src/Obj.hs
56
src/Obj.hs
@ -227,10 +227,10 @@ dependencyDepthOfTypedef _ xobj =
|
||||
|
||||
depthOfType :: TypeEnv -> String -> Maybe Ty -> Int
|
||||
depthOfType typeEnv selfName ty = visitType ty
|
||||
where
|
||||
where
|
||||
visitType :: Maybe Ty -> Int
|
||||
visitType (Just (StructTy name _)) = depthOfStructType name
|
||||
visitType (Just (FuncTy argTys retTy)) =
|
||||
visitType (Just (FuncTy argTys retTy)) =
|
||||
-- trace ("Depth of args of " ++ show argTys ++ ": " ++ show (map (visitType . Just) argTys))
|
||||
(maximum (visitType (Just retTy) : (map (visitType . Just) argTys))) + 1
|
||||
visitType (Just (PointerTy p)) = visitType (Just p)
|
||||
@ -304,19 +304,19 @@ envIsExternal env =
|
||||
|
||||
-- | Find the Binder at a specified path.
|
||||
lookupInEnv :: SymPath -> Env -> Maybe (Env, Binder)
|
||||
lookupInEnv (SymPath [] name) env =
|
||||
lookupInEnv (SymPath [] name) env =
|
||||
case Map.lookup name (envBindings env) of
|
||||
Just found -> Just (env, found)
|
||||
Nothing -> case envParent env of
|
||||
Just parent -> lookupInEnv (SymPath [] name) parent
|
||||
Nothing -> Nothing
|
||||
lookupInEnv path@(SymPath (p : ps) name) env =
|
||||
lookupInEnv path@(SymPath (p : ps) name) env =
|
||||
case Map.lookup p (envBindings env) of
|
||||
Just (Binder xobj) ->
|
||||
Just (Binder xobj) ->
|
||||
case xobj of
|
||||
(XObj (Mod modEnv) _ _) -> lookupInEnv (SymPath ps name) modEnv
|
||||
_ -> Nothing
|
||||
Nothing ->
|
||||
Nothing ->
|
||||
case envParent env of
|
||||
Just parent -> lookupInEnv path parent
|
||||
Nothing -> Nothing
|
||||
@ -331,7 +331,7 @@ multiLookupALL = multiLookupInternal True
|
||||
-- | The advanced version of multiLookup that allows for looking into modules that are NOT imported.
|
||||
multiLookupInternal :: Bool -> String -> Env -> [(Env, Binder)]
|
||||
multiLookupInternal allowLookupInAllModules name rootEnv = recursiveLookup rootEnv
|
||||
|
||||
|
||||
where lookupInLocalEnv :: String -> Env -> Maybe (Env, Binder)
|
||||
lookupInLocalEnv n localEnv = case Map.lookup n (envBindings localEnv) of -- No recurse!
|
||||
Just b -> Just (localEnv, b)
|
||||
@ -343,7 +343,7 @@ multiLookupInternal allowLookupInAllModules name rootEnv = recursiveLookup rootE
|
||||
in envs ++ (concatMap imports envs)
|
||||
-- Only lookup in imported modules:
|
||||
else let envs = mapMaybe (\path -> fmap getEnvFromBinder (lookupInEnv path env)) (envUseModules env)
|
||||
in envs ++ (concatMap imports envs)
|
||||
in envs ++ (concatMap imports envs)
|
||||
|
||||
binderToEnv :: Binder -> Maybe Env
|
||||
binderToEnv (Binder (XObj (Mod e) _ _)) = Just e
|
||||
@ -351,9 +351,9 @@ multiLookupInternal allowLookupInAllModules name rootEnv = recursiveLookup rootE
|
||||
|
||||
importsLookup :: Env -> [(Env, Binder)]
|
||||
importsLookup env = mapMaybe (lookupInLocalEnv name) (imports env)
|
||||
|
||||
|
||||
recursiveLookup :: Env -> [(Env, Binder)]
|
||||
recursiveLookup env =
|
||||
recursiveLookup env =
|
||||
let spine = case Map.lookup name (envBindings env) of
|
||||
Just found -> [(env, found)]
|
||||
Nothing -> []
|
||||
@ -381,15 +381,17 @@ multiLookupQualified path@(SymPath (p:ps) name) rootEnv =
|
||||
case lookupInEnv path rootEnv of
|
||||
Just found -> [found]
|
||||
Nothing -> []
|
||||
Nothing ->
|
||||
-- No exact match on the first qualifier, will look in various places for a match:
|
||||
let fromParent = case envParent rootEnv of
|
||||
Just parent -> multiLookupQualified path parent
|
||||
Nothing -> []
|
||||
fromUsedModules = let usedModules = envUseModules rootEnv
|
||||
envs = mapMaybe (\path -> fmap getEnvFromBinder (lookupInEnv path rootEnv)) usedModules
|
||||
in concatMap (\usedEnv -> multiLookupQualified path usedEnv) envs
|
||||
in fromParent ++ fromUsedModules
|
||||
Just _ -> inexactMatch
|
||||
Nothing -> inexactMatch
|
||||
where inexactMatch =
|
||||
-- No exact match on the first qualifier, will look in various places for a match:
|
||||
let fromParent = case envParent rootEnv of
|
||||
Just parent -> multiLookupQualified path parent
|
||||
Nothing -> []
|
||||
fromUsedModules = let usedModules = envUseModules rootEnv
|
||||
envs = mapMaybe (\path -> fmap getEnvFromBinder (lookupInEnv path rootEnv)) usedModules
|
||||
in concatMap (\usedEnv -> multiLookupQualified path usedEnv) envs
|
||||
in fromParent ++ fromUsedModules
|
||||
|
||||
|
||||
-- | Add an XObj to a specific environment. TODO: rename to envInsert
|
||||
@ -399,7 +401,7 @@ extendEnv env name xobj = envAddBinding env name (Binder xobj)
|
||||
-- | Add a Binder to an environment at a specific path location.
|
||||
envInsertAt :: Env -> SymPath -> XObj -> Env
|
||||
envInsertAt env (SymPath [] name) xobj = envAddBinding env name (Binder xobj)
|
||||
envInsertAt env (SymPath (p:ps) name) xobj =
|
||||
envInsertAt env (SymPath (p:ps) name) xobj =
|
||||
case Map.lookup p (envBindings env) of
|
||||
Just (Binder (XObj (Mod innerEnv) i t)) ->
|
||||
let newInnerEnv = Binder (XObj (Mod (envInsertAt innerEnv (SymPath ps name) xobj)) i t)
|
||||
@ -409,7 +411,7 @@ envInsertAt env (SymPath (p:ps) name) xobj =
|
||||
|
||||
envReplaceEnvAt :: Env -> [String] -> Env -> Env
|
||||
envReplaceEnvAt _ [] replacement = replacement
|
||||
envReplaceEnvAt env (p:ps) replacement =
|
||||
envReplaceEnvAt env (p:ps) replacement =
|
||||
case Map.lookup p (envBindings env) of
|
||||
Just (Binder (XObj (Mod innerEnv) i t)) ->
|
||||
let newInnerEnv = Binder (XObj (Mod (envReplaceEnvAt innerEnv ps replacement)) i t)
|
||||
@ -459,10 +461,10 @@ setFullyQualifiedSymbols env (XObj (Lst (defn@(XObj Defn _ _) :
|
||||
in (XObj (Lst [defn, sym, args, setFullyQualifiedSymbols envWithArgs body]) i t)
|
||||
setFullyQualifiedSymbols env (XObj (Lst (the@(XObj The _ _) : typeXObj : value : [])) i t) =
|
||||
let value' = setFullyQualifiedSymbols env value
|
||||
in (XObj (Lst [the, typeXObj, value']) i t)
|
||||
in (XObj (Lst [the, typeXObj, value']) i t)
|
||||
setFullyQualifiedSymbols env (XObj (Lst (def@(XObj Def _ _) : sym : expr : [])) i t) =
|
||||
let expr' = setFullyQualifiedSymbols env expr
|
||||
in (XObj (Lst [def, sym, expr']) i t)
|
||||
in (XObj (Lst [def, sym, expr']) i t)
|
||||
setFullyQualifiedSymbols env (XObj (Lst (letExpr@(XObj Let _ _) : bind@(XObj (Arr bindings) bindi bindt) : body : [])) i t) =
|
||||
if even (length bindings)
|
||||
then let innerEnv = Env Map.empty (Just env) (Just "LET") [] InternalEnv
|
||||
@ -478,11 +480,11 @@ setFullyQualifiedSymbols env (XObj (Lst (letExpr@(XObj Let _ _) : bind@(XObj (Ar
|
||||
setFullyQualifiedSymbols env (XObj (Lst xobjs) i t) =
|
||||
let xobjs' = map (setFullyQualifiedSymbols env) xobjs
|
||||
in XObj (Lst xobjs') i t
|
||||
setFullyQualifiedSymbols env xobj@(XObj (Sym path) i t) =
|
||||
setFullyQualifiedSymbols env xobj@(XObj (Sym path) i t) =
|
||||
case multiLookupQualified path env of
|
||||
[] -> xobj
|
||||
[(_, Binder foundOne)] -> XObj (Sym (getPath foundOne)) i t
|
||||
multiple ->
|
||||
multiple ->
|
||||
case filter (not . envIsExternal . fst) multiple of
|
||||
-- There is at least one local binding, use the path of that one:
|
||||
(_, Binder local) : _ -> XObj (Sym (getPath local)) i t
|
||||
@ -528,7 +530,7 @@ instance Show Project where
|
||||
data Includer = SystemInclude String
|
||||
| LocalInclude String
|
||||
deriving Eq
|
||||
|
||||
|
||||
instance Show Includer where
|
||||
show (SystemInclude file) = "<" ++ file ++ ">"
|
||||
show (LocalInclude file) = "\"" ++ file ++ "\""
|
||||
@ -650,7 +652,7 @@ defineFunctionTypeAlias aliasTy = defineTypeAlias (tyToC aliasTy) aliasTy
|
||||
defineArrayTypeAlias :: Ty -> XObj
|
||||
defineArrayTypeAlias t = defineTypeAlias (tyToC t) (StructTy "Array" [])
|
||||
|
||||
-- | Find out if a type is "external", meaning it is not defined by the user
|
||||
-- | Find out if a type is "external", meaning it is not defined by the user
|
||||
-- in this program but instead imported from another C library or similar.
|
||||
isExternalType :: TypeEnv -> Ty -> Bool
|
||||
isExternalType typeEnv (PointerTy p) =
|
||||
|
90
test/vector2.carp
Normal file
90
test/vector2.carp
Normal file
@ -0,0 +1,90 @@
|
||||
(use Test)
|
||||
(use Vector2)
|
||||
(use Geometry)
|
||||
|
||||
(defn main []
|
||||
(with-test test
|
||||
(assert-equal test
|
||||
&(init 1.0 2.0) &(init 1.0 2.0)
|
||||
"= operator works"
|
||||
=
|
||||
str)
|
||||
(assert-equal test
|
||||
&(init 1.0 2.0) &(init 1.0 1.0)
|
||||
"/= operator works"
|
||||
/=
|
||||
str)
|
||||
(assert-equal test
|
||||
&(init 3.0 3.0)
|
||||
&(+ &(init 2.0 1.0) &(init 1.0 2.0))
|
||||
"+ operator works"
|
||||
=
|
||||
str)
|
||||
(assert-equal test
|
||||
&(init 1.0 -1.0)
|
||||
&(- &(init 2.0 1.0) &(init 1.0 2.0))
|
||||
"- operator works"
|
||||
=
|
||||
str)
|
||||
(assert-equal test
|
||||
&(init 4.0 2.0)
|
||||
&(* &(init 2.0 1.0) 2.0)
|
||||
"* operator works"
|
||||
=
|
||||
str)
|
||||
(assert-equal test
|
||||
&(init 1.0 0.5)
|
||||
&(/ &(init 2.0 1.0) 2.0)
|
||||
"/ operator works"
|
||||
=
|
||||
str)
|
||||
(assert-equal test
|
||||
5.0
|
||||
(mag &(init 3.0 4.0))
|
||||
"mag works"
|
||||
Double.=
|
||||
Double.str)
|
||||
(assert-equal test
|
||||
101.0
|
||||
(mag-sq &(init 10.0 1.0))
|
||||
"mag-sq works"
|
||||
Double.=
|
||||
Double.str)
|
||||
(assert-equal test
|
||||
&(init 0.6 0.8)
|
||||
&(normalize &(init 3.0 4.0))
|
||||
"normalize works"
|
||||
Vector2.=
|
||||
Vector2.str)
|
||||
(assert-equal test
|
||||
5.0
|
||||
(dist &(init 10.0 10.0) &(init 7.0 6.0))
|
||||
"dist works"
|
||||
Double.=
|
||||
Double.str)
|
||||
(assert-equal test
|
||||
0.0
|
||||
(heading &(init 1.0 0.0))
|
||||
"heading works"
|
||||
Double.=
|
||||
Double.str)
|
||||
(assert-equal test
|
||||
&(init -2.0 1.0)
|
||||
&(rotate &(init 1.0 2.0) (degree-to-radians 90.0))
|
||||
"rotate works"
|
||||
Vector2.approx
|
||||
Vector2.str)
|
||||
(assert-equal test
|
||||
90.0
|
||||
(radians-to-degree (Vector2.angle-between &(init 1.0 0.0) &(init 0.0 1.0)))
|
||||
"angle-between works"
|
||||
Double.approx
|
||||
Double.str)
|
||||
(assert-equal test
|
||||
44.0
|
||||
(dot &(init 10.0 2.0) &(init 2.0 12.0))
|
||||
"dot works"
|
||||
Double.=
|
||||
Double.str)
|
||||
(print-test-results test)
|
||||
))
|
Loading…
Reference in New Issue
Block a user