summaryrefslogtreecommitdiff
path: root/testdata/complex.lc
blob: 1a7d8b00defa5f6fd067a0f0bfed4f7b3d5029b4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
module Complex where

data Repr = Normal | Polar

data Complex :: Repr -> Type where
  Complex :: forall r . Float -> Float -> Complex r

repr :: forall r . Complex r -> Repr
repr @r _ = r

normal :: Float -> Float -> Complex Normal
normal a b = Complex a b

polar :: Float -> Float -> Complex Polar
polar a b = Complex a b

-- TODO: Write tests that checks if the derived type is the same as the given
cabs :: forall r . Complex r -> Float
cabs @'Normal (Complex a b)    = sqrt (a*a + b*b)
cabs @'Polar  (Complex r _phi) = r

toPolar :: Complex Normal -> Complex Polar
toPolar (Complex x y) =
       if x >  0.0             then polar r (atan (y / x))
  else if x <  0.0 && y >= 0.0 then polar r (atan (y / x) + pi)
  else if x <  0.0 && y <  0.0 then polar r (atan (y / x) - pi)
  else if x == 0.0 && y >= 0.0 then polar r ( pi / 2.0)
  else if x == 0.0 && y <  0.0 then polar r (-pi / 2.0)
  else undefined -- x == 0.0 && y == 0.0
  where
    r = sqrt (x*x + y*y)

{- TODO:
       if x >  0.0             then polar r (arctan (y / x))
       if x <  0.0 && y >= 0.0 then polar r (arctan (y / x) + pi)
!Failed complex
  "./testdata/accept/complex.lc" (line 32, column 10):
  unexpected reserved word "if"
  expecting lowercase ident or uppercase ident
-}
{- TODO:
!Failed complex
  can't find: error in "./testdata/accept/complex.lc" (line 33, column 9):
    else (error "indeterminate polar complex number")
          ^^^^^
-}
{-
toPolar (Complex x y)
  | x > 0.0 && y >= 0.0 = polar r 0
  | x > 0.0 && y <  0.0 = polar r 0
  where
    r = sqrt (x*x + y*y)
!Failed complex
  "./testdata/accept/complex.lc" (line 26, column 4):
  unexpected reserved operator "|"
  expecting symbols
-}
{-
toPolar c@(Complex a b) = undefined
!Crashed mandel
  ../src/LambdaCube/Compiler/Infer.hs:(1162,1)-(1164,98): Non-exhaustive patterns in function addLams'
-}

toNormal :: Complex Polar -> Complex Normal
toNormal (Complex r phi) = Complex (r * cos phi) (r * sin phi)

{-
convert :: forall r0 . forall r1 . Complex r0 -> Complex r1
convert @'Normal @'Normal c = c
convert @'Polar  @'Polar  c = c
convert @'Normal @'Polar  c = toPolar c
convert @'Polar  @'Normal c = toNormal c
!Failed mandel
  checkMetas lam: \(a : V0~Polar) (b : Normal~V1) (c : 'Num ('MatVecElem 'Float)) (d : 'Num ('MatVecElem
  'Float)) (e : Polar~V4) (f : Normal~V5) (g : V6~Normal) {h:'Repr} (i : h~V8) (j : 'Complex V9) ->
  'ReprCase (\'Repr -> 'Complex V11) ('ReprCase (\'Repr -> 'Complex V11) (labend j) (labend (toPolar j))
  h) ('ReprCase (\'Repr -> 'Complex Normal) (labend (toNormal c d j)) (labend j) h) V10
-}

{-
convert :: forall r0 . forall r1 . Complex r0 -> Complex r1
convert @'Normal @'Normal = id
convert @'Polar  @'Polar  = id
convert @'Normal @'Polar  = toPolar
convert @'Polar  @'Normal = toNormal
!Failed mandel
  type error: can not unify
  Polar
  with
  Normal

  in "./testdata/accept/mandel.lc" (line 51, column 27):
  convert @'Normal @'Polar  = toPolar
                            ^^^^^^^
-}

{- ISSUE: Which is expected, which is found???
crepr :: forall r . Complex r -> r
crepr @r (Complex _ _) = r

!Failed mandel
  type error: can not unify
  Type
  with
  'Repr

r should have type X, but it has Y
-}

-- ISSUE: It compiles
it_should_fail (Complex r _ _ _ _) = r

add :: forall r0 . forall r1 . Complex r0 -> Complex r1 -> Complex r0
add @'Normal @'Normal (Complex a b) (Complex c d) = Complex (a + c) (b + d)

{-
add @'Polar  @'Polar  c0 c1 = toPolar (add (toNormal c0) (toNormal c1))
!Failed mandel
  checkMetas lam: \(a : Polar~V0) (b : 'Num ('MatVecElem 'Float)) (c : 'Num ('MatVecElem 'Float))
  {d:'Repr} (e : Polar~d) (f : V5~Polar) (g : 'Complex V6) (h : 'Complex d) -> 'ReprCase (\'Repr ->
  'Complex Polar) ('ReprCase (\'Repr -> 'Complex Polar) ('ComplexCase (\'Repr 'Complex k -> 'Complex
  Polar) (\{m:'Repr} n:'Float o:'Float -> 'ComplexCase (\'Repr 'Complex p -> 'Complex Polar) (\{r:'Repr}
  s:'Float t:'Float -> labend (Complex Polar (PrimAdd 'Float V19 n s) (PrimAdd 'Float V18 o t))) d h) V8
  g) (labend (undefined ('Complex Polar))) d) ('ReprCase (\'Repr -> 'Complex Polar) (labend (undefined
  ('Complex Polar))) (labend (toPolar (V9 Normal Normal (toNormal V11 V10 g) (toNormal b c h)))) d) V8
-}

mul :: forall r0 r1 . Complex r0 -> Complex r1 -> Complex r0
mul @'Normal @'Normal (Complex a b) (Complex c d) = Complex (a*c - b*d) (b*c + a*d)

{- TODO: The hidden parameters should not be shown... or a configuration level...
{a : 'Num ('MatVecElem 'Float)} -> {b : 'Num ('MatVecElem 'Float)} -> {c : 'Num ('MatVecElem 'Float)} ->
{d : 'Num ('MatVecElem 'Float)} -> {e : 'Num ('MatVecElem 'Float)} -> {f : 'Num ('MatVecElem 'Float)} ->
'Complex Normal -> 'Complex Normal -> 'Complex Normal
-}

s :: Complex r -> Complex r
s c = (mul c c) `add` c

-- ISSUE: More application consumes lot of memory
s4 c = s (s (s (s c)))

iter = s4

mandel c = cabs (iter c) < 2.0

{- PROPOSAL:
main should be called screenOut
main :: Output
main = ...
-}