40787a8 · elk · git.iko.soy

Elm.cabal+2

compare with master

unifiedsplit

@@ -68,6 +68,7 @@ Library

68 Type.Constrain.Literal,

69 Type.Constrain.Pattern,

70 Type.Environment,

71+ Type.ExtraChecks,

71 Type.Fragment,

72 Type.Fragment,

72 Type.Inference,

73 Type.Inference,

73 Type.PrettyPrint,

74 Type.PrettyPrint,

@@ -136,6 +137,7 @@ Executable elm

136 Type.Constrain.Literal,

137 Type.Constrain.Literal,

137 Type.Constrain.Pattern,

138 Type.Constrain.Pattern,

138 Type.Environment,

139 Type.Environment,

140+ Type.ExtraChecks,

139 Type.Fragment,

141 Type.Fragment,

140 Type.Inference,

142 Type.Inference,

141 Type.PrettyPrint,

143 Type.PrettyPrint,

compiler/Type/ExtraChecks.hsnew file+61

@@ -0,0 +1,61 @@

1+-- This module contains checks to be run *after* type inference has

2+-- completed successfully. At that point we still need to do occurs

3+-- checks and ensure that `main` has an acceptable type.

4+module Type.ExtraChecks (extraChecks) where

5+

6+import Control.Applicative ((<$>),(<*>))

7+import qualified Data.Map as Map

8+import qualified Data.UnionFind.IO as UF

9+import Type.Type ( Variable, structure, Term1(..) )

10+import Type.State (Env)

11+import Type.PrettyPrint ( pretty, ParensWhen(Never) )

12+import Text.PrettyPrint as P

13+

14+extraChecks :: Env -> IO (Either [P.Doc] Env)

15+extraChecks env =

16+ case mainCheck env of

17+ Left errs -> return $ Left errs

18+ Right env -> occursCheck env

19+

20+mainCheck :: Env -> Either [P.Doc] Env

21+mainCheck env =

22+ case Map.lookup "main" env of

23+ Nothing -> Right env

24+ Just var

25+ | P.render (pretty Never var) `elem` ["Element","Signal Element"] -> Right env

26+ | otherwise ->

27+ Left [ P.vcat [ P.text "Type Error:"

28+ , P.text "'main' must be an Element or a (Signal Element)\n" ] ]

29+

30+occursCheck :: Env -> IO (Either [P.Doc] Env)

31+occursCheck env = do

32+ errors <- concat <$> mapM isFinite (Map.toList env)

33+ return $ if null errors then Right env else Left errors

34+

35+isFinite :: (String, Variable) -> IO [P.Doc]

36+isFinite (name, var) =

37+ do varIsFinite <- go [] var

38+ return $

39+ case varIsFinite of

40+ True -> []

41+ False -> [ P.vcat [ P.text "Type Error:"

42+ , P.text $ "Cannot construct infinite type for '" ++ name ++ "'\n"

43+ ]

44+ ]

45+ where

46+ go :: [Variable] -> Variable -> IO Bool

47+ go seen var =

48+ let check = go (var:seen) in

49+ case var `elem` seen of

50+ True -> return False

51+ False -> do

52+ desc <- UF.descriptor var

53+ case structure desc of

54+ Nothing -> return True

55+ Just struct ->

56+ case struct of

57+ App1 a b -> (&&) <$> check a <*> check b

58+ Fun1 a b -> (&&) <$> check a <*> check b

59+ Var1 a -> check a

60+ EmptyRecord1 -> return True

61+ Record1 fields ext -> and <$> mapM check (ext : concat (Map.elems fields))

compiler/Type/Inference.hs+2−1

@@ -14,6 +14,7 @@ import SourceSyntax.Location (Located, noneNoDocs)

14import SourceSyntax.PrettyPrint

15import Text.PrettyPrint

16import qualified Type.State as TS

17+import Type.ExtraChecks (extraChecks)

17import Control.Monad.State

18import Control.Monad.State

18import Control.Arrow (second)

19import Control.Arrow (second)

19import Transform.SortDefinitions as Sort

20import Transform.SortDefinitions as Sort

@@ -46,6 +47,6 @@ infer interfaces modul = unsafePerformIO $ do

46 state <- execStateT (Solve.solve constraint) TS.initialState

47 state <- execStateT (Solve.solve constraint) TS.initialState

47 let errors = TS.sErrors state

