Skip to content
This repository
Browse code

Test enhancement

  • Loading branch information...
commit cfe7d6fe5a6b25795a1c32ab2f18cfcbad1f9b54 1 parent c4d02cd
David Pollak dpp authored
19 core/src/Tests.hs
@@ -102,6 +102,7 @@ syntaxTests =
102 102 \?taxRate // source the tax rate\n\
103 103 \?taxable\n\
104 104 \?nonTaxable", pfailure . checkparse)
  105 +
105 106 ,("f = 3", testTypes [("f", TPrim PrimDouble)] . checktype)
106 107 ,("f = 3\n\
107 108 \f2 n = f + n", testTypes [("f", TPrim PrimDouble)
@@ -114,17 +115,25 @@ syntaxTests =
114 115 ,("f n = n & \"hi\"", testTypes [("f", TFun (TPrim PrimStr) (TPrim PrimStr))] . checktype)
115 116 ,("q n = n", testTypes [("q", TPrim PrimDouble)] . checktype)
116 117 ,("f n = if true then n else n + 1", testTypes [("f", TFun (TPrim PrimDouble) (TPrim PrimDouble))] . checktype)
117   - {- ,("f n = if true then n else f (n + 1)", testTypes [("f", TFun (TPrim PrimDouble) (TPrim PrimDouble))] . checktype) -}
118   - {-
  118 + ,("f n = if true then n else f (n + 1)", testTypes [("f", TFun (TPrim PrimDouble) (TPrim PrimDouble))] . checktype)
  119 +
119 120 ,("f n = if true then n else (n + 1)\n\
120 121 \f2 n = if true then n else (n & \"foo\")", testTypes [("f", TFun (TPrim PrimDouble) (TPrim PrimDouble))
121 122 ,("f2", TFun (TPrim PrimStr) (TPrim PrimStr))] . checktype)
122   - -}
123   - {-
124 123 ,("f n = n & \"hi\"\n\
125 124 \q n = n", testTypes [("f", TFun (TPrim PrimStr) (TPrim PrimStr))
126 125 ,("q", TPrim PrimDouble)] . checktype)
127   - -}
  126 +
  127 + ,("{- and indented line should fail -}\n\
  128 + \total = subtotal + tax\n\
  129 + \tax = taxable * taxRate\n\
  130 + \subtotal = taxable + nonTaxable\n\n\n\
  131 + \\"Total\" = total // sink the total\n\
  132 + \\"Tax\" = tax // sink the tax\n\
  133 + \?taxRate // source the tax rate\n\
  134 + \?taxable\n\
  135 + \?nonTaxable", testTypes [("tax", TPrim PrimDouble)
  136 + ,("taxable", TPrim PrimDouble)] . checktype)
128 137 ]
129 138
130 139 -- | test that the string parses and there are cnt expressions
34 core/src/Visi/Expression.hs
@@ -391,7 +391,7 @@ prune atv t = return $ (atv, t)
391 391
392 392 isgeneric nongen atv tv@(TVar _) =
393 393 do
394   - (atv', oi) <- occursin (Set.elems nongen) atv tv
  394 + (atv', oi) <- vtrace ("isgeneric for "++show tv++" nongen "++show nongen) occursin (Set.elems nongen) atv tv
395 395 return $ vtrace ("Isgeneric for "++show tv++ " is "++ show oi) (atv', not oi)
396 396 isgeneric nongen atv _ = return (atv, False)
397 397
@@ -427,7 +427,7 @@ fresh' :: Nongen -> AllTypeVars -> Type -> (Map.Map Type Type) -> ThrowsError (A
427 427 fresh' nongen atv t map =
428 428 do
429 429 (atv', t') <- prune atv t
430   - case t' of
  430 + case vtrace ("In fresh for " ++ show t') t' of
431 431 (TVar _) ->
432 432 do
433 433 (atv'', gen) <- isgeneric nongen atv' t'
@@ -436,7 +436,7 @@ fresh' nongen atv t map =
436 436 _ -> let (atv''', ntv) = newVariable atv'' in
437 437 let map' = Map.insert t' ntv map in
438 438 return (atv''', ntv, map')
439   - if gen then updateMap
  439 + if gen then vtrace ("Fresh gen type for " ++ show t' ++ " is " ++ show updateMap) updateMap
440 440 else return (atv'', t', map)
441 441 (TFun t1 t2) ->
442 442 do
@@ -466,28 +466,32 @@ analyze scope nongen atv (SourceExp _ _ t) = return (atv, t)
466 466 analyze scope nongen atv (LetExp _ name t1 exp) =
467 467 do
468 468 let scope' = Map.insert name t1 scope
469   - (atv', rt) <- analyze scope' nongen atv exp
470   - atv'' <- unify atv' t1 rt
471   - return (atv'', t1)
  469 + (atv', rt) <- analyze scope' (Set.insert t1 nongen) atv exp
  470 + atv'' <- vtrace "Let Unify" unify atv' t1 rt
  471 + (atv''', t1') <- prune atv'' t1
  472 + return (atv''', t1')
472 473 analyze scope nongen atv (SinkExp _ name t1 exp) =
473 474 do
474 475 let scope' = Map.insert name t1 scope
475 476 (atv', rt) <- analyze scope' nongen atv exp
476 477 atv'' <- unify atv' t1 rt
477   - return (atv'', t1)
  478 + (atv''', t1') <- prune atv'' t1
  479 + return (atv''', t1')
478 480 analyze scope nongen atv (FuncExp paramName pt rt exp) =
479 481 do
480 482 let scope' = Map.insert paramName pt scope
481 483 (atv', rt') <- analyze scope' (Set.insert pt nongen) atv exp
482   - atv'' <- unify atv' rt rt'
483   - return (atv'', TFun pt rt')
  484 + atv'' <- vtrace "func exp unify" unify atv' rt rt'
  485 + (atv''', pt') <- prune atv'' pt
  486 + return (atv''', TFun pt' rt')
484 487 analyze scope nongen atv (Apply letId t1 t2 exp1 exp2) =
485 488 do
486 489 (atv', funType) <- vtrace ("Appy " ++ show letId) analyze scope nongen atv exp1
487   - (atv'', argType) <- analyze scope nongen atv' exp2
488   - atv''' <- unify atv'' (TFun argType t2) funType
489   - atv'''' <- unify atv''' t1 funType
490   - return (atv'''', t2)
  490 + (atv'', argType) <- vtrace "Appy 2" analyze scope nongen atv' exp2
  491 + atv''' <- vtrace "Apply3" unify atv'' (TFun argType t2) funType
  492 + -- atv'''' <- vtrace ("Apply4 unify " ++ show t1 ++ " and " ++ show funType) unify atv''' t1 funType
  493 + (atv'''', t2') <- prune atv''' t2
  494 + return $ vtrace ("Dappy "++show t2') (atv'''', t2')
491 495 analyze scope nongen atv (Group exprs t1 exp) =
492 496 let foldMe name (LetExp _ _ t1 _) map = Map.insert name t1 map
493 497 foldMe name (SinkExp _ _ t1 expr) map = Map.insert name t1 map
@@ -520,7 +524,7 @@ unify atv t1 t2 =
520 524 else do
521 525 tvi <- findType a atv3
522 526 setATV a (setTVIType tvi $ Just b) atv3
523   - (o, v@(TVar _)) -> unify atv'' v o
  527 + (o, v@(TVar _)) -> vtrace "Backward unify" unify atv'' v o
524 528 ((TFun p1 r1), (TFun p2 r2)) ->
525 529 do
526 530 atv''' <- vtrace ("Mr yak 1 "++ show t1' ++ " and " ++ show t2') unify atv'' p1 p2
@@ -534,7 +538,7 @@ unify atv t1 t2 =
534 538 unifyPair eAtv (t1, t2) =
535 539 do
536 540 atv <- eAtv
537   - unify atv t1 t2
  541 + vtrace "Unify pair" unify atv t1 t2
538 542
539 543
540 544 -- | collect all the type variable substitutions
4 core/src/Visi/Util.hs
@@ -34,8 +34,8 @@ flatten x = x >>= (\a -> a)
34 34
35 35 -- | Trace that you can disable
36 36 vtrace :: String -> a -> a
37   --- vtrace _ a = a
38   -vtrace msg a = trace msg a
  37 +vtrace _ a = a
  38 +-- vtrace msg a = trace msg a
39 39
40 40 data VisiError =
41 41 TypeError String

0 comments on commit cfe7d6f

Please sign in to comment.
Something went wrong with that request. Please try again.