48 let errors = TS.sErrors state

48 if null errors

49 if null errors

49− then return $ Right (Map.difference (TS.sSavedEnv state) header)

50+ then extraChecks $ Map.difference (TS.sSavedEnv state) header

50 else Left `fmap` sequence (reverse errors)

51 else Left `fmap` sequence (reverse errors)

51

52

compiler/Type/Solve.hs+4−2

@@ -70,7 +70,9 @@ adjustRank youngMark visitedMark groupRank variable =

70 do desc <- liftIO $ UF.descriptor variable

71 case () of

72 () | mark desc == youngMark ->

73+ do -- Set the variable as marked first because it may be cyclic.

74+ liftIO $ UF.modifyDescriptor variable $ \desc -> desc { mark = visitedMark }

73− do rank' <- case structure desc of

75+ rank' <- case structure desc of

74 Nothing -> return groupRank

76 Nothing -> return groupRank

75 Just term ->

77 Just term ->

76 case term of

78 case term of

@@ -82,7 +84,7 @@ adjustRank youngMark visitedMark groupRank variable =

82 do ranks <- mapM adjust (concat (Map.elems fields))

84 do ranks <- mapM adjust (concat (Map.elems fields))

83 rnk <- adjust extension

85 rnk <- adjust extension

84 return . maximum $ rnk : ranks

86 return . maximum $ rnk : ranks

85− liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' })

87+ liftIO $ UF.modifyDescriptor variable $ \desc -> desc { rank = rank' }

86 return rank'

88 return rank'

87

89

88 | mark desc /= visitedMark ->

90 | mark desc /= visitedMark ->

compiler/Type/State.hs+5−3

@@ -24,10 +24,12 @@ data Pool = Pool {

24

25emptyPool = Pool { maxRank = outermostRank, inhabitants = [] }

26

27+type Env = Map.Map String Variable

28+

27-- Keeps track of the environment, type variable pool, and a list of errors

29-- Keeps track of the environment, type variable pool, and a list of errors

28data SolverState = SS {

30data SolverState = SS {

29− sEnv :: Map.Map String Variable,

31+ sEnv :: Env,

30− sSavedEnv :: Map.Map String Variable,

32+ sSavedEnv :: Env,

31 sPool :: Pool,

33 sPool :: Pool,

32 sMark :: Int,

34 sMark :: Int,

33 sErrors :: [IO P.Doc]

35 sErrors :: [IO P.Doc]

@@ -77,7 +79,7 @@ switchToPool pool = modifyPool (\_ -> pool)

77getPool :: StateT SolverState IO Pool

79getPool :: StateT SolverState IO Pool

78getPool = sPool <$> get

80getPool = sPool <$> get

79

81

80−getEnv :: StateT SolverState IO (Map.Map String Variable)

82+getEnv :: StateT SolverState IO Env

81getEnv = sEnv <$> get

83getEnv = sEnv <$> get

82

84

83saveLocalEnv :: StateT SolverState IO ()

85saveLocalEnv :: StateT SolverState IO ()

libraries/Color.elm+16−4

@@ -2,6 +2,7 @@

2module Color where

3

4import Native.Color

5+import Basics ((-))

5

6

6data Color = Color Int Int Int Float

7data Color = Color Int Int Int Float

7

8

@@ -45,10 +46,21 @@ darkRed = Color 164 0 0 1

45black = Color 0 0 0 1

46black = Color 0 0 0 1

46white = Color 255 255 255 1

47white = Color 255 255 255 1

47

48

48−gray : Color

49+lightGrey = Color 238 238 236

49−gray = Color 128 128 128 1

50+grey = Color 211 215 207

50−grey : Color

51+darkGrey = Color 186 189 182

51−grey = Color 128 128 128 1

52+

53+lightGray = Color 238 238 236

54+gray = Color 211 215 207

55+darkGray = Color 186 189 182

56+

57+lightCharcoal = Color 136 138 133

58+charcoal = Color 85 87 83

59+darkCharcoal = Color 46 52 54

60+

61+grayscale : Float -> Color

62+grayscale p = hsv 0 0 (1-p)

63+greyscale p = hsv 0 0 (1-p)

52

64

53-- Produce a “complementary color”.

65-- Produce a “complementary color”.

54-- The two colors will accent each other.

66-- The two colors will accent each other.

libraries/Graphics/Collage.elm+3−3

@@ -4,7 +4,7 @@ module Graphics.Collage where

4import open Basics

5import List

6import Either (Either, Left, Right)

7−import Matrix2D (Matrix2D, identity)

7+import Transform2D (Transform2D, identity)

8import Native.Graphics.Collage

9import Graphics.Element (Element, Three, Pos, ElementPrim, Properties)

10import Color (Color, black, Gradient)

@@ -76,7 +76,7 @@ data BasicForm

76 | FShape (Either LineStyle FillStyle) Shape

77 | FImage Int Int (Int,Int) String

78 | FElement Element

79− | FGroup Matrix2D [Form]

79+ | FGroup Transform2D [Form]

80

81form : BasicForm -> Form

82form f = { theta=0, scale=1, x=0, y=0, alpha=1, form=f }

@@ -122,7 +122,7 @@ group fs = form (FGroup identity fs)

122

123-- Flatten many forms into a single `Form` and then apply a matrix

124-- transformation.

125−groupTransform : Matrix2D -> [Form] -> Form

125+groupTransform : Transform2D -> [Form] -> Form

126groupTransform matrix fs = form (FGroup matrix fs)

127

128-- Rotate a form by a given angle. Rotate takes standard Elm angles (radians)

libraries/Matrix2D.elmdeleted−42

@@ -1,42 +0,0 @@

1−

2−module Matrix2D where

3−

4−import Native.Matrix2D

5−

6−data Matrix2D = Matrix2D

7−

8−-- Create an identity matrix.

9−--

10−-- / 1 0 \\

11−-- \\ 0 1 /

12−identity : Matrix2D

13−identity = Native.Matrix2D.identity

14−

15−-- Creates an arbitrary matrix. This lets you create scales, shears, reflections,

16−-- translations, or any other 2D transform.

17−--

18−-- matrix a b c d dx dy

19−--

20−-- / a b \\

21−-- \\ c d /

22−--

23−-- And `dx` and `dy` are the translation values.

24−matrix : Float -> Float -> Float -> Float -> Float -> Float -> Matrix2D

25−matrix = Native.Matrix2D.matrix

26−

27−-- Creates a [rotation matrix](http://en.wikipedia.org/wiki/Rotation_matrix).

28−-- Given an angle t, it creates a counterclockwise rotation matrix:

29−--

30−-- / cos t -sin t \\

31−-- \\ sin t cos t /

32−rotation : Float -> Matrix2D

33−rotation = Native.Matrix2D.rotation

34−

35−-- Multiplies two matrices together:

36−--

37−-- multiply a b

38−--

39−-- / a11 a12 \\ . / b11 b12 \\

40−-- \\ a21 a22 / \\ b21 b22 /

41−multiply : Matrix2D -> Matrix2D -> Matrix2D

42−multiply = Native.Matrix2D.multiply

libraries/Native/Matrix2D.js → libraries/Native/Transform2D.jsrenamed+3−3

@@ -1,9 +1,9 @@

1

2−Elm.Native.Matrix2D = function(elm) {

2+Elm.Native.Transform2D = function(elm) {

3 "use strict";

4

5 elm.Native = elm.Native || {};

6− if (elm.Native.Matrix2D) return elm.Native.Matrix2D;

6+ if (elm.Native.Transform2D) return elm.Native.Transform2D;

7

8 var A;

9 if (typeof Float32Array === 'undefined') {

@@ -80,7 +80,7 @@ Elm.Native.Matrix2D = function(elm) {

80 m21*ndx + m22*ndy + mdy]);

81 }

82

83− return elm.Native.Matrix2D = {

83+ return elm.Native.Transform2D = {

84 identity:identity,

85 matrix:F6(matrix),

86 rotation:rotation,

libraries/Transform2D.elmnew file+44

@@ -0,0 +1,44 @@

1+

2+module Transform2D where

3+

4+import Native.Transform2D

5+

6+data Transform2D = Transform2D

7+

8+-- Create an identity transform. Transforming by the identity does

9+-- not change anything, but it can come in handy as a default or

10+-- base case.

11+--

12+-- / 1 0 \\

13+-- \\ 0 1 /

14+identity : Transform2D

15+identity = Native.Transform2D.identity

16+

17+-- Creates an arbitrary transformation matrix. This lets you create scales,

18+-- shears, reflections, translations, or any other 2D transform.

19+--

20+-- matrix a b c d dx dy

21+--

22+-- / a b \\

23+-- \\ c d /

24+--

25+-- And `dx` and `dy` are the translation values.

26+matrix : Float -> Float -> Float -> Float -> Float -> Float -> Transform2D

27+matrix = Native.Transform2D.matrix

28+

29+-- Creates a [rotation matrix](http://en.wikipedia.org/wiki/Rotation_matrix).

30+-- Given an angle t, it creates a counterclockwise rotation matrix:

31+--

32+-- / cos t -sin t \\

33+-- \\ sin t cos t /

34+rotation : Float -> Transform2D

35+rotation = Native.Transform2D.rotation

36+

37+-- Multiplies two transforms together:

38+--

39+-- multiply a b

40+--

41+-- / a11 a12 \\ . / b11 b12 \\

42+-- \\ a21 a22 / \\ b21 b22 /

43+multiply : Transform2D -> Transform2D -> Transform2D

44+multiply = Native.Transform2D.multiply

runtime/Render/Collage.js+7−7

@@ -3,7 +3,7 @@ ElmRuntime.Render.Collage = function() {

3'use strict';

4

5var Render = ElmRuntime.use(ElmRuntime.Render.Element);

6−var Matrix = Elm.Matrix2D({});

6+var Transform = Elm.Transform2D({});

7var Utils = ElmRuntime.use(ElmRuntime.Render.Utils);

8var newElement = Utils.newElement,

9 extract = Utils.extract, fromList = Utils.fromList,

@@ -158,23 +158,23 @@ function renderForm(redo, ctx, form) {

158

159function formToMatrix(form) {

160 var scale = form.scale;

161− var matrix = A6( Matrix.matrix, scale, 0, 0, scale, form.x, form.y );

161+ var matrix = A6( Transform.matrix, scale, 0, 0, scale, form.x, form.y );

162

163 var theta = form.theta

164 if (theta !== 0)

165− matrix = A2( Matrix.multiply, matrix, Matrix.rotation(theta) );

165+ matrix = A2( Transform.multiply, matrix, Transform.rotation(theta) );

166

167 return matrix;

168}

169

170function makeTransform(w, h, form, matrices) {

171 var props = form.form._0.props;

172− var m = A6( Matrix.matrix, 1, 0, 0, 1,

172+ var m = A6( Transform.matrix, 1, 0, 0, 1,

173 (w - props.width)/2,

174 (h - props.height)/2 );

175 var len = matrices.length;

176− for (var i = 0; i < len; ++i) { m = A2( Matrix.multiply, m, matrices[i] ); }

176+ for (var i = 0; i < len; ++i) { m = A2( Transform.multiply, m, matrices[i] ); }

177− m = A2( Matrix.multiply, m, formToMatrix(form) );

177+ m = A2( Transform.multiply, m, formToMatrix(form) );

178

179 return 'matrix(' + m[0] + ',' + m[3] + ',' +

180 (-m[1]) + ',' + (-m[4]) + ',' +

@@ -220,7 +220,7 @@ function stepper(forms) {

220 var f = out.form;

221 if (f.ctor === 'FGroup') {

222 ps.unshift(stepperHelp(f._1));

223− var m = A2(Matrix.multiply, f._0, formToMatrix(out));

223+ var m = A2(Transform.multiply, f._0, formToMatrix(out));

224 ctx.save();

225 ctx.transform(m[0], m[3], m[1], m[4], m[2], m[5]);

226 matrices.push(m);

tests/Main.hs+1−1

@@ -9,7 +9,7 @@ import Test.Framework.BlackBoxTest

9main :: IO ()

10main = do

11 args <- getArgs

12− tests <- blackBoxTests "tests/good" "dist/build/elm/elm" ".elm" bbtArgs

12+ tests <- blackBoxTests "tests" "dist/build/elm/elm" ".elm" bbtArgs

13 code <- runTestWithArgs args tests

14 removeDirectoryRecursive "cache"

15 removeDirectoryRecursive "build"

tests/bad/BBTArgsnew file+1

@@ -0,0 +1 @@

1+Fail

tests/bad/InfiniteType.elmnew file+2

@@ -0,0 +1,2 @@

1+

2+f = f 42

tests/bad/NonElementMain.elmnew file+2

@@ -0,0 +1,2 @@

1+

2+main = 42