├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── TODO.md ├── codegen ├── .gitignore ├── Elm │ └── Kernel │ │ ├── List.elm │ │ └── String.elm ├── Generate.elm ├── elm.codegen.json ├── elm.json ├── package.json ├── review │ ├── elm.json │ └── src │ │ └── ReviewConfig.elm └── yarn.lock ├── elm-interpreter.code-workspace ├── elm-watch.json ├── elm.json ├── helpers └── H.elm ├── ideas.md ├── index.html ├── package.json ├── review ├── elm.json └── src │ └── ReviewConfig.elm ├── script ├── .gitignore ├── elm.json └── src │ └── Trace.elm ├── src ├── Environment.elm ├── Eval.elm ├── Eval │ ├── Expression.elm │ ├── Module.elm │ └── Types.elm ├── EvalResult.elm ├── Expression │ └── Extra.elm ├── Kernel.elm ├── Kernel │ ├── Debug.elm │ ├── JsArray.elm │ ├── String.elm │ └── Utils.elm ├── List │ └── MyExtra.elm ├── Result │ └── MyExtra.elm ├── Syntax.elm ├── TopologicalSort.elm ├── Types.elm ├── UI.elm ├── UI │ ├── Source.elm │ └── Theme.elm └── Value.elm ├── tests ├── CoreTests │ ├── Array.elm │ ├── Basics.elm │ ├── Bitwise.elm │ ├── Char.elm │ ├── CodeGen.elm │ ├── Equality.elm │ ├── List.elm │ ├── Maybe.elm │ ├── Result.elm │ ├── String.elm │ └── Tuple.elm ├── EndToEnd.elm ├── Example.elm.txt ├── KernelTests.elm ├── TestUtils.elm └── TopologicalSortTests.elm └── yarn.lock /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | elm-stuff 3 | node_modules 4 | elm-stuff 5 | dist 6 | generated 7 | build 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2023-present Leonardo Taglialegne 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 8 | 9 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 10 | 11 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 12 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | LIBRARIES = elm/core/1.0.5 elm-community/list-extra/8.7.0 2 | 3 | .PHONY: all 4 | all: generated/Core/Basics.elm 5 | 6 | generated/Core/Basics.elm: codegen/Gen/Basics.elm codegen/Generate.elm node_modules/elm-codegen/bin/elm-codegen $(patsubst %,build/src/%/elm.json,$(LIBRARIES)) build/src/codegen/Elm/Kernel/List.elm 7 | yarn elm-codegen run --flags-from build/src 8 | 9 | codegen/Gen/Basics.elm: codegen/elm.codegen.json node_modules/elm-codegen/bin/elm-codegen $(wildcard helpers/*.elm) 10 | yarn elm-codegen install 11 | 12 | node_modules/elm-codegen/bin/elm-codegen: package.json yarn.lock 13 | yarn install 14 | touch -c $@ 15 | 16 | .PRECIOUS: build/%.tar.gz 17 | build/%.tar.gz: 18 | set -e &&\ 19 | NAME=$$(echo $* | cut -d/ -f1,2) &&\ 20 | VERSION=$$(echo $* | cut -d/ -f3) &&\ 21 | mkdir -p $(dir $@) &&\ 22 | curl -sSL https://github.com/$$NAME/archive/refs/tags/$$VERSION.tar.gz -o $@ 23 | 24 | build/src/%/elm.json: build/%.tar.gz 25 | mkdir -p $(@D) 26 | tar -xf $< --strip-components=1 -C $(@D) -m 27 | -test -f $(@D)/src/List.elm && (sed -i.bck 's/n-1/n - 1/g' $(@D)/src/List.elm && rm $(@D)/src/List.elm.bck) 28 | 29 | build/src/codegen/Elm/Kernel/List.elm: $(wildcard codegen/Elm/Kernel/*.elm) 30 | mkdir -p build/src/codegen 31 | cp -r codegen/Elm build/src/codegen 32 | 33 | ALL_GENERATED = $(shell find generated -type f -name '*.elm') 34 | ALL_SRC = $(shell find src -type f -name '*.elm') 35 | dist/ui.js: src/UI.elm $(ALL_SRC) generated/Core/Basics.elm $(ALL_GENERATED) 36 | elm make $< --output $@ 37 | 38 | .PHONY: measure 39 | measure: dist/ui.js 40 | du -sh $^ 41 | gzip -9 $^ 42 | du -sh $^.gz 43 | gunzip $^ 44 | npx elmjs-inspect $^ | head -10 45 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # elm-interpreter 2 | 3 | `elm-interpreter` is an intepreter for Elm, in Elm. 4 | 5 | The key function is `Eval.eval : String -> Result Error Value` that takes as input Elm code and executes it. 6 | 7 | # Testing 8 | 9 | - Use `elm-test`. 10 | - To make it faster, change the number in `test/Utiles.elm#slowTest`. 11 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | - Import aliases / module resolution - nab it from elm-review :D 2 | - Investigage unifying Value/Expression for simpler code 3 | - Make types "native" 4 | -------------------------------------------------------------------------------- /codegen/.gitignore: -------------------------------------------------------------------------------- 1 | Gen 2 | -------------------------------------------------------------------------------- /codegen/Elm/Kernel/List.elm: -------------------------------------------------------------------------------- 1 | module Elm.Kernel.List exposing (map2, map3, map4, map5, sortBy) 2 | 3 | 4 | map2 : (a -> b -> c) -> List a -> List b -> List c 5 | map2 f xas xbs = 6 | let 7 | go : List a -> List b -> List c -> List c 8 | go ao bo acc = 9 | case ao of 10 | [] -> 11 | List.reverse acc 12 | 13 | ah :: at -> 14 | case bo of 15 | [] -> 16 | List.reverse acc 17 | 18 | bh :: bt -> 19 | go at bt (f ah bh :: acc) 20 | in 21 | go xas xbs [] 22 | 23 | 24 | map3 : (a -> b -> c -> d) -> List a -> List b -> List c -> List d 25 | map3 f xas xbs xcs = 26 | let 27 | go : List a -> List b -> List c -> List d -> List d 28 | go ao bo co acc = 29 | case ao of 30 | [] -> 31 | List.reverse acc 32 | 33 | ah :: at -> 34 | case bo of 35 | [] -> 36 | List.reverse acc 37 | 38 | bh :: bt -> 39 | case co of 40 | [] -> 41 | List.reverse acc 42 | 43 | ch :: ct -> 44 | go at bt ct (f ah bh ch :: acc) 45 | in 46 | go xas xbs xcs [] 47 | 48 | 49 | map4 : (a -> b -> c -> d -> e) -> List a -> List b -> List c -> List d -> List e 50 | map4 f xas xbs xcs xds = 51 | let 52 | go : List a -> List b -> List c -> List d -> List e -> List e 53 | go ao bo co do acc = 54 | case ao of 55 | [] -> 56 | List.reverse acc 57 | 58 | ah :: at -> 59 | case bo of 60 | [] -> 61 | List.reverse acc 62 | 63 | bh :: bt -> 64 | case co of 65 | [] -> 66 | List.reverse acc 67 | 68 | ch :: ct -> 69 | case do of 70 | [] -> 71 | List.reverse acc 72 | 73 | dh :: dt -> 74 | go at bt ct dt (f ah bh ch dh :: acc) 75 | in 76 | go xas xbs xcs xds [] 77 | 78 | 79 | map5 : (a -> b -> c -> d -> e -> f) -> List a -> List b -> List c -> List d -> List e -> List f 80 | map5 f xas xbs xcs xds xes = 81 | let 82 | go : List a -> List b -> List c -> List d -> List e -> List f -> List f 83 | go ao bo co do eo acc = 84 | case ao of 85 | [] -> 86 | List.reverse acc 87 | 88 | ah :: at -> 89 | case bo of 90 | [] -> 91 | List.reverse acc 92 | 93 | bh :: bt -> 94 | case co of 95 | [] -> 96 | List.reverse acc 97 | 98 | ch :: ct -> 99 | case do of 100 | [] -> 101 | List.reverse acc 102 | 103 | dh :: dt -> 104 | case eo of 105 | [] -> 106 | List.reverse acc 107 | 108 | eh :: et -> 109 | go at bt ct dt et (f ah bh ch dh eh :: acc) 110 | in 111 | go xas xbs xcs xds xes [] 112 | 113 | 114 | sortBy : (a -> comparable) -> List a -> List a 115 | sortBy f xs = 116 | sortWith (\l r -> compare (f l) (f r)) xs 117 | 118 | 119 | sortWith : (a -> a -> Order) -> List a -> List a 120 | sortWith f xs = 121 | case xs of 122 | [] -> 123 | xs 124 | 125 | [ _ ] -> 126 | xs 127 | 128 | _ -> 129 | let 130 | ( left, right ) = 131 | split xs 132 | in 133 | mergeWith f (sortWith f left) (sortWith f right) 134 | 135 | 136 | split : List a -> ( List a, List a ) 137 | split xs = 138 | let 139 | goLeft : List a -> List a -> List a -> ( List a, List a ) 140 | goLeft l lacc racc = 141 | case l of 142 | [] -> 143 | ( lacc, racc ) 144 | 145 | lh :: lt -> 146 | goRight lt (lh :: lacc) racc 147 | 148 | goRight : List a -> List a -> List a -> ( List a, List a ) 149 | goRight l lacc racc = 150 | case l of 151 | [] -> 152 | ( lacc, racc ) 153 | 154 | lh :: lt -> 155 | goLeft lt lacc (lh :: racc) 156 | in 157 | goLeft xs [] [] 158 | 159 | 160 | mergeWith : (a -> a -> Order) -> List a -> List a -> List a 161 | mergeWith f ls rs = 162 | case ls of 163 | [] -> 164 | rs 165 | 166 | lh :: lt -> 167 | case rs of 168 | [] -> 169 | ls 170 | 171 | rh :: rt -> 172 | case f lh rh of 173 | LT -> 174 | lh :: mergeWith f lt rs 175 | 176 | GT -> 177 | rh :: mergeWith f ls rt 178 | 179 | EQ -> 180 | lh :: rh :: mergeWith f lt rt 181 | -------------------------------------------------------------------------------- /codegen/Elm/Kernel/String.elm: -------------------------------------------------------------------------------- 1 | module Elm.Kernel.String exposing (all, any, foldl, foldr, map) 2 | 3 | 4 | any : (Char -> Bool) -> String -> Bool 5 | any f s = 6 | List.any f (String.toList s) 7 | 8 | 9 | all : (Char -> Bool) -> String -> Bool 10 | all f s = 11 | List.all f (String.toList s) 12 | 13 | 14 | map : (Char -> Char) -> String -> String 15 | map f s = 16 | String.fromList (List.map f (String.toList s)) 17 | 18 | 19 | foldl : (Char -> b -> b) -> b -> String -> b 20 | foldl f i s = 21 | case String.uncons s of 22 | Nothing -> 23 | i 24 | 25 | Just ( c, t ) -> 26 | foldl f (f c i) t 27 | 28 | 29 | foldr : (Char -> b -> b) -> b -> String -> b 30 | foldr f i s = 31 | case String.uncons (String.right 1 s) of 32 | Nothing -> 33 | i 34 | 35 | Just ( c, _ ) -> 36 | foldr f (f c i) (String.dropRight 1 s) 37 | -------------------------------------------------------------------------------- /codegen/Generate.elm: -------------------------------------------------------------------------------- 1 | module Generate exposing (main) 2 | 3 | {-| -} 4 | 5 | import Dict 6 | import Elm 7 | import Elm.Annotation as Type 8 | import Elm.Dependency exposing (Dependency) 9 | import Elm.Interface exposing (Exposed, Interface) 10 | import Elm.Parser 11 | import Elm.Processing 12 | import Elm.RawFile exposing (RawFile) 13 | import Elm.Syntax.Declaration as Declaration 14 | import Elm.Syntax.Expression as Expression 15 | import Elm.Syntax.File as File 16 | import Elm.Syntax.Infix as Infix 17 | import Elm.Syntax.Module as Module 18 | import Elm.Syntax.ModuleName exposing (ModuleName) 19 | import Elm.Syntax.Node as Node exposing (Node(..)) 20 | import Elm.Syntax.Pattern as Pattern 21 | import Elm.Syntax.Range as Range 22 | import Gen.CodeGen.Generate as Generate exposing (Directory(..)) 23 | import Gen.Dict 24 | import Gen.Elm.Dependency 25 | import Gen.Elm.Interface 26 | import Gen.Elm.Syntax.Expression 27 | import Gen.Elm.Syntax.Infix 28 | import Gen.Elm.Syntax.ModuleName 29 | import Gen.Elm.Syntax.Node 30 | import Gen.Elm.Syntax.Pattern 31 | import Gen.Elm.Syntax.Range 32 | import Gen.FastDict 33 | import Gen.H 34 | import Gen.List 35 | import Gen.Maybe 36 | import Json.Decode exposing (Value) 37 | import List.Extra 38 | import Result.Extra 39 | 40 | 41 | main : Program Value () () 42 | main = 43 | Generate.fromDirectory toFiles 44 | 45 | 46 | toFiles : Directory -> List Elm.File 47 | toFiles modulesSource = 48 | let 49 | allFiles : List String 50 | allFiles = 51 | traverseDirectoryForFiles modulesSource 52 | 53 | maybeFiles : 54 | Result 55 | String 56 | (List 57 | { moduleName : ModuleName 58 | , file : Elm.File 59 | , hasOperators : Bool 60 | , interface : Interface 61 | } 62 | ) 63 | maybeFiles = 64 | allFiles 65 | |> List.filterMap 66 | (\file -> 67 | case Elm.Parser.parse file of 68 | Err _ -> 69 | case String.split "\n" file of 70 | [] -> 71 | Just (Err "Empty") 72 | 73 | head :: _ -> 74 | Just (Err head) 75 | 76 | Ok rawFile -> 77 | let 78 | selfDependencies : List Dependency 79 | selfDependencies = 80 | [] 81 | in 82 | toFile selfDependencies rawFile 83 | |> Maybe.map Ok 84 | ) 85 | |> Result.Extra.combine 86 | |> Result.map 87 | (\files -> 88 | files 89 | |> List.Extra.gatherEqualsBy .moduleName 90 | |> List.map 91 | (\( { moduleName } as first, rest ) -> 92 | let 93 | all : 94 | List 95 | { moduleName : ModuleName 96 | , declarations : List Elm.Declaration 97 | , hasOperators : Bool 98 | , interface : Interface 99 | } 100 | all = 101 | first :: rest 102 | in 103 | { moduleName = moduleName 104 | , file = 105 | all 106 | |> List.concatMap .declarations 107 | |> Elm.file moduleName 108 | , hasOperators = List.any .hasOperators all 109 | , interface = List.concatMap .interface all 110 | } 111 | ) 112 | ) 113 | in 114 | case maybeFiles of 115 | Err e -> 116 | [ Elm.file [ "Core" ] 117 | [ Elm.declaration "somethingWentWrong" (Elm.string e) ] 118 | ] 119 | 120 | Ok files -> 121 | let 122 | functions : Elm.Declaration 123 | functions = 124 | files 125 | |> List.map 126 | (\{ moduleName } -> 127 | Elm.tuple 128 | (Elm.list <| List.map Elm.string <| List.drop 1 moduleName) 129 | (Elm.value 130 | { importFrom = moduleName 131 | , name = "functions" 132 | , annotation = Nothing 133 | } 134 | ) 135 | ) 136 | |> Gen.FastDict.fromList 137 | |> Elm.withType 138 | (Gen.FastDict.annotation_.dict 139 | Gen.Elm.Syntax.ModuleName.annotation_.moduleName 140 | (Gen.FastDict.annotation_.dict 141 | Type.string 142 | Gen.Elm.Syntax.Expression.annotation_.functionImplementation 143 | ) 144 | ) 145 | |> Elm.declaration "functions" 146 | |> Elm.expose 147 | 148 | operators : Elm.Declaration 149 | operators = 150 | files 151 | |> List.filter .hasOperators 152 | |> List.map 153 | (\{ moduleName } -> 154 | Elm.value 155 | { importFrom = moduleName 156 | , name = "operators" 157 | , annotation = Nothing 158 | } 159 | ) 160 | |> Elm.list 161 | |> Gen.List.call_.concat 162 | |> Gen.FastDict.call_.fromList 163 | |> Elm.withType 164 | (Gen.FastDict.annotation_.dict 165 | Type.string 166 | Gen.Elm.Syntax.Pattern.annotation_.qualifiedNameRef 167 | ) 168 | |> Elm.declaration "operators" 169 | |> Elm.expose 170 | 171 | dependency : Elm.Declaration 172 | dependency = 173 | Gen.Elm.Dependency.make_.dependency 174 | { name = Elm.string "elm/core" 175 | , version = Elm.string "1.0.0" 176 | , interfaces = 177 | files 178 | |> List.map 179 | (\{ moduleName, interface } -> 180 | Elm.tuple 181 | (Elm.list <| List.map Elm.string <| List.drop 1 moduleName) 182 | (interfaceToGen interface) 183 | ) 184 | |> Gen.Dict.fromList 185 | } 186 | |> Elm.declaration "dependency" 187 | |> Elm.expose 188 | 189 | core : Elm.File 190 | core = 191 | [ functions 192 | , operators 193 | , dependency 194 | ] 195 | |> Elm.file [ "Core" ] 196 | in 197 | core :: List.map .file files 198 | 199 | 200 | interfaceToGen : Interface -> Elm.Expression 201 | interfaceToGen interface = 202 | Elm.list (List.map exposedToGen interface) 203 | 204 | 205 | exposedToGen : Exposed -> Elm.Expression 206 | exposedToGen exposed = 207 | case exposed of 208 | Elm.Interface.Function name -> 209 | Gen.Elm.Interface.make_.function (Elm.string name) 210 | 211 | Elm.Interface.CustomType ( name, ctors ) -> 212 | Gen.Elm.Interface.make_.customType 213 | (Elm.tuple (Elm.string name) 214 | (Elm.list <| List.map Elm.string ctors) 215 | ) 216 | 217 | Elm.Interface.Alias name -> 218 | Gen.Elm.Interface.make_.alias (Elm.string name) 219 | 220 | Elm.Interface.Operator fixity -> 221 | Gen.Elm.Interface.make_.operator 222 | (Gen.Elm.Syntax.Infix.make_.infix 223 | { direction = renode directionToGen fixity.direction 224 | , function = renode Elm.string fixity.function 225 | , operator = renode Elm.string fixity.operator 226 | , precedence = renode Elm.int fixity.precedence 227 | } 228 | ) 229 | 230 | 231 | directionToGen : Infix.InfixDirection -> Elm.Expression 232 | directionToGen direction = 233 | case direction of 234 | Infix.Left -> 235 | Gen.Elm.Syntax.Infix.make_.left 236 | 237 | Infix.Right -> 238 | Gen.Elm.Syntax.Infix.make_.right 239 | 240 | Infix.Non -> 241 | Gen.Elm.Syntax.Infix.make_.non 242 | 243 | 244 | traverseDirectoryForFiles : Directory -> List String 245 | traverseDirectoryForFiles d = 246 | let 247 | go : Directory -> List String -> List String 248 | go (Directory directory) acc = 249 | Dict.foldl 250 | (\subdirName subdir iacc -> 251 | if subdirName == "tests" then 252 | iacc 253 | 254 | else 255 | go subdir iacc 256 | ) 257 | (Dict.foldl 258 | (\name content iacc -> 259 | if String.endsWith ".elm" name then 260 | content :: iacc 261 | 262 | else 263 | iacc 264 | ) 265 | acc 266 | directory.files 267 | ) 268 | directory.directories 269 | in 270 | go d [] 271 | 272 | 273 | type alias FileResult a = 274 | { a 275 | | moduleName : ModuleName 276 | , declarations : List Elm.Declaration 277 | , hasOperators : Bool 278 | } 279 | 280 | 281 | toFile : List Dependency -> RawFile -> Maybe (FileResult { interface : Interface }) 282 | toFile selfDependencies rawFile = 283 | let 284 | context : Elm.Processing.ProcessContext 285 | context = 286 | List.foldl Elm.Processing.addDependency Elm.Processing.init selfDependencies 287 | 288 | file : File.File 289 | file = 290 | Elm.Processing.process context rawFile 291 | in 292 | case Node.value file.moduleDefinition of 293 | Module.EffectModule _ -> 294 | -- Effect modules are not supported 295 | Nothing 296 | 297 | Module.PortModule _ -> 298 | -- Port modules are not supported 299 | Nothing 300 | 301 | Module.NormalModule { moduleName } -> 302 | let 303 | normal : FileResult {} 304 | normal = 305 | normalModuleToFile moduleName file 306 | in 307 | { moduleName = normal.moduleName 308 | , declarations = normal.declarations 309 | , hasOperators = normal.hasOperators 310 | , interface = Elm.Interface.build rawFile 311 | } 312 | |> Just 313 | 314 | 315 | normalModuleToFile : Node ModuleName -> File.File -> FileResult {} 316 | normalModuleToFile (Node _ moduleName) file = 317 | let 318 | generatedModuleName : ModuleName 319 | generatedModuleName = 320 | "Core" :: moduleName 321 | 322 | namesAndDeclarations : List ( String, Elm.Declaration ) 323 | namesAndDeclarations = 324 | file.declarations 325 | |> List.filterMap (declarationToGen moduleName) 326 | 327 | names : List String 328 | names = 329 | List.map Tuple.first namesAndDeclarations 330 | 331 | declarations : List Elm.Declaration 332 | declarations = 333 | List.map Tuple.second namesAndDeclarations 334 | 335 | functions : Elm.Declaration 336 | functions = 337 | names 338 | |> List.map 339 | (\name -> 340 | Elm.tuple 341 | (Elm.string name) 342 | (Elm.value 343 | { importFrom = [] 344 | , name = name 345 | , annotation = 346 | Just 347 | Gen.Elm.Syntax.Expression.annotation_.functionImplementation 348 | } 349 | ) 350 | ) 351 | |> Gen.FastDict.fromList 352 | |> Elm.declaration "functions" 353 | |> Elm.expose 354 | 355 | operators : List Elm.Expression 356 | operators = 357 | List.filterMap 358 | (\(Node _ declaration) -> 359 | case declaration of 360 | Declaration.InfixDeclaration { operator, function } -> 361 | let 362 | functionName : String 363 | functionName = 364 | Node.value function 365 | in 366 | case List.reverse <| List.map Elm.string <| String.split "." functionName of 367 | name :: reverseModule -> 368 | let 369 | fixedModule : List Elm.Expression 370 | fixedModule = 371 | if List.isEmpty reverseModule then 372 | List.map Elm.string moduleName 373 | 374 | else 375 | List.reverse reverseModule 376 | in 377 | Just 378 | (Elm.tuple 379 | (Elm.string <| Node.value operator) 380 | (Gen.Elm.Syntax.Pattern.make_.qualifiedNameRef 381 | { moduleName = Elm.list fixedModule 382 | , name = name 383 | } 384 | ) 385 | ) 386 | 387 | [] -> 388 | Nothing 389 | 390 | _ -> 391 | Nothing 392 | ) 393 | file.declarations 394 | 395 | outputDeclarations : List Elm.Declaration 396 | outputDeclarations = 397 | if List.isEmpty operators then 398 | functions :: declarations 399 | 400 | else 401 | let 402 | operatorsDeclaration : Elm.Declaration 403 | operatorsDeclaration = 404 | operators 405 | |> Elm.list 406 | |> Elm.declaration "operators" 407 | |> Elm.expose 408 | in 409 | functions :: operatorsDeclaration :: declarations 410 | in 411 | { moduleName = generatedModuleName 412 | , declarations = outputDeclarations 413 | , hasOperators = not (List.isEmpty operators) 414 | } 415 | 416 | 417 | declarationToGen : ModuleName -> Node Declaration.Declaration -> Maybe ( String, Elm.Declaration ) 418 | declarationToGen moduleName (Node _ declaration) = 419 | case declaration of 420 | Declaration.FunctionDeclaration function -> 421 | let 422 | implementation : Expression.FunctionImplementation 423 | implementation = 424 | Node.value function.declaration 425 | 426 | name : String 427 | name = 428 | Node.value implementation.name 429 | in 430 | Just 431 | ( name 432 | , functionImplementationToGen 433 | { implementation 434 | | name = 435 | Node 436 | (Node.range implementation.name) 437 | (String.join "." (moduleName ++ [ name ])) 438 | } 439 | |> Elm.declaration name 440 | |> Elm.expose 441 | ) 442 | 443 | _ -> 444 | Nothing 445 | 446 | 447 | functionImplementationToGen : Expression.FunctionImplementation -> Elm.Expression 448 | functionImplementationToGen { name, arguments, expression } = 449 | Gen.Elm.Syntax.Expression.make_.functionImplementation 450 | { name = renode Elm.string name 451 | , arguments = arguments |> List.map (\pattern -> renode patternToGen pattern) |> Elm.list 452 | , expression = renode expressionToGen expression 453 | } 454 | 455 | 456 | patternToGen : Pattern.Pattern -> Elm.Expression 457 | patternToGen pattern = 458 | case pattern of 459 | Pattern.AllPattern -> 460 | Gen.Elm.Syntax.Pattern.make_.allPattern 461 | 462 | Pattern.UnitPattern -> 463 | Gen.Elm.Syntax.Pattern.make_.unitPattern 464 | 465 | Pattern.CharPattern c -> 466 | Gen.Elm.Syntax.Pattern.make_.charPattern (Elm.char c) 467 | 468 | Pattern.StringPattern s -> 469 | Gen.Elm.Syntax.Pattern.make_.stringPattern (Elm.string s) 470 | 471 | Pattern.IntPattern i -> 472 | Gen.Elm.Syntax.Pattern.make_.intPattern (Elm.int i) 473 | 474 | Pattern.HexPattern x -> 475 | Gen.Elm.Syntax.Pattern.make_.hexPattern (Elm.hex x) 476 | 477 | Pattern.FloatPattern f -> 478 | Gen.Elm.Syntax.Pattern.make_.floatPattern (Elm.float f) 479 | 480 | Pattern.TuplePattern children -> 481 | Gen.Elm.Syntax.Pattern.make_.tuplePattern (renodeList patternToGen children) 482 | 483 | Pattern.RecordPattern fields -> 484 | Gen.Elm.Syntax.Pattern.make_.recordPattern (renodeList Elm.string fields) 485 | 486 | Pattern.VarPattern name -> 487 | Gen.Elm.Syntax.Pattern.make_.varPattern (Elm.string name) 488 | 489 | Pattern.ParenthesizedPattern child -> 490 | Gen.Elm.Syntax.Pattern.make_.parenthesizedPattern (renode patternToGen child) 491 | 492 | Pattern.AsPattern child name -> 493 | Gen.Elm.Syntax.Pattern.make_.asPattern (renode patternToGen child) (renode Elm.string name) 494 | 495 | Pattern.UnConsPattern head tail -> 496 | Gen.Elm.Syntax.Pattern.make_.unConsPattern (renode patternToGen head) (renode patternToGen tail) 497 | 498 | Pattern.ListPattern children -> 499 | Gen.Elm.Syntax.Pattern.make_.listPattern (renodeList patternToGen children) 500 | 501 | Pattern.NamedPattern qualifiedNameRef children -> 502 | Gen.Elm.Syntax.Pattern.make_.namedPattern (qualifiedNameRefToGen qualifiedNameRef) (renodeList patternToGen children) 503 | 504 | 505 | qualifiedNameRefToGen : Pattern.QualifiedNameRef -> Elm.Expression 506 | qualifiedNameRefToGen { name, moduleName } = 507 | Gen.Elm.Syntax.Pattern.make_.qualifiedNameRef 508 | { name = Elm.string name 509 | , moduleName = Elm.list (List.map Elm.string moduleName) 510 | } 511 | 512 | 513 | renode : (a -> Elm.Expression) -> Node a -> Elm.Expression 514 | renode toGen (Node range value) = 515 | if range.start.row == range.end.row then 516 | Gen.H.node1 range.start.row range.start.column range.end.column (toGen value) 517 | 518 | else 519 | Gen.H.node range.start.row range.start.column range.end.row range.end.column (toGen value) 520 | 521 | 522 | renodeList : (a -> Elm.Expression) -> List (Node a) -> Elm.Expression 523 | renodeList f list = 524 | Elm.list (List.map (renode f) list) 525 | 526 | 527 | expressionToGen : Expression.Expression -> Elm.Expression 528 | expressionToGen expression = 529 | case expression of 530 | Expression.UnitExpr -> 531 | Gen.Elm.Syntax.Expression.make_.unitExpr 532 | 533 | Expression.Application children -> 534 | Gen.Elm.Syntax.Expression.make_.application (renodeList expressionToGen children) 535 | 536 | Expression.OperatorApplication opName infix_ l r -> 537 | Gen.Elm.Syntax.Expression.make_.operatorApplication 538 | (Elm.string opName) 539 | (infixToGen infix_) 540 | (renode expressionToGen l) 541 | (renode expressionToGen r) 542 | 543 | Expression.FunctionOrValue [] name -> 544 | Gen.H.val name 545 | 546 | Expression.FunctionOrValue moduleName name -> 547 | Gen.Elm.Syntax.Expression.make_.functionOrValue (Elm.list <| List.map Elm.string moduleName) (Elm.string name) 548 | 549 | Expression.IfBlock cond true false -> 550 | Gen.Elm.Syntax.Expression.make_.ifBlock 551 | (renode expressionToGen cond) 552 | (renode expressionToGen true) 553 | (renode expressionToGen false) 554 | 555 | Expression.PrefixOperator opName -> 556 | Gen.Elm.Syntax.Expression.make_.prefixOperator (Elm.string opName) 557 | 558 | Expression.Operator opName -> 559 | Gen.Elm.Syntax.Expression.make_.operator (Elm.string opName) 560 | 561 | Expression.Integer i -> 562 | Gen.Elm.Syntax.Expression.make_.integer (Elm.int i) 563 | 564 | Expression.Hex x -> 565 | Gen.Elm.Syntax.Expression.make_.hex (Elm.hex x) 566 | 567 | Expression.Floatable f -> 568 | Gen.Elm.Syntax.Expression.make_.floatable (Elm.float f) 569 | 570 | Expression.Negation child -> 571 | Gen.Elm.Syntax.Expression.make_.negation (renode expressionToGen child) 572 | 573 | Expression.Literal s -> 574 | Gen.Elm.Syntax.Expression.make_.literal (Elm.string s) 575 | 576 | Expression.CharLiteral c -> 577 | Gen.Elm.Syntax.Expression.make_.charLiteral (Elm.char c) 578 | 579 | Expression.TupledExpression children -> 580 | Gen.Elm.Syntax.Expression.make_.tupledExpression (renodeList expressionToGen children) 581 | 582 | Expression.ParenthesizedExpression child -> 583 | Gen.Elm.Syntax.Expression.make_.parenthesizedExpression (renode expressionToGen child) 584 | 585 | Expression.LetExpression letBlock -> 586 | Gen.Elm.Syntax.Expression.make_.letExpression (letBlockToGen letBlock) 587 | 588 | Expression.CaseExpression caseBlock -> 589 | Gen.Elm.Syntax.Expression.make_.caseExpression (caseBlockToGen caseBlock) 590 | 591 | Expression.LambdaExpression lambda -> 592 | Gen.Elm.Syntax.Expression.make_.lambdaExpression (lambdaToGen lambda) 593 | 594 | Expression.RecordExpr setters -> 595 | Gen.Elm.Syntax.Expression.make_.recordExpr (renodeList recordSetterToGen setters) 596 | 597 | Expression.ListExpr children -> 598 | Gen.Elm.Syntax.Expression.make_.listExpr (renodeList expressionToGen children) 599 | 600 | Expression.RecordAccess child field -> 601 | Gen.Elm.Syntax.Expression.make_.recordAccess (renode expressionToGen child) (renode Elm.string field) 602 | 603 | Expression.RecordAccessFunction name -> 604 | Gen.Elm.Syntax.Expression.make_.recordAccessFunction (Elm.string name) 605 | 606 | Expression.RecordUpdateExpression name setters -> 607 | Gen.Elm.Syntax.Expression.make_.recordUpdateExpression (renode Elm.string name) (renodeList recordSetterToGen setters) 608 | 609 | Expression.GLSLExpression s -> 610 | Gen.Elm.Syntax.Expression.make_.gLSLExpression (Elm.string s) 611 | 612 | 613 | caseBlockToGen : Expression.CaseBlock -> Elm.Expression 614 | caseBlockToGen { expression, cases } = 615 | Gen.Elm.Syntax.Expression.make_.caseBlock 616 | { expression = renode expressionToGen expression 617 | , cases = Elm.list <| List.map caseToGen cases 618 | } 619 | 620 | 621 | caseToGen : Expression.Case -> Elm.Expression 622 | caseToGen ( pattern, expression ) = 623 | Elm.tuple 624 | (renode patternToGen pattern) 625 | (renode expressionToGen expression) 626 | 627 | 628 | lambdaToGen : Expression.Lambda -> Elm.Expression 629 | lambdaToGen { args, expression } = 630 | Gen.Elm.Syntax.Expression.make_.lambda 631 | { args = renodeList patternToGen args 632 | , expression = renode expressionToGen expression 633 | } 634 | 635 | 636 | letBlockToGen : Expression.LetBlock -> Elm.Expression 637 | letBlockToGen { declarations, expression } = 638 | Gen.Elm.Syntax.Expression.make_.letBlock 639 | { declarations = renodeList letDeclarationToGen declarations 640 | , expression = renode expressionToGen expression 641 | } 642 | 643 | 644 | letDeclarationToGen : Expression.LetDeclaration -> Elm.Expression 645 | letDeclarationToGen declaration = 646 | case declaration of 647 | Expression.LetFunction function -> 648 | Gen.Elm.Syntax.Expression.make_.letFunction (functionToGen function) 649 | 650 | Expression.LetDestructuring pattern expression -> 651 | Gen.Elm.Syntax.Expression.make_.letDestructuring (renode patternToGen pattern) (renode expressionToGen expression) 652 | 653 | 654 | functionToGen : Expression.Function -> Elm.Expression 655 | functionToGen { declaration } = 656 | Gen.Elm.Syntax.Expression.make_.function 657 | { documentation = Gen.Maybe.make_.nothing 658 | , signature = Gen.Maybe.make_.nothing 659 | , declaration = renode functionImplementationToGen declaration 660 | } 661 | 662 | 663 | recordSetterToGen : Expression.RecordSetter -> Elm.Expression 664 | recordSetterToGen ( name, value ) = 665 | Elm.tuple (renode Elm.string name) (renode expressionToGen value) 666 | 667 | 668 | infixToGen : Infix.InfixDirection -> Elm.Expression 669 | infixToGen direction = 670 | case direction of 671 | Infix.Left -> 672 | Gen.Elm.Syntax.Infix.make_.left 673 | 674 | Infix.Right -> 675 | Gen.Elm.Syntax.Infix.make_.right 676 | 677 | Infix.Non -> 678 | Gen.Elm.Syntax.Infix.make_.non 679 | -------------------------------------------------------------------------------- /codegen/elm.codegen.json: -------------------------------------------------------------------------------- 1 | { 2 | "elm-codegen-version": "0.5.2", 3 | "codegen-helpers": { 4 | "packages": { 5 | "elm/core": "1.0.5", 6 | "stil4m/elm-syntax": "7.2.9", 7 | "miniBill/elm-fast-dict": "1.1.0" 8 | }, 9 | "local": [ 10 | "helpers" 11 | ] 12 | } 13 | } -------------------------------------------------------------------------------- /codegen/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "." 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/core": "1.0.5", 10 | "elm/json": "1.1.3", 11 | "elm-community/list-extra": "8.7.0", 12 | "elm-community/result-extra": "2.4.0", 13 | "mdgriffith/elm-codegen": "4.1.1", 14 | "miniBill/elm-fast-dict": "1.1.0", 15 | "stil4m/elm-syntax": "7.3.2" 16 | }, 17 | "indirect": { 18 | "elm/parser": "1.1.0", 19 | "elm-community/basics-extra": "4.1.0", 20 | "miniBill/elm-unicode": "1.1.0", 21 | "rtfeldman/elm-hex": "1.0.0", 22 | "stil4m/structured-writer": "1.0.3", 23 | "the-sett/elm-pretty-printer": "3.1.0" 24 | } 25 | }, 26 | "test-dependencies": { 27 | "direct": {}, 28 | "indirect": {} 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /codegen/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "devDependencies": { 3 | "elm-review": "^2.10.2" 4 | }, 5 | "license": "BSD-3-Clause" 6 | } -------------------------------------------------------------------------------- /codegen/review/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/core": "1.0.5", 10 | "elm/project-metadata-utils": "1.0.2", 11 | "jfmengels/elm-review": "2.13.0", 12 | "jfmengels/elm-review-code-style": "1.1.4", 13 | "jfmengels/elm-review-common": "1.3.2", 14 | "jfmengels/elm-review-simplify": "2.0.29", 15 | "jfmengels/elm-review-unused": "1.1.29", 16 | "sparksp/elm-review-always": "1.0.6", 17 | "sparksp/elm-review-imports": "1.0.2", 18 | "truqu/elm-review-nobooleancase": "1.0.1" 19 | }, 20 | "indirect": { 21 | "elm/bytes": "1.0.8", 22 | "elm/html": "1.0.0", 23 | "elm/json": "1.1.3", 24 | "elm/parser": "1.1.0", 25 | "elm/random": "1.0.0", 26 | "elm/time": "1.0.0", 27 | "elm/virtual-dom": "1.0.3", 28 | "elm-community/list-extra": "8.7.0", 29 | "elm-explorations/test": "2.1.1", 30 | "miniBill/elm-unicode": "1.0.3", 31 | "pzp1997/assoc-list": "1.0.0", 32 | "rtfeldman/elm-hex": "1.0.0", 33 | "stil4m/elm-syntax": "7.2.9", 34 | "stil4m/structured-writer": "1.0.3" 35 | } 36 | }, 37 | "test-dependencies": { 38 | "direct": {}, 39 | "indirect": {} 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /codegen/review/src/ReviewConfig.elm: -------------------------------------------------------------------------------- 1 | module ReviewConfig exposing (config) 2 | 3 | import NoAlways 4 | import NoBooleanCase 5 | import NoExposingEverything 6 | import NoImportingEverything 7 | import NoMissingTypeAnnotation 8 | import NoMissingTypeAnnotationInLetIn 9 | import NoMissingTypeExpose 10 | import NoModuleOnExposedNames 11 | import NoPrematureLetComputation 12 | import NoSimpleLetBody 13 | import NoUnused.CustomTypeConstructorArgs 14 | import NoUnused.CustomTypeConstructors 15 | -- import NoUnused.Dependencies 16 | import NoUnused.Exports 17 | import NoUnused.Parameters 18 | import NoUnused.Patterns 19 | import NoUnused.Variables 20 | import Review.Rule as Rule exposing (Rule) 21 | import Simplify 22 | 23 | 24 | config : List Rule 25 | config = 26 | [ NoAlways.rule 27 | , NoBooleanCase.rule 28 | , NoExposingEverything.rule 29 | , NoImportingEverything.rule [] 30 | , NoMissingTypeAnnotation.rule 31 | , NoMissingTypeAnnotationInLetIn.rule 32 | , NoMissingTypeExpose.rule 33 | , NoModuleOnExposedNames.rule 34 | , NoPrematureLetComputation.rule 35 | , NoSimpleLetBody.rule 36 | , NoUnused.CustomTypeConstructorArgs.rule 37 | , NoUnused.CustomTypeConstructors.rule [] 38 | -- , NoUnused.Dependencies.rule 39 | , NoUnused.Exports.rule 40 | |> Rule.ignoreErrorsForDirectories [ "Elm/Kernel" ] 41 | , NoUnused.Parameters.rule 42 | , NoUnused.Patterns.rule 43 | , NoUnused.Variables.rule 44 | , Simplify.rule Simplify.defaults 45 | |> Rule.ignoreErrorsForDirectories [ "tests", "../tests" ] 46 | ] 47 | |> List.map 48 | (\rule -> 49 | rule 50 | |> Rule.ignoreErrorsForDirectories [ "node_modules", "Gen" ] 51 | ) 52 | -------------------------------------------------------------------------------- /elm-interpreter.code-workspace: -------------------------------------------------------------------------------- 1 | { 2 | "folders": [ 3 | { 4 | "path": "." 5 | }, 6 | { 7 | "path": "codegen" 8 | } 9 | ], 10 | "settings": {} 11 | } -------------------------------------------------------------------------------- /elm-watch.json: -------------------------------------------------------------------------------- 1 | { 2 | "targets": { 3 | "UI": { 4 | "inputs": [ 5 | "src/UI.elm" 6 | ], 7 | "output": "dist/ui.js" 8 | } 9 | }, 10 | "serve": "." 11 | } -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src", 5 | "generated", 6 | "helpers" 7 | ], 8 | "elm-version": "0.19.1", 9 | "dependencies": { 10 | "direct": { 11 | "elm/browser": "1.0.2", 12 | "elm/core": "1.0.5", 13 | "elm/html": "1.0.0", 14 | "elm/json": "1.1.3", 15 | "elm/parser": "1.1.0", 16 | "elm-community/list-extra": "8.7.0", 17 | "elm-community/maybe-extra": "5.3.0", 18 | "mdgriffith/elm-ui": "1.1.8", 19 | "micahhahn/elm-safe-recursion": "2.0.0", 20 | "miniBill/elm-fast-dict": "1.1.0", 21 | "miniBill/elm-rope": "1.0.0", 22 | "miniBill/elm-unicode": "1.1.0", 23 | "rtfeldman/elm-hex": "1.0.0", 24 | "stil4m/elm-syntax": "7.3.2", 25 | "the-sett/elm-pretty-printer": "3.1.0", 26 | "the-sett/elm-syntax-dsl": "6.0.2" 27 | }, 28 | "indirect": { 29 | "Chadtech/elm-bool-extra": "2.4.2", 30 | "elm/time": "1.0.0", 31 | "elm/url": "1.0.0", 32 | "elm/virtual-dom": "1.0.3", 33 | "elm-community/basics-extra": "4.1.0", 34 | "stil4m/structured-writer": "1.0.3" 35 | } 36 | }, 37 | "test-dependencies": { 38 | "direct": { 39 | "elm-explorations/test": "2.2.0" 40 | }, 41 | "indirect": { 42 | "elm/bytes": "1.0.8", 43 | "elm/random": "1.0.0" 44 | } 45 | } 46 | } -------------------------------------------------------------------------------- /helpers/H.elm: -------------------------------------------------------------------------------- 1 | module H exposing (node, node1, val) 2 | 3 | import Elm.Syntax.Expression 4 | import Elm.Syntax.Node exposing (Node(..)) 5 | 6 | 7 | node : Int -> Int -> Int -> Int -> a -> Node a 8 | node fr fc tr tc value = 9 | Node 10 | { start = { row = fr, column = fc } 11 | , end = { row = tr, column = tc } 12 | } 13 | value 14 | 15 | 16 | node1 : Int -> Int -> Int -> a -> Node a 17 | node1 fr fc tc value = 18 | Node 19 | { start = { row = fr, column = fc } 20 | , end = { row = fr, column = tc } 21 | } 22 | value 23 | 24 | 25 | val : String -> Elm.Syntax.Expression.Expression 26 | val name = 27 | Elm.Syntax.Expression.FunctionOrValue [] name 28 | -------------------------------------------------------------------------------- /ideas.md: -------------------------------------------------------------------------------- 1 | mouseover value from env 2 | out of memory/stack overflow/infinite loop 3 | step-by-step 4 | viewers 5 | edit local variable value 6 | jump to code from the tree 7 | keep tree open when editing 8 | current line on the code, highlighted current line, step button 9 | previous line is colored (less) 10 | historical debugging 11 | -------------------------------------------------------------------------------- /index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | UI 8 | 9 | 10 |
11 | 12 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "license": "BSD-3-Clause", 3 | "devDependencies": { 4 | "elm-codegen": "^0.6.1", 5 | "elm-pages": "^3.0.19", 6 | "elm-review": "^2.12.0", 7 | "elm-test-rs": "^3.0.0-5", 8 | "elm-watch": "^2.0.0-beta.3" 9 | }, 10 | "overrides": { 11 | "elm-doc-preview": ">=6.0.0", 12 | "cross-spawn": ">=7.0.3" 13 | }, 14 | "resolutions": { 15 | "elm-doc-preview": ">=6.0.0", 16 | "cross-spawn": ">=7.0.3" 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /review/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/core": "1.0.5", 10 | "elm/project-metadata-utils": "1.0.2", 11 | "jfmengels/elm-review": "2.13.0", 12 | "jfmengels/elm-review-code-style": "1.1.4", 13 | "jfmengels/elm-review-common": "1.3.2", 14 | "jfmengels/elm-review-simplify": "2.0.29", 15 | "jfmengels/elm-review-unused": "1.1.29", 16 | "sparksp/elm-review-always": "1.0.6", 17 | "sparksp/elm-review-imports": "1.0.2", 18 | "truqu/elm-review-nobooleancase": "1.0.1" 19 | }, 20 | "indirect": { 21 | "elm/bytes": "1.0.8", 22 | "elm/html": "1.0.0", 23 | "elm/json": "1.1.3", 24 | "elm/parser": "1.1.0", 25 | "elm/random": "1.0.0", 26 | "elm/time": "1.0.0", 27 | "elm/virtual-dom": "1.0.3", 28 | "elm-community/list-extra": "8.7.0", 29 | "elm-explorations/test": "2.1.1", 30 | "miniBill/elm-unicode": "1.0.3", 31 | "pzp1997/assoc-list": "1.0.0", 32 | "rtfeldman/elm-hex": "1.0.0", 33 | "stil4m/elm-syntax": "7.2.9", 34 | "stil4m/structured-writer": "1.0.3" 35 | } 36 | }, 37 | "test-dependencies": { 38 | "direct": {}, 39 | "indirect": {} 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /review/src/ReviewConfig.elm: -------------------------------------------------------------------------------- 1 | module ReviewConfig exposing (config) 2 | 3 | import NoAlways 4 | import NoBooleanCase 5 | import NoExposingEverything 6 | import NoImportingEverything 7 | import NoMissingTypeAnnotation 8 | import NoMissingTypeAnnotationInLetIn 9 | import NoMissingTypeExpose 10 | import NoModuleOnExposedNames 11 | import NoPrematureLetComputation 12 | import NoSimpleLetBody 13 | import NoUnused.CustomTypeConstructorArgs 14 | import NoUnused.CustomTypeConstructors 15 | import NoUnused.Dependencies 16 | import NoUnused.Exports 17 | import NoUnused.Modules 18 | import NoUnused.Parameters 19 | import NoUnused.Patterns 20 | import NoUnused.Variables 21 | import Review.Rule as Rule exposing (Rule) 22 | import Simplify 23 | 24 | 25 | config : List Rule 26 | config = 27 | [ NoAlways.rule 28 | , NoBooleanCase.rule 29 | , NoExposingEverything.rule 30 | , NoImportingEverything.rule [] 31 | , NoMissingTypeAnnotation.rule 32 | , NoMissingTypeAnnotationInLetIn.rule 33 | , NoMissingTypeExpose.rule 34 | , NoModuleOnExposedNames.rule 35 | , NoPrematureLetComputation.rule 36 | , NoSimpleLetBody.rule 37 | , NoUnused.CustomTypeConstructorArgs.rule 38 | , NoUnused.CustomTypeConstructors.rule [] 39 | , NoUnused.Dependencies.rule 40 | , NoUnused.Exports.rule 41 | , NoUnused.Modules.rule 42 | , NoUnused.Parameters.rule 43 | , NoUnused.Patterns.rule 44 | , NoUnused.Variables.rule 45 | , Simplify.rule Simplify.defaults 46 | |> Rule.ignoreErrorsForDirectories [ "tests" ] 47 | ] 48 | |> List.map 49 | (\rule -> 50 | rule 51 | |> Rule.ignoreErrorsForDirectories [ "Gen" ] 52 | |> Rule.ignoreErrorsForDirectories [ "generated" ] 53 | ) 54 | -------------------------------------------------------------------------------- /script/.gitignore: -------------------------------------------------------------------------------- 1 | 2 | elm-stuff 3 | -------------------------------------------------------------------------------- /script/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src", 5 | "../src", 6 | "../generated" 7 | ], 8 | "elm-version": "0.19.1", 9 | "dependencies": { 10 | "direct": { 11 | "dillonkearns/elm-cli-options-parser": "3.2.0", 12 | "dillonkearns/elm-pages": "10.0.1", 13 | "elm/browser": "1.0.2", 14 | "elm/core": "1.0.5", 15 | "elm/html": "1.0.0", 16 | "elm/parser": "1.1.0", 17 | "elm-community/list-extra": "8.7.0", 18 | "elm-community/maybe-extra": "5.3.0", 19 | "miniBill/elm-fast-dict": "1.1.0", 20 | "miniBill/elm-rope": "1.0.0", 21 | "miniBill/elm-unicode": "1.0.3", 22 | "stil4m/elm-syntax": "7.2.9" 23 | }, 24 | "indirect": { 25 | "Chadtech/elm-bool-extra": "2.4.2", 26 | "avh4/elm-color": "1.0.0", 27 | "danfishgold/base64-bytes": "1.1.0", 28 | "danyx23/elm-mimetype": "4.0.1", 29 | "dillonkearns/elm-bcp47-language-tag": "1.0.1", 30 | "dillonkearns/elm-date-or-date-time": "2.0.0", 31 | "dillonkearns/elm-form": "3.0.0", 32 | "elm/bytes": "1.0.8", 33 | "elm/file": "1.0.5", 34 | "elm/http": "2.0.0", 35 | "elm/json": "1.1.3", 36 | "elm/random": "1.0.0", 37 | "elm/regex": "1.0.0", 38 | "elm/time": "1.0.0", 39 | "elm/url": "1.0.0", 40 | "elm/virtual-dom": "1.0.3", 41 | "elm-community/basics-extra": "4.1.0", 42 | "fredcy/elm-parseint": "2.0.1", 43 | "jluckyiv/elm-utc-date-strings": "1.0.0", 44 | "justinmimbs/date": "4.0.1", 45 | "mdgriffith/elm-codegen": "3.0.0", 46 | "miniBill/elm-codec": "2.0.0", 47 | "noahzgordon/elm-color-extra": "1.0.2", 48 | "robinheghan/fnv1a": "1.0.0", 49 | "robinheghan/murmur3": "1.0.0", 50 | "rtfeldman/elm-css": "18.0.0", 51 | "rtfeldman/elm-hex": "1.0.0", 52 | "rtfeldman/elm-iso8601-date-strings": "1.1.4", 53 | "stil4m/structured-writer": "1.0.3", 54 | "the-sett/elm-pretty-printer": "3.0.0", 55 | "the-sett/elm-syntax-dsl": "6.0.2", 56 | "vito/elm-ansi": "10.0.1" 57 | } 58 | }, 59 | "test-dependencies": { 60 | "direct": {}, 61 | "indirect": {} 62 | } 63 | } 64 | -------------------------------------------------------------------------------- /script/src/Trace.elm: -------------------------------------------------------------------------------- 1 | module Trace exposing (run) 2 | 3 | import BackendTask exposing (BackendTask) 4 | import Cli.Option as Option 5 | import Cli.OptionsParser as OptionsParser 6 | import Cli.Program as Program 7 | import Eval 8 | import Eval.Log as Log 9 | import FatalError exposing (FatalError) 10 | import Pages.Script as Script exposing (Script) 11 | import Rope 12 | 13 | 14 | run : Script 15 | run = 16 | Script.withCliOptions programConfig 17 | (\{ input } -> 18 | let 19 | ( _, _, log ) = 20 | Eval.trace input 21 | in 22 | log 23 | |> Rope.toList 24 | |> List.map logLine 25 | |> BackendTask.combine 26 | |> BackendTask.map (\_ -> ()) 27 | ) 28 | 29 | 30 | logLine : Log.Line -> BackendTask FatalError () 31 | logLine line = 32 | Script.log line.message 33 | 34 | 35 | programConfig : Program.Config { input : String } 36 | programConfig = 37 | Program.config 38 | |> Program.add 39 | (OptionsParser.build (\input -> { input = input }) 40 | |> OptionsParser.with (Option.requiredKeywordArg "input") 41 | ) 42 | 43 | 44 | 45 | -- Array.toList (Array.initialize 1056 identity) 46 | -------------------------------------------------------------------------------- /src/Environment.elm: -------------------------------------------------------------------------------- 1 | module Environment exposing (addFunction, addValue, call, empty, with) 2 | 3 | import Elm.Syntax.Expression exposing (FunctionImplementation) 4 | import Elm.Syntax.ModuleName exposing (ModuleName) 5 | import Elm.Syntax.Node as Node 6 | import FastDict as Dict 7 | import Types exposing (Env, EnvValues, Value) 8 | 9 | 10 | addValue : String -> Value -> Env -> Env 11 | addValue name value env = 12 | { env 13 | | values = Dict.insert name value env.values 14 | } 15 | 16 | 17 | addFunction : ModuleName -> FunctionImplementation -> Env -> Env 18 | addFunction moduleName function env = 19 | { env 20 | | functions = 21 | Dict.insert 22 | moduleName 23 | (Dict.insert (Node.value function.name) 24 | function 25 | (Maybe.withDefault Dict.empty 26 | (Dict.get moduleName env.functions) 27 | ) 28 | ) 29 | env.functions 30 | } 31 | 32 | 33 | with : EnvValues -> Env -> Env 34 | with newValues old = 35 | { old | values = Dict.union newValues old.values } 36 | 37 | 38 | empty : ModuleName -> Env 39 | empty moduleName = 40 | { currentModule = moduleName 41 | , callStack = [] 42 | , functions = Dict.empty 43 | , values = Dict.empty 44 | } 45 | 46 | 47 | call : ModuleName -> String -> Env -> Env 48 | call moduleName name env = 49 | { env 50 | | currentModule = moduleName 51 | , callStack = 52 | { moduleName = moduleName, name = name } 53 | :: env.callStack 54 | } 55 | -------------------------------------------------------------------------------- /src/Eval.elm: -------------------------------------------------------------------------------- 1 | module Eval exposing (eval, indent, toModule, trace) 2 | 3 | import Elm.Syntax.Expression as Expression exposing (Expression) 4 | import Eval.Module 5 | import Rope exposing (Rope) 6 | import Types exposing (CallTree, Error, Value) 7 | 8 | 9 | eval : String -> Result Error Value 10 | eval expressionSource = 11 | let 12 | ( result, _, _ ) = 13 | traceOrEval { trace = True } expressionSource 14 | in 15 | result 16 | 17 | 18 | trace : String -> ( Result Error Value, Rope CallTree, Rope String ) 19 | trace expressionSource = 20 | traceOrEval { trace = True } expressionSource 21 | 22 | 23 | traceOrEval : { trace : Bool } -> String -> ( Result Error Value, Rope CallTree, Rope String ) 24 | traceOrEval cfg expressionSource = 25 | let 26 | source : String 27 | source = 28 | toModule expressionSource 29 | 30 | expression : Expression 31 | expression = 32 | Expression.FunctionOrValue [] "main" 33 | in 34 | Eval.Module.traceOrEvalModule cfg source expression 35 | 36 | 37 | toModule : String -> String 38 | toModule expression = 39 | "module Main exposing (main)\n\nmain =\n" 40 | ++ indent 4 expression 41 | 42 | 43 | indent : Int -> String -> String 44 | indent count input = 45 | let 46 | prefix : String 47 | prefix = 48 | String.repeat count " " 49 | in 50 | input 51 | |> String.split "\n" 52 | |> List.map 53 | (\line -> 54 | if String.isEmpty line then 55 | line 56 | 57 | else 58 | prefix ++ line 59 | ) 60 | |> String.join "\n" 61 | -------------------------------------------------------------------------------- /src/Eval/Module.elm: -------------------------------------------------------------------------------- 1 | module Eval.Module exposing (eval, trace, traceOrEvalModule) 2 | 3 | import Core 4 | import Elm.Parser 5 | import Elm.Syntax.Declaration exposing (Declaration(..)) 6 | import Elm.Syntax.Expression exposing (Expression(..)) 7 | import Elm.Syntax.File exposing (File) 8 | import Elm.Syntax.Module exposing (Module(..)) 9 | import Elm.Syntax.ModuleName exposing (ModuleName) 10 | import Elm.Syntax.Node as Node exposing (Node(..)) 11 | import Environment 12 | import Eval.Expression 13 | import FastDict as Dict 14 | import List.Extra 15 | import Result.MyExtra 16 | import Rope exposing (Rope) 17 | import Syntax exposing (fakeNode) 18 | import Types exposing (CallTree, Env, Error(..), Value) 19 | import Value exposing (unsupported) 20 | 21 | 22 | eval : String -> Expression -> Result Error Value 23 | eval source expression = 24 | let 25 | ( result, _, _ ) = 26 | traceOrEvalModule { trace = False } source expression 27 | in 28 | result 29 | 30 | 31 | trace : String -> Expression -> ( Result Error Value, Rope CallTree, Rope String ) 32 | trace source expression = 33 | traceOrEvalModule { trace = True } source expression 34 | 35 | 36 | traceOrEvalModule : { trace : Bool } -> String -> Expression -> ( Result Error Value, Rope CallTree, Rope String ) 37 | traceOrEvalModule cfg source expression = 38 | let 39 | maybeEnv : Result Error Env 40 | maybeEnv = 41 | source 42 | |> Elm.Parser.parseToFile 43 | |> Result.mapError ParsingError 44 | |> Result.andThen buildInitialEnv 45 | in 46 | case maybeEnv of 47 | Err e -> 48 | ( Err e, Rope.empty, Rope.empty ) 49 | 50 | Ok env -> 51 | let 52 | maybeNode : a -> Node a 53 | maybeNode = 54 | case expression of 55 | FunctionOrValue [] name -> 56 | let 57 | needle : String 58 | needle = 59 | name ++ " =" 60 | in 61 | source 62 | |> String.split "\n" 63 | |> List.Extra.findIndex 64 | (String.startsWith needle) 65 | |> Maybe.map 66 | (\index -> 67 | Node 68 | { start = { row = index + 1, column = 1 } 69 | , end = { row = index + 1, column = 1 + String.length name } 70 | } 71 | ) 72 | |> Maybe.withDefault fakeNode 73 | 74 | _ -> 75 | fakeNode 76 | 77 | ( result, callTrees, logLines ) = 78 | Eval.Expression.evalExpression 79 | (maybeNode expression) 80 | { trace = cfg.trace } 81 | env 82 | in 83 | ( Result.mapError Types.EvalError result 84 | , callTrees 85 | , logLines 86 | ) 87 | 88 | 89 | buildInitialEnv : File -> Result Error Env 90 | buildInitialEnv file = 91 | let 92 | moduleName : ModuleName 93 | moduleName = 94 | case Node.value file.moduleDefinition of 95 | NormalModule normal -> 96 | Node.value normal.moduleName 97 | 98 | PortModule port_ -> 99 | Node.value port_.moduleName 100 | 101 | EffectModule effect -> 102 | Node.value effect.moduleName 103 | 104 | coreEnv : Env 105 | coreEnv = 106 | { currentModule = moduleName 107 | , callStack = [] 108 | , functions = Core.functions 109 | , values = Dict.empty 110 | } 111 | 112 | addDeclaration : Node Declaration -> Env -> Result Error Env 113 | addDeclaration (Node _ decl) env = 114 | case decl of 115 | FunctionDeclaration function -> 116 | let 117 | (Node _ implementation) = 118 | function.declaration 119 | in 120 | Ok (Environment.addFunction moduleName implementation env) 121 | 122 | PortDeclaration _ -> 123 | Err <| Types.EvalError <| unsupported env "Port declaration" 124 | 125 | InfixDeclaration _ -> 126 | Err <| Types.EvalError <| unsupported env "Infix declaration" 127 | 128 | Destructuring _ _ -> 129 | Err <| Types.EvalError <| unsupported env "Top level destructuring" 130 | 131 | AliasDeclaration _ -> 132 | Ok env 133 | 134 | CustomTypeDeclaration _ -> 135 | Ok env 136 | in 137 | file.declarations 138 | |> Result.MyExtra.combineFoldl 139 | addDeclaration 140 | (Ok coreEnv) 141 | -------------------------------------------------------------------------------- /src/Eval/Types.elm: -------------------------------------------------------------------------------- 1 | module Eval.Types exposing (combineMap, errorToString, evalErrorToString, failPartial, foldl, foldr, recurseMapThen, recurseThen, succeedPartial) 2 | 3 | import Elm.Syntax.Expression exposing (Expression) 4 | import Elm.Syntax.Node exposing (Node) 5 | import EvalResult 6 | import Parser 7 | import Recursion exposing (Rec) 8 | import Recursion.Traverse 9 | import Rope 10 | import Syntax 11 | import Types exposing (Config, Env, Error(..), Eval, EvalErrorData, EvalErrorKind(..), EvalResult, PartialResult) 12 | 13 | 14 | combineMap : (a -> Eval b) -> List a -> Eval (List b) 15 | combineMap f xs cfg env = 16 | List.foldr 17 | (\el acc -> 18 | case EvalResult.toResult acc of 19 | Err _ -> 20 | acc 21 | 22 | Ok _ -> 23 | EvalResult.map2 (::) 24 | (f el cfg env) 25 | acc 26 | ) 27 | (EvalResult.succeed []) 28 | xs 29 | 30 | 31 | foldl : (a -> out -> Eval out) -> out -> List a -> Eval out 32 | foldl f init xs cfg env = 33 | List.foldl 34 | (\el acc -> 35 | case EvalResult.toResult acc of 36 | Err _ -> 37 | acc 38 | 39 | Ok a -> 40 | f el a cfg env 41 | ) 42 | (EvalResult.succeed init) 43 | xs 44 | 45 | 46 | foldr : (a -> out -> Eval out) -> out -> List a -> Eval out 47 | foldr f init xs cfg env = 48 | List.foldr 49 | (\el acc -> 50 | case EvalResult.toResult acc of 51 | Err _ -> 52 | acc 53 | 54 | Ok a -> 55 | f el a cfg env 56 | ) 57 | (EvalResult.succeed init) 58 | xs 59 | 60 | 61 | succeedPartial : v -> PartialResult v 62 | succeedPartial v = 63 | Recursion.base (EvalResult.succeed v) 64 | 65 | 66 | failPartial : EvalErrorData -> PartialResult v 67 | failPartial e = 68 | Recursion.base (EvalResult.fail e) 69 | 70 | 71 | errorToString : Error -> String 72 | errorToString err = 73 | case err of 74 | ParsingError deadEnds -> 75 | "Parsing error: " ++ Parser.deadEndsToString deadEnds 76 | 77 | EvalError evalError -> 78 | evalErrorToString evalError 79 | 80 | 81 | evalErrorToString : EvalErrorData -> String 82 | evalErrorToString { callStack, error } = 83 | let 84 | messageWithType : String 85 | messageWithType = 86 | case error of 87 | TypeError message -> 88 | "Type error: " ++ message 89 | 90 | Unsupported message -> 91 | "Unsupported: " ++ message 92 | 93 | NameError name -> 94 | "Name error: " ++ name ++ " not found" 95 | 96 | Todo message -> 97 | "Todo: " ++ message 98 | in 99 | messageWithType 100 | ++ "\nCall stack:\n - " 101 | ++ String.join "\n - " (List.reverse <| List.map Syntax.qualifiedNameToString callStack) 102 | 103 | 104 | recurseThen : 105 | ( Node Expression, Config, Env ) 106 | -> (out -> PartialResult out) 107 | -> PartialResult out 108 | recurseThen expr f = 109 | Recursion.recurseThen expr 110 | (wrapThen f) 111 | 112 | 113 | wrapThen : 114 | (value 115 | -> Rec r t (EvalResult a) 116 | ) 117 | -> EvalResult value 118 | -> Rec r t (EvalResult a) 119 | wrapThen f ( value, trees, logs ) = 120 | case value of 121 | Err e -> 122 | Recursion.base ( Err e, trees, logs ) 123 | 124 | Ok v -> 125 | f v 126 | |> Recursion.map 127 | (\( result, ftrees, flogs ) -> 128 | ( result 129 | , Rope.appendTo trees ftrees 130 | , Rope.appendTo logs flogs 131 | ) 132 | ) 133 | 134 | 135 | recurseMapThen : 136 | ( List (Node Expression), Config, Env ) 137 | -> (List out -> PartialResult out) 138 | -> PartialResult out 139 | recurseMapThen ( exprs, cfg, env ) f = 140 | Recursion.Traverse.sequenceListThen (List.map (\e -> ( e, cfg, env )) exprs) 141 | (\results -> 142 | let 143 | ( values, trees, logs ) = 144 | EvalResult.combine results 145 | in 146 | case values of 147 | Err e -> 148 | Recursion.base ( Err e, trees, logs ) 149 | 150 | Ok vs -> 151 | f vs 152 | |> Recursion.map 153 | (\( result, ftrees, flogs ) -> 154 | ( result 155 | , Rope.appendTo trees ftrees 156 | , Rope.appendTo logs flogs 157 | ) 158 | ) 159 | ) 160 | -------------------------------------------------------------------------------- /src/EvalResult.elm: -------------------------------------------------------------------------------- 1 | module EvalResult exposing (andThen, combine, fail, fromResult, map, map2, onValue, succeed, toResult) 2 | 3 | import Rope exposing (Rope) 4 | import Types exposing (CallTree, EvalErrorData, EvalResult) 5 | 6 | 7 | succeed : a -> EvalResult a 8 | succeed x = 9 | ( Ok x, Rope.empty, Rope.empty ) 10 | 11 | 12 | fail : EvalErrorData -> EvalResult a 13 | fail e = 14 | ( Err e, Rope.empty, Rope.empty ) 15 | 16 | 17 | fromResult : Result EvalErrorData a -> EvalResult a 18 | fromResult x = 19 | ( x, Rope.empty, Rope.empty ) 20 | 21 | 22 | toResult : EvalResult out -> Result EvalErrorData out 23 | toResult ( res, _, _ ) = 24 | res 25 | 26 | 27 | map : (a -> out) -> EvalResult a -> EvalResult out 28 | map f ( x, callTrees, logs ) = 29 | ( Result.map f x 30 | , callTrees 31 | , logs 32 | ) 33 | 34 | 35 | andThen : (a -> EvalResult b) -> EvalResult a -> EvalResult b 36 | andThen f ( v, callTrees, logs ) = 37 | case v of 38 | Err e -> 39 | ( Err e, callTrees, logs ) 40 | 41 | Ok w -> 42 | let 43 | ( y, fxCallTrees, fxLogs ) = 44 | f w 45 | in 46 | ( y 47 | , Rope.appendTo callTrees fxCallTrees 48 | , Rope.appendTo logs fxLogs 49 | ) 50 | 51 | 52 | map2 : (a -> b -> out) -> EvalResult a -> EvalResult b -> EvalResult out 53 | map2 f ( lv, lc, ll ) ( rv, rc, rl ) = 54 | ( Result.map2 f lv rv 55 | , Rope.appendTo lc rc 56 | , Rope.appendTo ll rl 57 | ) 58 | 59 | 60 | onValue : (a -> Result EvalErrorData out) -> EvalResult a -> EvalResult out 61 | onValue f ( x, callTrees, logs ) = 62 | ( Result.andThen f x 63 | , callTrees 64 | , logs 65 | ) 66 | 67 | 68 | combine : List (EvalResult t) -> EvalResult (List t) 69 | combine ls = 70 | let 71 | go : List (EvalResult t) -> ( List t, Rope CallTree, Rope String ) -> EvalResult (List t) 72 | go queue ( vacc, tacc, lacc ) = 73 | case queue of 74 | [] -> 75 | ( Ok <| List.reverse vacc, tacc, lacc ) 76 | 77 | ( Err e, trees, logs ) :: _ -> 78 | ( Err e, Rope.appendTo tacc trees, Rope.appendTo lacc logs ) 79 | 80 | ( Ok v, trees, logs ) :: tail -> 81 | go tail ( v :: vacc, Rope.appendTo tacc trees, Rope.appendTo lacc logs ) 82 | in 83 | go ls ( [], Rope.empty, Rope.empty ) 84 | -------------------------------------------------------------------------------- /src/Expression/Extra.elm: -------------------------------------------------------------------------------- 1 | module Expression.Extra exposing (toString) 2 | 3 | import Elm.Pretty 4 | import Elm.Syntax.Expression exposing (Expression) 5 | import Elm.Syntax.Node exposing (Node(..)) 6 | import Pretty 7 | 8 | 9 | toString : Node Expression -> String 10 | toString (Node _ expression) = 11 | expression 12 | |> Elm.Pretty.prettyExpression 13 | |> Pretty.pretty 120 14 | -------------------------------------------------------------------------------- /src/Kernel/Debug.elm: -------------------------------------------------------------------------------- 1 | module Kernel.Debug exposing (log, todo) 2 | 3 | import EvalResult 4 | import Rope 5 | import Types exposing (Eval, Value) 6 | import Value 7 | 8 | 9 | log : String -> Value -> Eval Value 10 | log key value _ _ = 11 | let 12 | message : String 13 | message = 14 | key ++ ": " ++ Value.toString value 15 | in 16 | ( Ok value 17 | , Rope.empty 18 | , Rope.singleton message 19 | ) 20 | 21 | 22 | todo : String -> Eval Value 23 | todo msg _ env = 24 | EvalResult.fail <| Value.todo env msg 25 | -------------------------------------------------------------------------------- /src/Kernel/JsArray.elm: -------------------------------------------------------------------------------- 1 | module Kernel.JsArray exposing (appendN, foldl, foldr, indexedMap, initialize, initializeFromList, map, unsafeGet) 2 | 3 | import Array exposing (Array) 4 | import Eval.Types as Types 5 | import EvalResult 6 | import List.Extra 7 | import Types exposing (Eval, Value) 8 | import Value 9 | 10 | 11 | appendN : Int -> Array Value -> Array Value -> Array Value 12 | appendN n dest source = 13 | let 14 | itemsToCopy : Int 15 | itemsToCopy = 16 | n - Array.length dest 17 | in 18 | Array.append 19 | dest 20 | (Array.slice 0 itemsToCopy source) 21 | 22 | 23 | {-| Initialize an array from a list. `initializeFromList n ls` creates an array of, 24 | at most, `n` elements from the list. The return value is a tuple containing the 25 | created array as well as a list without the first `n` elements. 26 | 27 | This function was created specifically for the `Array` module, which never wants 28 | to create `JsArray`s above a certain size. That being said, because every 29 | manipulation of `JsArray` results in a copy, users should always try to keep 30 | these as small as possible. The `n` parameter should always be set to a 31 | reasonably small value. 32 | 33 | -} 34 | initializeFromList : Int -> List Value -> ( Array Value, List Value ) 35 | initializeFromList n values = 36 | let 37 | ( before, after ) = 38 | List.Extra.splitAt n values 39 | in 40 | ( Array.fromList before, after ) 41 | 42 | 43 | {-| Initialize an array. `initalize n offset fn` creates an array of length `n` 44 | with the element at index `i` initialized to the result of `(f (i + offset))`. 45 | 46 | The offset parameter is there so one can avoid creating a closure for this use 47 | case. This is an optimization that has proved useful in the `Array` module. 48 | 49 | initialize 3 5 identity == [ 5, 6, 7 ] 50 | 51 | -} 52 | initialize : Int -> Int -> (Int -> Eval Value) -> Eval (Array Value) 53 | initialize len offset f cfg env = 54 | Types.combineMap f (List.range offset (offset + len - 1)) cfg env 55 | |> EvalResult.map Array.fromList 56 | 57 | 58 | foldr : (Value -> Eval (Value -> Eval Value)) -> Value -> Array Value -> Eval Value 59 | foldr f init arr cfg env = 60 | Array.foldr 61 | (\e acc -> 62 | case EvalResult.toResult acc of 63 | Err _ -> 64 | acc 65 | 66 | Ok _ -> 67 | EvalResult.map2 Tuple.pair (f e cfg env) acc 68 | |> EvalResult.andThen (\( g, y ) -> g y cfg env) 69 | ) 70 | (EvalResult.succeed init) 71 | arr 72 | 73 | 74 | foldl : (Value -> Eval (Value -> Eval Value)) -> Value -> Array Value -> Eval Value 75 | foldl f init arr cfg env = 76 | Array.foldl 77 | (\e acc -> 78 | case EvalResult.toResult acc of 79 | Err _ -> 80 | acc 81 | 82 | Ok _ -> 83 | EvalResult.map2 Tuple.pair (f e cfg env) acc 84 | |> EvalResult.andThen (\( g, y ) -> g y cfg env) 85 | ) 86 | (EvalResult.succeed init) 87 | arr 88 | 89 | 90 | map : (Value -> Eval Value) -> Array Value -> Eval (Array Value) 91 | map f array cfg env = 92 | Types.combineMap f (Array.toList array) cfg env 93 | |> EvalResult.map Array.fromList 94 | 95 | 96 | indexedMap : (Int -> Eval (Value -> Eval Value)) -> Array Value -> Eval (Array Value) 97 | indexedMap f array cfg env = 98 | Types.combineMap f (List.range 0 (Array.length array - 1)) cfg env 99 | |> EvalResult.andThen 100 | (\fs -> 101 | Types.combineMap 102 | (\( ef, ex ) -> ef ex) 103 | (List.map2 Tuple.pair fs (Array.toList array)) 104 | cfg 105 | env 106 | ) 107 | |> EvalResult.map Array.fromList 108 | 109 | 110 | unsafeGet : Int -> Array Value -> Eval Value 111 | unsafeGet index array _ env = 112 | case Array.get index array of 113 | Just v -> 114 | EvalResult.succeed v 115 | 116 | Nothing -> 117 | EvalResult.fail <| Value.typeError env "Out of bounds access" 118 | -------------------------------------------------------------------------------- /src/Kernel/String.elm: -------------------------------------------------------------------------------- 1 | module Kernel.String exposing (filter, foldl, foldr, fromNumber) 2 | 3 | import Eval.Types as Types 4 | import EvalResult 5 | import Types exposing (Eval, Value(..)) 6 | import Value exposing (typeError) 7 | 8 | 9 | fromNumber : Value -> Eval String 10 | fromNumber s _ env = 11 | case s of 12 | Int i -> 13 | EvalResult.succeed <| String.fromInt i 14 | 15 | Float f -> 16 | EvalResult.succeed <| String.fromFloat f 17 | 18 | _ -> 19 | EvalResult.fail <| typeError env <| "Cannot convert " ++ Value.toString s ++ " to a string" 20 | 21 | 22 | foldr : (Char -> Eval (Value -> Eval Value)) -> Value -> String -> Eval Value 23 | foldr f i xs = 24 | Types.foldr 25 | (\el acc c e -> 26 | EvalResult.andThen (\fe -> fe acc c e) (f el c e) 27 | ) 28 | i 29 | (String.toList xs) 30 | 31 | 32 | foldl : (Char -> Eval (Value -> Eval Value)) -> Value -> String -> Eval Value 33 | foldl f i xs = 34 | Types.foldl 35 | (\el acc c e -> 36 | EvalResult.andThen (\fe -> fe acc c e) (f el c e) 37 | ) 38 | i 39 | (String.toList xs) 40 | 41 | 42 | filter : (Char -> Eval Bool) -> String -> Eval String 43 | filter f s cfg env = 44 | Types.foldr 45 | (\char acc c e -> 46 | EvalResult.map 47 | (\fc -> 48 | if fc then 49 | char :: acc 50 | 51 | else 52 | acc 53 | ) 54 | (f char c e) 55 | ) 56 | [] 57 | (String.toList s) 58 | cfg 59 | env 60 | |> EvalResult.map String.fromList 61 | -------------------------------------------------------------------------------- /src/Kernel/Utils.elm: -------------------------------------------------------------------------------- 1 | module Kernel.Utils exposing (append, compare, comparison) 2 | 3 | import Array 4 | import Elm.Syntax.ModuleName exposing (ModuleName) 5 | import EvalResult 6 | import FastDict as Dict exposing (Dict) 7 | import Types exposing (Env, Eval, EvalErrorData, Value(..)) 8 | import Value exposing (typeError) 9 | 10 | 11 | append : Value -> Value -> Eval Value 12 | append l r _ env = 13 | case ( l, r ) of 14 | ( String ls, String rs ) -> 15 | EvalResult.succeed <| String (ls ++ rs) 16 | 17 | ( List ll, List rl ) -> 18 | EvalResult.succeed <| List (ll ++ rl) 19 | 20 | _ -> 21 | EvalResult.fail <| typeError env <| "Cannot append " ++ Value.toString l ++ " and " ++ Value.toString r 22 | 23 | 24 | compare : Value -> Value -> Eval Order 25 | compare l r _ env = 26 | EvalResult.fromResult (innerCompare l r env) 27 | 28 | 29 | innerCompare : Value -> Value -> Env -> Result EvalErrorData Order 30 | innerCompare l r env = 31 | let 32 | inner : comparable -> comparable -> Result EvalErrorData Order 33 | inner lv rv = 34 | Ok <| Basics.compare lv rv 35 | 36 | uncomparable : () -> Result EvalErrorData value 37 | uncomparable () = 38 | Err <| 39 | typeError env 40 | ("Cannot compare " 41 | ++ Value.toString l 42 | ++ " and " 43 | ++ Value.toString r 44 | ++ " because they have different types" 45 | ) 46 | in 47 | case ( l, r ) of 48 | ( Int lv, Int rv ) -> 49 | inner lv rv 50 | 51 | ( Int lv, Float rv ) -> 52 | inner (toFloat lv) rv 53 | 54 | ( Int _, _ ) -> 55 | uncomparable () 56 | 57 | ( Float lv, Float rv ) -> 58 | inner lv rv 59 | 60 | ( Float lv, Int rv ) -> 61 | inner lv (toFloat rv) 62 | 63 | ( Float _, _ ) -> 64 | uncomparable () 65 | 66 | ( String lv, String rv ) -> 67 | inner lv rv 68 | 69 | ( String _, _ ) -> 70 | uncomparable () 71 | 72 | ( Char lv, Char rv ) -> 73 | inner lv rv 74 | 75 | ( Char _, _ ) -> 76 | uncomparable () 77 | 78 | ( Tuple la lb, Tuple ra rb ) -> 79 | innerCompare la ra env 80 | |> Result.andThen 81 | (\a -> 82 | if a /= EQ then 83 | Ok a 84 | 85 | else 86 | innerCompare lb rb env 87 | ) 88 | 89 | ( Tuple _ _, _ ) -> 90 | uncomparable () 91 | 92 | ( Triple la lb lc, Triple ra rb rc ) -> 93 | innerCompare la ra env 94 | |> Result.andThen 95 | (\a -> 96 | if a /= EQ then 97 | Ok a 98 | 99 | else 100 | innerCompare lb rb env 101 | |> Result.andThen 102 | (\b -> 103 | if b /= EQ then 104 | Ok b 105 | 106 | else 107 | innerCompare lc rc env 108 | ) 109 | ) 110 | 111 | ( Triple _ _ _, _ ) -> 112 | uncomparable () 113 | 114 | ( List [], List (_ :: _) ) -> 115 | Ok LT 116 | 117 | ( List (_ :: _), List [] ) -> 118 | Ok GT 119 | 120 | ( List [], List [] ) -> 121 | Ok EQ 122 | 123 | ( List (lh :: lt), List (rh :: rt) ) -> 124 | innerCompare lh rh env 125 | |> Result.andThen 126 | (\h -> 127 | if h /= EQ then 128 | Ok h 129 | 130 | else 131 | innerCompare (List lt) (List rt) env 132 | ) 133 | 134 | ( List _, _ ) -> 135 | uncomparable () 136 | 137 | ( Custom lname lvalues, Custom rname rvalues ) -> 138 | if lname.moduleName /= rname.moduleName then 139 | inner lname.moduleName rname.moduleName 140 | 141 | else if lname.name /= rname.name then 142 | inner lname.name rname.name 143 | 144 | else 145 | case ( Value.toArray l, Value.toArray r ) of 146 | ( Just la, Just ra ) -> 147 | innerCompare (List la) (List ra) env 148 | 149 | _ -> 150 | innerCompare (List lvalues) (List rvalues) env 151 | 152 | ( Custom _ _, _ ) -> 153 | uncomparable () 154 | 155 | ( Record ldict, Record rdict ) -> 156 | let 157 | toValue : Dict String Value -> Value 158 | toValue dict = 159 | dict 160 | |> Dict.toList 161 | |> List.map (\( k, v ) -> Tuple (String k) v) 162 | |> List 163 | in 164 | innerCompare (toValue ldict) (toValue rdict) env 165 | 166 | ( Record _, _ ) -> 167 | uncomparable () 168 | 169 | ( JsArray larr, JsArray rarr ) -> 170 | innerCompare (List <| Array.toList larr) (List <| Array.toList rarr) env 171 | 172 | ( JsArray _, _ ) -> 173 | uncomparable () 174 | 175 | ( Bool lb, Bool rb ) -> 176 | if lb == rb then 177 | Ok EQ 178 | 179 | else if lb then 180 | Ok LT 181 | 182 | else 183 | Ok GT 184 | 185 | ( Bool _, _ ) -> 186 | uncomparable () 187 | 188 | ( Unit, Unit ) -> 189 | Ok EQ 190 | 191 | ( Unit, _ ) -> 192 | uncomparable () 193 | 194 | ( PartiallyApplied _ _ _ _ _, PartiallyApplied _ _ _ _ _ ) -> 195 | Err <| typeError env "Cannot compare functions" 196 | 197 | ( PartiallyApplied _ _ _ _ _, _ ) -> 198 | uncomparable () 199 | 200 | 201 | comparison : List Order -> ModuleName -> ( Int, List Value -> Eval Value ) 202 | comparison orders _ = 203 | ( 2 204 | , \args cfg env -> 205 | case args of 206 | [ l, r ] -> 207 | compare l r cfg env 208 | |> EvalResult.map 209 | (\result -> 210 | Bool (List.member result orders) 211 | ) 212 | 213 | _ -> 214 | EvalResult.fail <| typeError env "Comparison needs exactly two arguments" 215 | ) 216 | -------------------------------------------------------------------------------- /src/List/MyExtra.elm: -------------------------------------------------------------------------------- 1 | module List.MyExtra exposing (groupBy) 2 | 3 | import List.Extra 4 | 5 | 6 | groupBy : (a -> b) -> List a -> List ( b, List a ) 7 | groupBy f list = 8 | list 9 | |> List.Extra.groupWhile (\l r -> f l == f r) 10 | |> List.map (\( head, tail ) -> ( f head, head :: tail )) 11 | -------------------------------------------------------------------------------- /src/Result/MyExtra.elm: -------------------------------------------------------------------------------- 1 | module Result.MyExtra exposing (combineFoldl) 2 | 3 | 4 | combineFoldl : (a -> b -> Result error b) -> Result error b -> List a -> Result error b 5 | combineFoldl f init list = 6 | case init of 7 | Err e -> 8 | Err e 9 | 10 | Ok i -> 11 | let 12 | combineFoldlHelper : b -> List a -> Result error b 13 | combineFoldlHelper acc tail = 14 | case tail of 15 | [] -> 16 | Ok acc 17 | 18 | x :: xs -> 19 | case f x acc of 20 | Err e -> 21 | Err e 22 | 23 | Ok y -> 24 | combineFoldlHelper y xs 25 | in 26 | combineFoldlHelper i list 27 | -------------------------------------------------------------------------------- /src/Syntax.elm: -------------------------------------------------------------------------------- 1 | module Syntax exposing (fakeNode, qualifiedNameToString) 2 | 3 | import Elm.Syntax.Node exposing (Node(..)) 4 | import Elm.Syntax.Pattern exposing (QualifiedNameRef) 5 | import Elm.Syntax.Range exposing (Location, Range) 6 | 7 | 8 | fakeNode : a -> Node a 9 | fakeNode value = 10 | Node fakeRange value 11 | 12 | 13 | fakeRange : Range 14 | fakeRange = 15 | { start = fakeLocation, end = fakeLocation } 16 | 17 | 18 | fakeLocation : Location 19 | fakeLocation = 20 | { row = -1 21 | , column = -1 22 | } 23 | 24 | 25 | qualifiedNameToString : QualifiedNameRef -> String 26 | qualifiedNameToString { moduleName, name } = 27 | (moduleName ++ [ name ]) 28 | |> String.join "." 29 | -------------------------------------------------------------------------------- /src/TopologicalSort.elm: -------------------------------------------------------------------------------- 1 | module TopologicalSort exposing (SortError(..), sort) 2 | 3 | {-| Topological sort of a directed graph. 4 | 5 | Special version for sorting let declarations in Elm: 6 | 7 | - every declaration defines one or more variables 8 | - every declaration references zero or more free variables 9 | - cycles are allowed if they consist only of functions 10 | 11 | -} 12 | 13 | import FastDict as Dict exposing (Dict) 14 | import Set exposing (Set) 15 | 16 | 17 | type SortError 18 | = IllegalCycle 19 | | InternalError 20 | 21 | 22 | type alias State a c = 23 | { sorted : List a 24 | , temporary : Set c 25 | , permanent : Set c 26 | , path : List c 27 | , error : Maybe SortError 28 | } 29 | 30 | 31 | sort : 32 | { id : a -> comparable1 33 | , defVars : a -> Set comparable2 34 | , refVars : a -> Set comparable2 35 | , cycleAllowed : a -> Bool 36 | } 37 | -> (List a -> Result SortError (List a)) 38 | sort config items = 39 | let 40 | graph : 41 | { goalIds : List comparable1 42 | , cycleIds : Set comparable1 43 | , id2item : Dict comparable1 a 44 | , id2refs : Dict comparable1 (Set comparable1) 45 | } 46 | graph = 47 | items 48 | |> List.foldl 49 | (\item acc -> 50 | let 51 | id : comparable1 52 | id = 53 | config.id item 54 | 55 | defVars : Set comparable2 56 | defVars = 57 | config.defVars item 58 | 59 | refVars : Set comparable2 60 | refVars = 61 | config.refVars item 62 | in 63 | { var2id = 64 | Set.foldl 65 | (\defVar acc2 -> 66 | Dict.insert defVar id acc2 67 | ) 68 | acc.var2id 69 | defVars 70 | 71 | -- 72 | , goalIds = id :: acc.goalIds 73 | 74 | -- 75 | , cycleIds = 76 | if config.cycleAllowed item then 77 | Set.insert id acc.cycleIds 78 | 79 | else 80 | acc.cycleIds 81 | 82 | -- 83 | , id2item = 84 | Dict.insert id item acc.id2item 85 | 86 | -- 87 | , id2refs = 88 | case Dict.get id acc.id2refs of 89 | Nothing -> 90 | Dict.insert id refVars acc.id2refs 91 | 92 | Just refs -> 93 | Dict.insert id (Set.union refs refVars) acc.id2refs 94 | } 95 | ) 96 | { var2id = Dict.empty 97 | , goalIds = [] 98 | , cycleIds = Set.empty 99 | , id2item = Dict.empty 100 | , id2refs = Dict.empty 101 | } 102 | |> (\{ var2id, goalIds, cycleIds, id2item, id2refs } -> 103 | { goalIds = goalIds 104 | , cycleIds = cycleIds 105 | , id2item = id2item 106 | , id2refs = 107 | Dict.map 108 | (\_ -> 109 | Set.foldl 110 | (\ref acc -> 111 | case Dict.get ref var2id of 112 | Nothing -> 113 | acc 114 | 115 | Just id -> 116 | Set.insert id acc 117 | ) 118 | Set.empty 119 | ) 120 | id2refs 121 | } 122 | ) 123 | 124 | checkCycle : comparable1 -> List comparable1 -> Maybe SortError 125 | checkCycle start path = 126 | case path of 127 | h :: t -> 128 | if Set.member h graph.cycleIds then 129 | if h == start then 130 | Nothing 131 | 132 | else 133 | checkCycle start t 134 | 135 | else 136 | Just IllegalCycle 137 | 138 | [] -> 139 | Just InternalError 140 | 141 | visit : comparable1 -> State a comparable1 -> State a comparable1 142 | visit node state = 143 | case state.error of 144 | Just _ -> 145 | state 146 | 147 | Nothing -> 148 | if Set.member node state.permanent then 149 | state 150 | 151 | else if Set.member node state.temporary then 152 | { state | error = checkCycle node state.path } 153 | 154 | else 155 | let 156 | newState : State a comparable1 157 | newState = 158 | Set.foldl visit 159 | { state 160 | | temporary = Set.insert node state.temporary 161 | , path = node :: state.path 162 | } 163 | (Dict.get node graph.id2refs |> Maybe.withDefault Set.empty) 164 | in 165 | { state 166 | | sorted = 167 | case Dict.get node graph.id2item of 168 | Nothing -> 169 | newState.sorted 170 | 171 | Just item -> 172 | item :: newState.sorted 173 | , permanent = Set.insert node newState.permanent 174 | , error = newState.error 175 | } 176 | 177 | result : State a comparable1 178 | result = 179 | List.foldl visit 180 | { sorted = [] 181 | , temporary = Set.empty 182 | , permanent = Set.empty 183 | , path = [] 184 | , error = Nothing 185 | } 186 | graph.goalIds 187 | in 188 | case result.error of 189 | Just err -> 190 | Err err 191 | 192 | Nothing -> 193 | Ok result.sorted 194 | -------------------------------------------------------------------------------- /src/Types.elm: -------------------------------------------------------------------------------- 1 | module Types exposing (CallTree(..), Config, Env, EnvValues, Error(..), Eval, EvalErrorData, EvalErrorKind(..), EvalResult, PartialEval, PartialResult, Value(..)) 2 | 3 | import Array exposing (Array) 4 | import Elm.Syntax.Expression exposing (Expression, FunctionImplementation) 5 | import Elm.Syntax.ModuleName exposing (ModuleName) 6 | import Elm.Syntax.Node exposing (Node) 7 | import Elm.Syntax.Pattern exposing (Pattern, QualifiedNameRef) 8 | import FastDict exposing (Dict) 9 | import Parser exposing (DeadEnd) 10 | import Recursion exposing (Rec) 11 | import Rope exposing (Rope) 12 | 13 | 14 | type alias PartialEval out = 15 | Config -> Env -> PartialResult out 16 | 17 | 18 | type alias PartialResult out = 19 | Rec 20 | ( Node Expression, Config, Env ) 21 | (EvalResult out) 22 | (EvalResult out) 23 | 24 | 25 | type alias Eval out = 26 | Config -> Env -> EvalResult out 27 | 28 | 29 | type alias EvalResult out = 30 | ( Result EvalErrorData out 31 | , Rope CallTree 32 | , Rope String 33 | ) 34 | 35 | 36 | type alias Config = 37 | { trace : Bool 38 | } 39 | 40 | 41 | type CallTree 42 | = CallNode 43 | { expression : Node Expression 44 | , result : Result EvalErrorData Value 45 | , children : Rope CallTree 46 | , env : Env 47 | } 48 | 49 | 50 | type Error 51 | = ParsingError (List DeadEnd) 52 | | EvalError EvalErrorData 53 | 54 | 55 | type Value 56 | = String String 57 | | Int Int 58 | | Float Float 59 | | Char Char 60 | | Bool Bool 61 | | Unit 62 | | Tuple Value Value 63 | | Triple Value Value Value 64 | | Record (Dict String Value) 65 | | Custom QualifiedNameRef (List Value) 66 | | PartiallyApplied Env (List Value) (List (Node Pattern)) (Maybe QualifiedNameRef) (Node Expression) 67 | | JsArray (Array Value) 68 | | List (List Value) 69 | 70 | 71 | type alias Env = 72 | { currentModule : ModuleName 73 | , functions : Dict ModuleName (Dict String FunctionImplementation) 74 | , values : EnvValues 75 | , callStack : List QualifiedNameRef 76 | } 77 | 78 | 79 | type alias EnvValues = 80 | Dict String Value 81 | 82 | 83 | type alias EvalErrorData = 84 | { currentModule : ModuleName 85 | , callStack : List QualifiedNameRef 86 | , error : EvalErrorKind 87 | } 88 | 89 | 90 | type EvalErrorKind 91 | = TypeError String 92 | | Unsupported String 93 | | NameError String 94 | | Todo String 95 | -------------------------------------------------------------------------------- /src/UI/Source.elm: -------------------------------------------------------------------------------- 1 | module UI.Source exposing (Button, Config, view, viewExpression) 2 | 3 | import Core 4 | import Element exposing (Attribute, Element) 5 | import Element.Background as Background 6 | import Element.Border as Border 7 | import Element.Font as Font 8 | import Elm.Syntax.Range exposing (Location, Range) 9 | import FastDict 10 | import Html exposing (Html, pre, span, text) 11 | import Html.Attributes exposing (style, title) 12 | import Html.Events 13 | import Json.Decode 14 | import List.Extra 15 | import List.MyExtra 16 | import Maybe.Extra 17 | import Parser 18 | import UI.Theme as Theme 19 | import Unicode 20 | 21 | 22 | type alias Button msg = 23 | { onPress : Maybe msg 24 | , range : Range 25 | , tooltip : Maybe String 26 | } 27 | 28 | 29 | type alias Config msg = 30 | { highlight : Maybe Range 31 | , source : String 32 | , buttons : List (Button msg) 33 | } 34 | 35 | 36 | type alias InnerConfig msg = 37 | { highlight : Maybe Range 38 | , source : String 39 | , buttons : List (Button msg) 40 | , forExpression : Bool 41 | } 42 | 43 | 44 | viewExpression : List (Attribute msg) -> Config msg -> Element msg 45 | viewExpression attrs config = 46 | innerView attrs 47 | { source = config.source 48 | , highlight = config.highlight 49 | , buttons = config.buttons 50 | , forExpression = True 51 | } 52 | 53 | 54 | view : 55 | List (Attribute msg) 56 | -> Config msg 57 | -> Element msg 58 | view attrs config = 59 | innerView attrs 60 | { source = config.source 61 | , highlight = config.highlight 62 | , buttons = config.buttons 63 | , forExpression = False 64 | } 65 | 66 | 67 | innerView : List (Attribute msg) -> InnerConfig msg -> Element msg 68 | innerView attrs config = 69 | config.source 70 | |> String.split "\n" 71 | |> List.indexedMap 72 | (\rowIndex row -> 73 | (String.toList row 74 | |> List.indexedMap 75 | (\colIndex char -> 76 | ( char 77 | , { row = rowIndex + 1 78 | , column = colIndex + 1 79 | } 80 | ) 81 | ) 82 | ) 83 | ++ [ ( '\n' 84 | , { row = rowIndex + 1 85 | , column = String.length row + 1 86 | } 87 | ) 88 | ] 89 | ) 90 | |> List.concat 91 | |> parse config 92 | |> pre 93 | [ style "line-height" "125%" 94 | , style "margin" "0" 95 | , style "padding" "0" 96 | ] 97 | |> Element.html 98 | |> Element.el 99 | (Element.width Element.fill 100 | :: Element.alignTop 101 | :: Theme.padding 102 | :: Border.width 1 103 | :: (Background.color <| Element.rgb 0.2 0.2 0.2) 104 | :: (Font.color <| Element.rgb 1 1 1) 105 | :: attrs 106 | ) 107 | 108 | 109 | type State 110 | = Initial 111 | | GettingModuleName 112 | | WaitingModuleExposing 113 | | WaitingExposeList 114 | | ReadingExposeList 115 | | WaitingDeclaration 116 | | ReadingDeclaration 117 | | ReadingExpression 118 | | ReadingVariable 119 | | ReadingNumber 120 | | ReadingString State 121 | | ReadingStringEscape State 122 | | Comment State 123 | | Error 124 | 125 | 126 | type alias Parsed msg = 127 | { color : Maybe String 128 | , background : Maybe String 129 | , button : Maybe (Button msg) 130 | , token : String 131 | , highlight : Bool 132 | } 133 | 134 | 135 | type alias Step msg = 136 | Parser.Step 137 | ( State, Parsed msg, Queue ) 138 | (List (Html msg)) 139 | 140 | 141 | type alias Queue = 142 | List ( Char, Location ) 143 | 144 | 145 | parse : InnerConfig msg -> Queue -> List (Html msg) 146 | parse config chars = 147 | parseHelp config 148 | (if config.forExpression then 149 | ReadingExpression 150 | 151 | else 152 | Initial 153 | ) 154 | [] 155 | (List.sortBy 156 | (\{ range } -> ( range.start.row, range.start.column )) 157 | config.buttons 158 | ) 159 | chars 160 | 161 | 162 | parseHelp : InnerConfig msg -> State -> List (Parsed msg) -> List (Button msg) -> Queue -> List (Html msg) 163 | parseHelp config state acc buttons queue = 164 | case queue of 165 | [] -> 166 | List.reverse acc |> aggregate 167 | 168 | ( head, location ) :: tail -> 169 | let 170 | ( button, newButtons ) = 171 | findButton buttons 172 | 173 | findButton : List (Button msg) -> ( Maybe (Button msg), List (Button msg) ) 174 | findButton bqueue = 175 | case bqueue of 176 | [] -> 177 | ( Nothing, bqueue ) 178 | 179 | bhead :: btail -> 180 | case 181 | compareLocationRange 182 | location 183 | bhead.range 184 | of 185 | LT -> 186 | ( Nothing, bqueue ) 187 | 188 | EQ -> 189 | ( Just bhead, buttons ) 190 | 191 | GT -> 192 | findButton btail 193 | 194 | default : Parsed msg 195 | default = 196 | { background = Nothing 197 | , button = button 198 | , color = Nothing 199 | , token = String.fromChar head 200 | , highlight = 201 | Maybe.map (compareLocationRange location) config.highlight == Just EQ 202 | } 203 | 204 | normal : State -> Step msg 205 | normal newState = 206 | ( newState 207 | , default 208 | , tail 209 | ) 210 | |> Parser.Loop 211 | 212 | operator : State -> Step msg 213 | operator newState = 214 | colored colors.operator newState 215 | 216 | colored : String -> State -> Step msg 217 | colored color newState = 218 | ( newState 219 | , { default | color = Just color } 220 | , tail 221 | ) 222 | |> Parser.Loop 223 | 224 | error : () -> Step msg 225 | error () = 226 | colored "red" Error 227 | 228 | seek : String -> State -> String -> Maybe (Step msg) 229 | seek color newState keyword = 230 | let 231 | len : Int 232 | len = 233 | String.length keyword 234 | in 235 | if 236 | (queue 237 | |> List.take len 238 | |> List.map Tuple.first 239 | ) 240 | == String.toList keyword 241 | then 242 | ( newState 243 | , { default 244 | | color = Just color 245 | , token = keyword 246 | } 247 | , List.drop len queue 248 | ) 249 | |> Parser.Loop 250 | |> Just 251 | 252 | else 253 | Nothing 254 | 255 | seekOrError : String -> State -> String -> Step msg 256 | seekOrError color newState keyword = 257 | case seek color newState keyword of 258 | Just r -> 259 | r 260 | 261 | Nothing -> 262 | error () 263 | 264 | step : 265 | Parser.Step 266 | ( State, Parsed msg, Queue ) 267 | (List (Html msg)) 268 | step = 269 | case ( state, queue ) of 270 | ( _, [] ) -> 271 | List.reverse acc 272 | |> aggregate 273 | |> Parser.Done 274 | 275 | ( Error, _ ) -> 276 | error () 277 | 278 | ( ReadingString previous, ( '\\', _ ) :: _ ) -> 279 | colored colors.string (ReadingStringEscape previous) 280 | 281 | ( ReadingStringEscape previous, _ ) -> 282 | colored colors.string (ReadingString previous) 283 | 284 | ( ReadingString previous, ( '"', _ ) :: _ ) -> 285 | colored colors.string previous 286 | 287 | ( ReadingString _, _ ) -> 288 | colored colors.string state 289 | 290 | ( _, ( '-', _ ) :: ( '-', _ ) :: commentTail ) -> 291 | ( Comment state 292 | , { default 293 | | color = Just colors.comment 294 | , token = "--" 295 | } 296 | , commentTail 297 | ) 298 | |> Parser.Loop 299 | 300 | ( Comment previous, ( '\n', _ ) :: _ ) -> 301 | colored colors.comment previous 302 | 303 | ( Comment _, _ ) -> 304 | colored colors.comment state 305 | 306 | ( Initial, ( '\n', _ ) :: _ ) -> 307 | normal Initial 308 | 309 | ( Initial, ( ' ', _ ) :: _ ) -> 310 | normal Initial 311 | 312 | ( Initial, _ ) -> 313 | seekOrError colors.keyword GettingModuleName "module " 314 | 315 | ( GettingModuleName, ( ' ', _ ) :: _ ) -> 316 | normal WaitingModuleExposing 317 | 318 | ( GettingModuleName, _ ) -> 319 | normal GettingModuleName 320 | 321 | ( WaitingModuleExposing, _ ) -> 322 | seekOrError colors.keyword WaitingExposeList "exposing" 323 | 324 | ( WaitingExposeList, ( ' ', _ ) :: _ ) -> 325 | normal WaitingExposeList 326 | 327 | ( WaitingExposeList, ( '(', _ ) :: _ ) -> 328 | operator ReadingExposeList 329 | 330 | ( ReadingExposeList, ( ')', _ ) :: _ ) -> 331 | operator WaitingDeclaration 332 | 333 | ( ReadingExposeList, _ ) -> 334 | normal ReadingExposeList 335 | 336 | ( _, ( '\n', _ ) :: _ ) -> 337 | normal 338 | (if config.forExpression then 339 | ReadingExpression 340 | 341 | else 342 | WaitingDeclaration 343 | ) 344 | 345 | ( WaitingDeclaration, ( ' ', _ ) :: _ ) -> 346 | normal ReadingExpression 347 | 348 | ( WaitingDeclaration, _ ) -> 349 | colored colors.declaration ReadingDeclaration 350 | 351 | ( ReadingDeclaration, ( ' ', _ ) :: _ ) -> 352 | normal ReadingExpression 353 | 354 | ( ReadingDeclaration, _ ) -> 355 | colored colors.declaration ReadingDeclaration 356 | 357 | ( ReadingExpression, _ ) -> 358 | keywords 359 | |> List.Extra.findMap 360 | (seek colors.keyword ReadingExpression) 361 | |> Maybe.Extra.withDefaultLazy 362 | (\_ -> 363 | if Unicode.isAlpha head then 364 | normal ReadingVariable 365 | 366 | else if Unicode.isDigit head then 367 | colored colors.number ReadingNumber 368 | 369 | else 370 | normal ReadingExpression 371 | ) 372 | 373 | ( ReadingVariable, ( ' ', _ ) :: _ ) -> 374 | normal ReadingExpression 375 | 376 | ( ReadingVariable, _ ) -> 377 | normal ReadingVariable 378 | 379 | ( ReadingNumber, ( ' ', _ ) :: _ ) -> 380 | colored colors.number ReadingExpression 381 | 382 | ( ReadingNumber, _ ) -> 383 | colored colors.number ReadingNumber 384 | 385 | _ -> 386 | error () 387 | in 388 | case step of 389 | Parser.Done r -> 390 | r 391 | 392 | Parser.Loop ( newState, enqueue, effectiveTail ) -> 393 | parseHelp config 394 | newState 395 | (enqueue :: acc) 396 | newButtons 397 | effectiveTail 398 | 399 | 400 | {-| Returns `LT` if the location is before the range, `EQ` if it's inside the range, `GT` if it's after the range. 401 | -} 402 | compareLocationRange : Location -> Range -> Order 403 | compareLocationRange { row, column } { start, end } = 404 | if row < start.row || (row == start.row && column < start.column) then 405 | LT 406 | 407 | else if row > end.row || (row == end.row && column >= end.column) then 408 | GT 409 | 410 | else 411 | EQ 412 | 413 | 414 | aggregate : List (Parsed msg) -> List (Html msg) 415 | aggregate queue = 416 | queue 417 | |> List.MyExtra.groupBy .highlight 418 | |> List.concatMap 419 | (\( highlight, highlightGroup ) -> 420 | let 421 | highlightContent : List (Html msg) 422 | highlightContent = 423 | highlightGroup 424 | |> List.MyExtra.groupBy .button 425 | |> List.concatMap 426 | (\( button, group ) -> 427 | let 428 | content : List (Html msg) 429 | content = 430 | group 431 | |> List.MyExtra.groupBy 432 | (\{ color, background } -> ( color, background )) 433 | |> List.map 434 | (\( ( color, background ), subgroup ) -> 435 | let 436 | subcontent : Html msg 437 | subcontent = 438 | text <| String.concat <| List.map .token subgroup 439 | in 440 | if color == Nothing && background == Nothing then 441 | subcontent 442 | 443 | else 444 | span 445 | (List.filterMap identity 446 | [ Maybe.map (\c -> style "color" c) color 447 | , Maybe.map (\c -> style "background" c) background 448 | , Maybe.map (\c -> style "outline" <| "1px solid " ++ c) background 449 | ] 450 | ) 451 | [ subcontent ] 452 | ) 453 | in 454 | case button of 455 | Nothing -> 456 | content 457 | 458 | Just { onPress, tooltip } -> 459 | [ span 460 | ([ Just <| style "outline" "1px solid #fff" 461 | , Just <| style "background" "rgba(100 0 0 / 0.5)" 462 | , Just <| style "cursor" "pointer" 463 | , Maybe.map 464 | (\msg -> 465 | Html.Events.stopPropagationOn "click" 466 | (Json.Decode.succeed ( msg, True )) 467 | ) 468 | onPress 469 | , Maybe.map title tooltip 470 | ] 471 | |> List.filterMap identity 472 | ) 473 | content 474 | ] 475 | ) 476 | in 477 | if highlight then 478 | [ span 479 | [ style "background" colors.highlightBackground 480 | , style "outline" <| "1px solid " ++ colors.highlightBackground 481 | ] 482 | highlightContent 483 | ] 484 | 485 | else 486 | highlightContent 487 | ) 488 | 489 | 490 | keywords : List String 491 | keywords = 492 | let 493 | language : List String 494 | language = 495 | -- TODO: finish this. 496 | -- Or, even better, actually do syntax highlighting; possibly starting from the AST. 497 | [ "=" 498 | , "as" 499 | , "case" 500 | , "else" 501 | , "exposing" 502 | , "if" 503 | , "of" 504 | , "import" 505 | , "in" 506 | , "let" 507 | , "module" 508 | , "then" 509 | ] 510 | 511 | core : List String 512 | core = 513 | FastDict.keys Core.operators 514 | in 515 | (language ++ core) 516 | |> List.sortBy (\keyword -> -(String.length keyword)) 517 | 518 | 519 | colors : 520 | { comment : String 521 | , highlightBackground : String 522 | , declaration : String 523 | , keyword : String 524 | , number : String 525 | , operator : String 526 | , string : String 527 | } 528 | colors = 529 | { comment = "#ccc" 530 | , highlightBackground = "#660" 531 | , declaration = "#ffc" 532 | , keyword = "#88f" 533 | , number = "#cfc" 534 | , operator = "#cc4" 535 | , string = "#c44" 536 | } 537 | -------------------------------------------------------------------------------- /src/UI/Theme.elm: -------------------------------------------------------------------------------- 1 | module UI.Theme exposing (box, button, column, padding, row, rythm, spacing, style, wrappedRow) 2 | 3 | import Element exposing (Attribute, Element, alignTop, el, text) 4 | import Element.Border as Border 5 | import Element.Font as Font 6 | import Element.Input as Input 7 | import Html.Attributes 8 | 9 | 10 | rythm : number 11 | rythm = 12 | 10 13 | 14 | 15 | padding : Attribute msg 16 | padding = 17 | Element.padding rythm 18 | 19 | 20 | spacing : Attribute msg 21 | spacing = 22 | Element.spacing rythm 23 | 24 | 25 | row : List (Attribute msg) -> List (Element msg) -> Element msg 26 | row attrs children = 27 | Element.row (spacing :: attrs) children 28 | 29 | 30 | column : List (Attribute msg) -> List (Element msg) -> Element msg 31 | column attrs children = 32 | Element.column (spacing :: attrs) children 33 | 34 | 35 | wrappedRow : List (Attribute msg) -> List (Element msg) -> Element msg 36 | wrappedRow attrs children = 37 | Element.wrappedRow (spacing :: attrs) children 38 | 39 | 40 | button : List (Attribute msg) -> { onPress : Maybe msg, label : Element msg } -> Element msg 41 | button attrs config = 42 | Input.button (padding :: Border.width 1 :: attrs) config 43 | 44 | 45 | style : String -> String -> Attribute msg 46 | style key value = 47 | Element.htmlAttribute <| Html.Attributes.style key value 48 | 49 | 50 | box : String -> List (Attribute msg) -> List (Element msg) -> Element msg 51 | box label attrs content = 52 | column 53 | (padding 54 | :: Border.width 1 55 | :: alignTop 56 | :: attrs 57 | ) 58 | ((el [ Font.bold ] <| 59 | text label 60 | ) 61 | :: content 62 | ) 63 | -------------------------------------------------------------------------------- /src/Value.elm: -------------------------------------------------------------------------------- 1 | module Value exposing (fromOrder, nameError, toArray, toExpression, toOrder, toString, todo, typeError, unsupported) 2 | 3 | import Array exposing (Array) 4 | import Elm.Syntax.Expression as Expression exposing (Expression) 5 | import Elm.Syntax.Node exposing (Node) 6 | import Expression.Extra 7 | import FastDict as Dict 8 | import String exposing (String) 9 | import Syntax exposing (fakeNode) 10 | import Types exposing (Env, EvalErrorData, EvalErrorKind(..), Value(..)) 11 | 12 | 13 | typeError : Env -> String -> EvalErrorData 14 | typeError env msg = 15 | error env (TypeError msg) 16 | 17 | 18 | nameError : Env -> String -> EvalErrorData 19 | nameError env msg = 20 | error env (NameError msg) 21 | 22 | 23 | unsupported : Env -> String -> EvalErrorData 24 | unsupported env msg = 25 | error env (Unsupported msg) 26 | 27 | 28 | todo : Env -> String -> EvalErrorData 29 | todo env msg = 30 | error env (Todo msg) 31 | 32 | 33 | error : Env -> EvalErrorKind -> EvalErrorData 34 | error env msg = 35 | { currentModule = env.currentModule 36 | , callStack = env.callStack 37 | , error = msg 38 | } 39 | 40 | 41 | toExpression : Value -> Node Expression 42 | toExpression value = 43 | fakeNode <| 44 | case value of 45 | String s -> 46 | Expression.Literal s 47 | 48 | Int i -> 49 | Expression.Integer i 50 | 51 | Float f -> 52 | Expression.Floatable f 53 | 54 | Char c -> 55 | Expression.CharLiteral c 56 | 57 | Bool b -> 58 | Expression.FunctionOrValue [] (boolToString b) 59 | 60 | Unit -> 61 | Expression.UnitExpr 62 | 63 | Tuple l r -> 64 | Expression.TupledExpression 65 | [ toExpression l 66 | , toExpression r 67 | ] 68 | 69 | Triple l m r -> 70 | Expression.TupledExpression 71 | [ toExpression l 72 | , toExpression m 73 | , toExpression r 74 | ] 75 | 76 | Record fields -> 77 | fields 78 | |> Dict.toList 79 | |> List.map 80 | (\( fieldName, fieldValue ) -> 81 | fakeNode ( fakeNode fieldName, toExpression fieldValue ) 82 | ) 83 | |> Expression.RecordExpr 84 | 85 | List list -> 86 | list 87 | |> List.map toExpression 88 | |> Expression.ListExpr 89 | 90 | Custom name args -> 91 | case toArray value of 92 | Just array -> 93 | arrayToExpression "Array" array 94 | 95 | Nothing -> 96 | (fakeNode (Expression.FunctionOrValue name.moduleName name.name) 97 | :: List.map toExpression args 98 | ) 99 | |> Expression.Application 100 | 101 | JsArray array -> 102 | arrayToExpression "JsArray" (Array.toList array) 103 | 104 | PartiallyApplied _ [] _ (Just qualifiedName) _ -> 105 | Expression.FunctionOrValue qualifiedName.moduleName qualifiedName.name 106 | 107 | PartiallyApplied _ args _ (Just qualifiedName) _ -> 108 | (fakeNode 109 | (Expression.FunctionOrValue 110 | qualifiedName.moduleName 111 | qualifiedName.name 112 | ) 113 | :: List.map toExpression args 114 | ) 115 | |> Expression.Application 116 | 117 | PartiallyApplied _ [] patterns Nothing implementation -> 118 | Expression.LambdaExpression 119 | { args = patterns 120 | , expression = implementation 121 | } 122 | 123 | PartiallyApplied _ args patterns Nothing implementation -> 124 | (fakeNode 125 | (Expression.LambdaExpression 126 | { args = patterns 127 | , expression = implementation 128 | } 129 | ) 130 | :: List.map toExpression args 131 | ) 132 | |> Expression.Application 133 | 134 | 135 | arrayToExpression : String -> List Value -> Expression 136 | arrayToExpression name array = 137 | Expression.Application 138 | [ Expression.FunctionOrValue 139 | [ name ] 140 | "fromList" 141 | |> fakeNode 142 | , array 143 | |> List 144 | |> toExpression 145 | ] 146 | 147 | 148 | toArray : Value -> Maybe (List Value) 149 | toArray value = 150 | case value of 151 | Custom name [ _, _, JsArray tree, JsArray tailArray ] -> 152 | case ( name.moduleName, name.name ) of 153 | ( [ "Array" ], "Array_elm_builtin" ) -> 154 | let 155 | treeToArray : Array Value -> List Value 156 | treeToArray arr = 157 | List.concatMap nodeToList (Array.toList arr) 158 | 159 | nodeToList : Value -> List Value 160 | nodeToList node = 161 | case node of 162 | Custom qualifiedName [ JsArray arr ] -> 163 | case qualifiedName.name of 164 | "SubTree" -> 165 | treeToArray arr 166 | 167 | "Leaf" -> 168 | Array.toList arr 169 | 170 | _ -> 171 | [] 172 | 173 | _ -> 174 | [] 175 | in 176 | Just (treeToArray tree ++ Array.toList tailArray) 177 | 178 | _ -> 179 | Nothing 180 | 181 | _ -> 182 | Nothing 183 | 184 | 185 | boolToString : Bool -> String 186 | boolToString b = 187 | if b then 188 | "True" 189 | 190 | else 191 | "False" 192 | 193 | 194 | toString : Value -> String 195 | toString value = 196 | -- TODO: This is inefficient and subtly different from Debug.toString 197 | toExpression value 198 | |> Expression.Extra.toString 199 | 200 | 201 | fromOrder : Order -> Value 202 | fromOrder order = 203 | case order of 204 | LT -> 205 | Custom { moduleName = [ "Basics" ], name = "LT" } [] 206 | 207 | EQ -> 208 | Custom { moduleName = [ "Basics" ], name = "EQ" } [] 209 | 210 | GT -> 211 | Custom { moduleName = [ "Basics" ], name = "GT" } [] 212 | 213 | 214 | toOrder : Value -> Maybe Order 215 | toOrder value = 216 | case value of 217 | Custom { moduleName, name } [] -> 218 | case ( moduleName, name ) of 219 | ( [ "Basics" ], "LT" ) -> 220 | Just LT 221 | 222 | ( [ "Basics" ], "EQ" ) -> 223 | Just EQ 224 | 225 | ( [ "Basics" ], "GT" ) -> 226 | Just GT 227 | 228 | _ -> 229 | Nothing 230 | 231 | _ -> 232 | Nothing 233 | -------------------------------------------------------------------------------- /tests/CoreTests/Array.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.Array exposing (suite) 2 | 3 | import Array exposing (Array) 4 | import Fuzz exposing (Fuzzer, intRange) 5 | import Test exposing (Test, describe, fuzz) 6 | import TestUtils exposing (evalExpect, evalTest, list, maybe, withInt) 7 | import Types exposing (Value(..)) 8 | 9 | 10 | suite : Test 11 | suite = 12 | describe "Array" 13 | [ initTests 14 | , isEmptyTests 15 | , lengthTests 16 | , getSetTests 17 | , conversionTests 18 | , transformTests 19 | , sliceTests 20 | , runtimeCrashTests 21 | ] 22 | 23 | 24 | {-| 25 | 26 | > 33000 elements requires 3 levels in the tree 27 | 28 | -} 29 | defaultSizeRange : Fuzzer Int 30 | defaultSizeRange = 31 | intRange 1 33000 32 | 33 | 34 | fuzzEvalTest : String -> String -> (a -> Value) -> (Int -> a) -> Test 35 | fuzzEvalTest name source kind value = 36 | Test.skip <| 37 | fuzz defaultSizeRange name <| 38 | \size -> 39 | evalExpect (withInt "size" size source) 40 | kind 41 | (value size) 42 | 43 | 44 | initTests : Test 45 | initTests = 46 | describe "Initialization" 47 | [ fuzzEvalTest "initialize" 48 | "Array.toList <| Array.initialize size identity" 49 | List 50 | (\size -> Array.toList <| Array.initialize size Int) 51 | , fuzzEvalTest "push" 52 | "Array.toList <| List.foldl Array.push Array.empty (List.range 0 (size - 1))" 53 | List 54 | (\size -> Array.toList <| List.foldl Array.push Array.empty (List.map Int <| List.range 0 (size - 1))) 55 | , evalTest "initialize non-identity" 56 | "Array.toList (Array.initialize 4 (\\n -> n * n))" 57 | (list Int) 58 | (Array.toList (Array.initialize 4 (\n -> n * n))) 59 | , evalTest "initialize empty" 60 | "Array.toList (Array.initialize 0 identity)" 61 | (list Int) 62 | (Array.toList (Array.initialize 0 identity)) 63 | , evalTest "initialize negative" 64 | "Array.toList (Array.initialize -2 identity)" 65 | (list Int) 66 | (Array.toList (Array.initialize -2 identity)) 67 | ] 68 | 69 | 70 | isEmptyTests : Test 71 | isEmptyTests = 72 | describe "isEmpty" 73 | [ evalTest "all empty arrays are equal" 74 | "(Array.empty == Array.fromList [])" 75 | Bool 76 | (Array.empty == Array.fromList []) 77 | , evalTest "empty array" 78 | "Array.isEmpty Array.empty" 79 | Bool 80 | (Array.isEmpty Array.empty) 81 | , evalTest "empty converted array" 82 | "Array.isEmpty (Array.fromList [])" 83 | Bool 84 | (Array.isEmpty (Array.fromList [])) 85 | , evalTest "non-empty array" 86 | "Array.isEmpty (Array.fromList [ 1 ])" 87 | Bool 88 | (Array.isEmpty (Array.fromList [ 1 ])) 89 | ] 90 | 91 | 92 | lengthTests : Test 93 | lengthTests = 94 | describe "Length" 95 | [ evalTest "empty array" 96 | "Array.length Array.empty" 97 | Int 98 | (Array.length Array.empty) 99 | , fuzzEvalTest "non-empty array" 100 | "Array.length (Array.initialize size identity)" 101 | Int 102 | (\size -> Array.length (Array.initialize size identity)) 103 | 104 | -- , fuzz defaultSizeRange "push" <| 105 | -- \size -> 106 | -- length (push size (initialize size identity)) 107 | -- |> Expect.equal (size + 1) 108 | -- , fuzz defaultSizeRange "append" <| 109 | -- \size -> 110 | -- length (append (initialize size identity) (initialize (size // 2) identity)) 111 | -- |> Expect.equal (size + (size // 2)) 112 | -- , fuzz defaultSizeRange "set does not increase" <| 113 | -- \size -> 114 | -- length (set (size // 2) 1 (initialize size identity)) 115 | -- |> Expect.equal size 116 | -- , fuzz (intRange 100 10000) "big slice" <| 117 | -- \size -> 118 | -- length (slice 35 -35 (initialize size identity)) 119 | -- |> Expect.equal (size - 70) 120 | -- , fuzz2 (intRange -32 -1) (intRange 100 10000) "small slice end" <| 121 | -- \n size -> 122 | -- length (slice 0 n (initialize size identity)) 123 | -- |> Expect.equal (size + n) 124 | ] 125 | 126 | 127 | getSetTests : Test 128 | getSetTests = 129 | describe "Get and set" 130 | [ -- fuzz2 defaultSizeRange defaultSizeRange "can retrieve element" <| 131 | -- \x y -> 132 | -- let 133 | -- n = 134 | -- min x y 135 | -- size = 136 | -- max x y 137 | -- in 138 | -- get n (initialize (size + 1) identity) 139 | -- |> Expect.equal (Just n) 140 | -- , fuzz2 (intRange 1 50) (intRange 100 33000) "out of bounds retrieval returns nothing" <| 141 | -- \n size -> 142 | -- let 143 | -- arr = 144 | -- initialize size identity 145 | -- in 146 | -- ( get (negate n) arr 147 | -- , get (size + n) arr 148 | -- ) 149 | -- |> Expect.equal ( Nothing, Nothing ) 150 | -- , fuzz2 defaultSizeRange defaultSizeRange "set replaces value" <| 151 | -- \x y -> 152 | -- let 153 | -- n = 154 | -- min x y 155 | -- size = 156 | -- max x y 157 | -- in 158 | -- get n (set n 5 (initialize (size + 1) identity)) 159 | -- |> Expect.equal (Just 5) 160 | -- , fuzz2 (intRange 1 50) defaultSizeRange "set out of bounds returns original array" <| 161 | -- \n size -> 162 | -- let 163 | -- arr = 164 | -- initialize size identity 165 | -- in 166 | -- set (negate n) 5 arr 167 | -- |> set (size + n) 5 168 | -- |> Expect.equal arr, 169 | evalTest "Retrieval works from tail" 170 | "Array.get 1030 (Array.set 1030 5 (Array.initialize 1035 identity))" 171 | (maybe Int) 172 | (Array.get 1030 (Array.set 1030 5 (Array.initialize 1035 identity))) 173 | ] 174 | 175 | 176 | conversionTests : Test 177 | conversionTests = 178 | describe "Conversion" 179 | [ -- fuzz defaultSizeRange "back and forth" <| 180 | -- \size -> 181 | -- let 182 | -- ls = 183 | -- List.range 0 (size - 1) 184 | -- in 185 | -- toList (fromList ls) 186 | -- |> Expect.equal ls, 187 | fuzzEvalTest "indexed" 188 | "Array.toIndexedList (Array.initialize size ((+) 1)) == Array.toList (Array.initialize size (\\idx -> ( idx, idx + 1 )))" 189 | Bool 190 | (\size -> Array.toIndexedList (Array.initialize size ((+) 1)) == Array.toList (Array.initialize size (\idx -> ( idx, idx + 1 )))) 191 | ] 192 | 193 | 194 | transformTests : Test 195 | transformTests = 196 | describe "Transform" 197 | [ -- fuzz defaultSizeRange "foldl" <| 198 | -- \size -> 199 | -- foldl (::) [] (initialize size identity) 200 | -- |> Expect.equal (List.reverse (List.range 0 (size - 1))) 201 | -- , fuzz defaultSizeRange "foldr" <| 202 | -- \size -> 203 | -- foldr (\n acc -> n :: acc) [] (initialize size identity) 204 | -- |> Expect.equal (List.range 0 (size - 1)) 205 | -- , fuzz defaultSizeRange "filter" <| 206 | -- \size -> 207 | -- toList (filter (\a -> modBy 2 a == 0) (initialize size identity)) 208 | -- |> Expect.equal (List.filter (\a -> modBy 2 a == 0) (List.range 0 (size - 1))), 209 | fuzzEvalTest "map" 210 | "Array.map ((+) 1) (Array.initialize size identity) == Array.initialize size ((+) 1)" 211 | Bool 212 | (\size -> Array.map ((+) 1) (Array.initialize size identity) == Array.initialize size ((+) 1)) 213 | 214 | -- , fuzz defaultSizeRange "indexedMap" <| 215 | -- \size -> 216 | -- indexedMap (*) (repeat size 5) 217 | -- |> Expect.equal (initialize size ((*) 5)) 218 | -- , fuzz defaultSizeRange "push appends one element" <| 219 | -- \size -> 220 | -- push size (initialize size identity) 221 | -- |> Expect.equal (initialize (size + 1) identity) 222 | -- , fuzz (intRange 1 1050) "append" <| 223 | -- \size -> 224 | -- append (initialize size identity) (initialize size ((+) size)) 225 | -- |> Expect.equal (initialize (size * 2) identity) 226 | -- , fuzz2 defaultSizeRange (intRange 1 32) "small appends" <| 227 | -- \s1 s2 -> 228 | -- append (initialize s1 identity) (initialize s2 ((+) s1)) 229 | -- |> Expect.equal (initialize (s1 + s2) identity) 230 | ] 231 | 232 | 233 | sliceTests : Test 234 | sliceTests = 235 | let 236 | smallSample : Array Int 237 | smallSample = 238 | Array.fromList (List.range 1 8) 239 | in 240 | describe "Slice" 241 | [ -- fuzz2 (intRange -50 -1) (intRange 100 33000) "both" <| 242 | -- \n size -> 243 | -- slice (abs n) n (initialize size identity) 244 | -- |> Expect.equal (initialize (size + n + n) (\idx -> idx - n)) 245 | -- , fuzz2 (intRange -50 -1) (intRange 100 33000) "left" <| 246 | -- \n size -> 247 | -- let 248 | -- arr = 249 | -- initialize size identity 250 | -- in 251 | -- slice (abs n) (length arr) arr 252 | -- |> Expect.equal (initialize (size + n) (\idx -> idx - n)) 253 | -- , fuzz2 (intRange -50 -1) (intRange 100 33000) "right" <| 254 | -- \n size -> 255 | -- slice 0 n (initialize size identity) 256 | -- |> Expect.equal (initialize (size + n) identity) 257 | -- , fuzz defaultSizeRange "slicing all but the last item" <| 258 | -- \size -> 259 | -- initialize size identity 260 | -- |> slice -1 size 261 | -- |> toList 262 | -- |> Expect.equal [ size - 1 ], 263 | evalTest "both small" 264 | "let smallSample = Array.fromList (List.range 1 8) in Array.toList (Array.slice 2 5 smallSample)" 265 | (list Int) 266 | (Array.toList (Array.slice 2 5 smallSample)) 267 | 268 | -- , test "start small" <| 269 | -- \() -> 270 | -- toList (slice 2 (length smallSample) smallSample) 271 | -- |> Expect.equal (List.range 3 8) 272 | -- , test "negative" <| 273 | -- \() -> 274 | -- toList (slice -5 -2 smallSample) 275 | -- |> Expect.equal (List.range 4 6) 276 | -- , test "impossible" <| 277 | -- \() -> 278 | -- toList (slice -1 -2 smallSample) 279 | -- |> Expect.equal [] 280 | -- , test "crash" <| 281 | -- \() -> 282 | -- Array.repeat (33 * 32) 1 283 | -- |> Array.slice 0 1 284 | -- |> Expect.equal (Array.repeat 1 1) 285 | ] 286 | 287 | 288 | runtimeCrashTests : Test 289 | runtimeCrashTests = 290 | describe "Runtime crashes in core" 291 | [ evalTest "magic slice" 292 | """Array.initialize 40 identity 293 | |> Array.slice 10 40 294 | |> Array.slice 10 30 295 | |> Array.slice 10 20 296 | |> Array.slice 10 10 297 | |> (\\a -> a == a)""" 298 | Bool 299 | (Array.initialize 40 identity 300 | |> Array.slice 10 40 301 | |> Array.slice 10 30 302 | |> Array.slice 10 20 303 | |> Array.slice 10 10 304 | |> (\a -> a == a) 305 | ) 306 | 307 | -- , test "magic slice 2" <| 308 | -- \() -> 309 | -- let 310 | -- ary = 311 | -- fromList <| List.range 0 32 312 | -- res = 313 | -- append (slice 1 32 ary) (slice (32 + 1) -1 ary) 314 | -- in 315 | -- Expect.equal res res 316 | -- , test "magic append" <| 317 | -- \() -> 318 | -- let 319 | -- res = 320 | -- append (initialize 1 (always 1)) 321 | -- (initialize (32 ^ 2 - 1 * 32 + 1) (\i -> i)) 322 | -- in 323 | -- Expect.equal res res 324 | ] 325 | -------------------------------------------------------------------------------- /tests/CoreTests/Basics.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.Basics exposing (suite) 2 | 3 | import Array 4 | import Dict 5 | import Set 6 | import Test exposing (Test, describe) 7 | import TestUtils exposing (evalTest, evalTest_, list) 8 | import Types exposing (Value(..)) 9 | import Value 10 | 11 | 12 | suite : Test 13 | suite = 14 | let 15 | comparison : Test 16 | comparison = 17 | describe "Comparison" 18 | [ evalTest "max" "max 32 42" Int <| max 32 42 19 | , evalTest "min" "min 91 42" Int <| min 91 42 20 | , evalTest "clamp low" "clamp 10 20 5" Int <| clamp 10 20 5 21 | , evalTest "clamp mid" "clamp 10 20 15" Int <| clamp 10 20 15 22 | , evalTest "clamp high" "clamp 10 20 25" Int <| clamp 10 20 25 23 | , evalTest_ "5 < 6" Bool <| 5 < 6 24 | , evalTest_ "6 < 5" Bool <| 6 < 5 25 | , evalTest_ "6 < 6" Bool <| 6 < 6 26 | , evalTest_ "5 > 6" Bool <| 5 > 6 27 | , evalTest_ "6 > 5" Bool <| 6 > 5 28 | , evalTest_ "6 > 6" Bool <| 6 > 6 29 | , evalTest_ "5 <= 6" Bool <| 5 <= 6 30 | , evalTest_ "6 <= 5" Bool <| 6 <= 5 31 | , evalTest_ "6 <= 6" Bool <| 6 <= 6 32 | , evalTest_ "compare \"A\" \"B\"" identity <| Value.fromOrder (compare "A" "B") 33 | , evalTest_ "compare 'f' 'f'" identity <| Value.fromOrder (compare 'f' 'f') 34 | , evalTest_ "compare (1, 2, 3) (0, 1, 2)" identity <| Value.fromOrder (compare ( 1, 2, 3 ) ( 0, 1, 2 )) 35 | , evalTest_ "compare ['a'] ['b']" identity <| Value.fromOrder (compare [ 'a' ] [ 'b' ]) 36 | , evalTest "array equality" "Array.fromList [ 1, 1, 1, 1 ] == Array.repeat 4 1" Bool <| Array.fromList [ 1, 1, 1, 1 ] == Array.repeat 4 1 37 | , evalTest "set equality" "Set.fromList [ 1, 2 ] == Set.fromList [ 2, 1 ]" Bool <| Set.fromList [ 1, 2 ] == Set.fromList [ 2, 1 ] 38 | , evalTest "dict equality" "Dict.fromList [ ( 1, 1 ), ( 2, 2 ) ] == Dict.fromList [ ( 2, 2 ), ( 1, 1 ) ]" Bool <| Dict.fromList [ ( 1, 1 ), ( 2, 2 ) ] == Dict.fromList [ ( 2, 2 ), ( 1, 1 ) ] 39 | , evalTest "char equality" "'0' == '饑'" Bool <| '0' == '饑' 40 | ] 41 | 42 | toStringTests : Test 43 | toStringTests = 44 | describe "Debug.toString Tests" 45 | [ evalTest "toString Int" "Debug.toString 42" String <| Debug.toString 42 46 | , evalTest "toString Float" "Debug.toString 42.52" String <| Debug.toString 42.52 47 | , evalTest "toString Char" "Debug.toString 'c'" String <| Debug.toString 'c' 48 | , evalTest "toString Char single quote" "Debug.toString '\\''" String <| Debug.toString '\'' 49 | , evalTest "toString Char double quote" "Debug.toString '\"'" String <| Debug.toString '"' 50 | , evalTest "toString String single quote" """Debug.toString "not 'escaped'" """ String <| Debug.toString "not 'escaped'" 51 | , evalTest "toString record" "Debug.toString { field = [ 0 ] }" String "{field = [0]}" 52 | ] 53 | 54 | trigTests : Test 55 | trigTests = 56 | describe "Trigonometry Tests" 57 | [ evalTest_ "radians 0" Float <| radians 0 58 | , evalTest_ "radians 5" Float <| radians 5 59 | , evalTest_ "radians -5" Float <| radians -5 60 | , evalTest_ "degrees 0" Float <| degrees 0 61 | , evalTest_ "degrees 90" Float <| degrees 90 62 | , evalTest_ "degrees -145" Float <| degrees -145 63 | , evalTest_ "turns 0" Float <| turns 0 64 | , evalTest_ "turns 8" Float <| turns 8 65 | , evalTest_ "turns -133" Float <| turns -133 66 | , evalTest_ "fromPolar (0, 0)" floatTuple <| fromPolar ( 0, 0 ) 67 | , evalTest_ "fromPolar (1, 0)" floatTuple <| fromPolar ( 1, 0 ) 68 | , evalTest_ "fromPolar (0, 1)" floatTuple <| fromPolar ( 0, 1 ) 69 | , evalTest_ "fromPolar (1, 1)" floatTuple <| fromPolar ( 1, 1 ) 70 | , evalTest_ "toPolar (0, 0)" floatTuple <| toPolar ( 0, 0 ) 71 | , evalTest_ "toPolar (1, 0)" floatTuple <| toPolar ( 1, 0 ) 72 | , evalTest_ "toPolar (0, 1)" floatTuple <| toPolar ( 0, 1 ) 73 | , evalTest_ "toPolar (1, 1)" floatTuple <| toPolar ( 1, 1 ) 74 | , evalTest_ "cos 0" Float <| cos 0 75 | , evalTest_ "sin 0" Float <| sin 0 76 | , evalTest_ "tan 17.2" Float <| tan 17.2 77 | , evalTest_ "acos -1" Float <| acos -1 78 | , evalTest_ "asin 0.3" Float <| asin 0.3 79 | , evalTest_ "atan 4567.8" Float <| atan 4567.8 80 | , evalTest_ "atan2 36 0.65" Float <| atan2 36 0.65 81 | , evalTest_ "pi" Float pi 82 | ] 83 | 84 | basicMathTests : Test 85 | basicMathTests = 86 | describe "Basic Math Tests" 87 | [ evalTest "add float" "155.6 + 3.4" Float <| 155.6 + 3.4 88 | , evalTest "add int" "round 10 + round 7" Int <| (round 10 + round 7) 89 | , evalTest "subtract float" "1 - 7.3" Float <| 1 - 7.3 90 | , evalTest "subtract int" "round 9432 - round 8302" Int <| round 9432 - round 8302 91 | , evalTest "multiply float" "96 * 4.5" Float <| 96 * 4.5 92 | , evalTest "multiply int" "round 10 * round 9" Int <| round 10 * round 9 93 | , evalTest "divide float" "527 / 40" Float <| 527 / 40 94 | , evalTest "divide int" "70 // 3" Int <| 70 // 3 95 | , evalTest_ "7 |> remainderBy 2" Int <| (7 |> remainderBy 2) 96 | , evalTest_ "-1 |> remainderBy 4" Int <| (-1 |> remainderBy 4) 97 | , evalTest_ "modBy 2 7" Int <| modBy 2 7 98 | , evalTest_ "modBy 4 -1" Int <| modBy 4 -1 99 | , evalTest_ "3 ^ 2" Float <| 3 ^ 2 100 | , evalTest_ "sqrt 81" Float <| sqrt 81 101 | , evalTest_ "negate 42" Float <| negate 42 102 | , evalTest_ "negate -42" Float <| negate -42 103 | , evalTest_ "negate 0" Float <| negate 0 104 | , evalTest_ "abs -25" Float <| abs -25 105 | , evalTest_ "abs 76" Float <| abs 76 106 | , evalTest_ "logBase 10 100" Float <| logBase 10 100 107 | , evalTest_ "logBase 2 256" Float <| logBase 2 256 108 | , evalTest_ "e" Float e 109 | ] 110 | 111 | booleanTests : Test 112 | booleanTests = 113 | describe "Boolean Tests" 114 | [ evalTest_ "False && False" Bool <| False && False 115 | , evalTest_ "False && True" Bool <| False && True 116 | , evalTest_ "True && False" Bool <| True && False 117 | , evalTest_ "True && True" Bool <| True && True 118 | , evalTest_ "False || False" Bool <| False || False 119 | , evalTest_ "False || True" Bool <| False || True 120 | , evalTest_ "True || False" Bool <| True || False 121 | , evalTest_ "True || True" Bool <| True || True 122 | , evalTest_ "xor False False" Bool <| xor False False 123 | , evalTest_ "xor False True" Bool <| xor False True 124 | , evalTest_ "xor True False" Bool <| xor True False 125 | , evalTest_ "xor True True" Bool <| xor True True 126 | , evalTest_ "not True" Bool <| not True 127 | , evalTest_ "not False" Bool <| not False 128 | ] 129 | 130 | conversionTests : Test 131 | conversionTests = 132 | describe "Conversion Tests" 133 | [ evalTest_ "round 0.6" Int <| round 0.6 134 | , evalTest_ "round 0.4" Int <| round 0.4 135 | , evalTest_ "round 0.5" Int <| round 0.5 136 | , evalTest_ "truncate -2367.9267" Int <| truncate -2367.9267 137 | , evalTest_ "floor -2367.9267" Int <| floor -2367.9267 138 | , evalTest_ "ceiling 37.2" Int <| ceiling 37.2 139 | , evalTest_ "toFloat 25" Float <| toFloat 25 140 | ] 141 | 142 | miscTests : Test 143 | miscTests = 144 | describe "Miscellaneous Tests" 145 | [ evalTest_ "isNaN (0/0)" Bool <| isNaN (0 / 0) 146 | , evalTest_ "isNaN (sqrt -1)" Bool <| isNaN (sqrt -1) 147 | , evalTest_ "isNaN (1/0)" Bool <| isNaN (1 / 0) 148 | , evalTest_ "isNaN 1" Bool <| isNaN 1 149 | , evalTest_ "isInfinite (0/0)" Bool <| isInfinite (0 / 0) 150 | , evalTest_ "isInfinite (sqrt -1)" Bool <| isInfinite (sqrt -1) 151 | , evalTest_ "isInfinite (1/0)" Bool <| isInfinite (1 / 0) 152 | , evalTest_ "isInfinite 1" Bool <| isInfinite 1 153 | , evalTest_ "\"hello\" ++ \"world\"" String <| "hello" ++ "world" 154 | , evalTest_ "[1, 1, 2] ++ [3, 5, 8]" (list Int) [ 1, 1, 2, 3, 5, 8 ] 155 | , evalTest_ "Tuple.first (1, 2)" Int <| Tuple.first ( 1, 2 ) 156 | , evalTest_ "Tuple.second (1, 2)" Int <| Tuple.second ( 1, 2 ) 157 | ] 158 | 159 | higherOrderTests : Test 160 | higherOrderTests = 161 | describe "Higher Order Helpers" 162 | [ evalTest_ "identity 'c'" Char <| identity 'c' 163 | , evalTest_ "always 42 ()" Int <| always 42 () 164 | , evalTest "<|" " identity <| 3 + 6" Int <| (identity <| 3 + 6) 165 | , evalTest "|>" " 3 + 6 |> identity" Int <| (3 + 6 |> identity) 166 | , evalTest "<<" " not << xor True <| True" Bool <| (not << xor True <| True) 167 | , describe ">>" 168 | [ evalTest "with xor" 169 | "True |> (xor True >> not)" 170 | Bool 171 | <| 172 | (True |> xor True >> not) 173 | , evalTest "with a record accessor" 174 | """ 175 | [ { foo = "NaS", bar = "baz" } ] 176 | |> List.map (.foo >> String.reverse) 177 | """ 178 | (list String) 179 | <| 180 | ([ { foo = "NaS", bar = "baz" } ] 181 | |> List.map (.foo >> String.reverse) 182 | ) 183 | ] 184 | ] 185 | in 186 | describe "Basics" 187 | [ comparison 188 | , toStringTests 189 | , trigTests 190 | , basicMathTests 191 | , booleanTests 192 | , conversionTests 193 | , miscTests 194 | , higherOrderTests 195 | ] 196 | 197 | 198 | floatTuple : ( Float, Float ) -> Value 199 | floatTuple ( l, r ) = 200 | Tuple (Float l) (Float r) 201 | -------------------------------------------------------------------------------- /tests/CoreTests/Bitwise.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.Bitwise exposing (suite) 2 | 3 | import Bitwise 4 | import Test exposing (Test, describe) 5 | import TestUtils exposing (evalTest) 6 | import Types exposing (Value(..)) 7 | 8 | 9 | suite : Test 10 | suite = 11 | describe "Bitwise" 12 | [ describe "and" 13 | [ evalTest "and with 32 bit integers" 14 | "Bitwise.and 5 3" 15 | Int 16 | (Bitwise.and 5 3) 17 | , evalTest "and with 0 as first argument" 18 | "Bitwise.and 0 1450" 19 | Int 20 | (Bitwise.and 0 1450) 21 | , evalTest "and with 0 as second argument" 22 | "Bitwise.and 274 0" 23 | Int 24 | (Bitwise.and 274 0) 25 | , evalTest "and with -1 as first argument" 26 | "Bitwise.and -1 2671" 27 | Int 28 | (Bitwise.and -1 2671) 29 | , evalTest "and with -1 as second argument" 30 | "Bitwise.and 96 -1" 31 | Int 32 | (Bitwise.and 96 -1) 33 | ] 34 | , describe "or" 35 | [ evalTest "or with 32 bit integers" 36 | "Bitwise.or 9 14" 37 | Int 38 | (Bitwise.or 9 14) 39 | , evalTest "or with 0 as first argument" 40 | "Bitwise.or 0 843" 41 | Int 42 | (Bitwise.or 0 843) 43 | , evalTest "or with 0 as second argument" 44 | "Bitwise.or 19 0" 45 | Int 46 | (Bitwise.or 19 0) 47 | , evalTest "or with -1 as first argument" 48 | "Bitwise.or -1 2360" 49 | Int 50 | (Bitwise.or -1 2360) 51 | , evalTest "or with -1 as second argument" 52 | "Bitwise.or 3 -1" 53 | Int 54 | (Bitwise.or 3 -1) 55 | ] 56 | , describe "xor" 57 | [ evalTest "xor with 32 bit integers" 58 | "Bitwise.xor 580 24" 59 | Int 60 | (Bitwise.xor 580 24) 61 | , evalTest "xor with 0 as first argument" 62 | "Bitwise.xor 0 56" 63 | Int 64 | (Bitwise.xor 0 56) 65 | , evalTest "xor with 0 as second argument" 66 | "Bitwise.xor -268 0" 67 | Int 68 | (Bitwise.xor -268 0) 69 | , evalTest "xor with -1 as first argument" 70 | "Bitwise.xor -1 24" 71 | Int 72 | (Bitwise.xor -1 24) 73 | , evalTest "xor with -1 as second argument" 74 | "Bitwise.xor -25602 -1" 75 | Int 76 | (Bitwise.xor -25602 -1) 77 | ] 78 | , describe "complement" 79 | [ evalTest "complement a positive" 80 | "Bitwise.complement 8" 81 | Int 82 | (Bitwise.complement 8) 83 | , evalTest "complement a negative" 84 | "Bitwise.complement -279" 85 | Int 86 | (Bitwise.complement -279) 87 | ] 88 | , describe "shiftLeftBy" 89 | [ evalTest "8 |> shiftLeftBy 1 == 16" 90 | "8 |> Bitwise.shiftLeftBy 1" 91 | Int 92 | (8 |> Bitwise.shiftLeftBy 1) 93 | , evalTest "8 |> shiftLeftby 2 == 32" 94 | "8 |> Bitwise.shiftLeftBy 2" 95 | Int 96 | (8 |> Bitwise.shiftLeftBy 2) 97 | ] 98 | , describe "shiftRightBy" 99 | [ evalTest "32 |> shiftRight 1 == 16" 100 | "32 |> Bitwise.shiftRightBy 1" 101 | Int 102 | (32 |> Bitwise.shiftRightBy 1) 103 | , evalTest "32 |> shiftRight 2 == 8" 104 | "32 |> Bitwise.shiftRightBy 2" 105 | Int 106 | (32 |> Bitwise.shiftRightBy 2) 107 | , evalTest "-32 |> shiftRight 1 == -16" 108 | "-32 |> Bitwise.shiftRightBy 1" 109 | Int 110 | (-32 |> Bitwise.shiftRightBy 1) 111 | ] 112 | , describe "shiftRightZfBy" 113 | [ evalTest "32 |> shiftRightZfBy 1 == 16" 114 | "32 |> Bitwise.shiftRightZfBy 1" 115 | Int 116 | (32 |> Bitwise.shiftRightZfBy 1) 117 | , evalTest "32 |> shiftRightZfBy 2 == 8" 118 | "32 |> Bitwise.shiftRightZfBy 2" 119 | Int 120 | (32 |> Bitwise.shiftRightZfBy 2) 121 | , evalTest "-32 |> shiftRightZfBy 1 == 2147483632" 122 | "-32 |> Bitwise.shiftRightZfBy 1" 123 | Int 124 | (-32 |> Bitwise.shiftRightZfBy 1) 125 | ] 126 | ] 127 | -------------------------------------------------------------------------------- /tests/CoreTests/Char.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.Char exposing (suite) 2 | 3 | import Test exposing (Test, describe) 4 | import TestUtils exposing (evalTest, evalTest_) 5 | import Types exposing (Value(..)) 6 | 7 | 8 | suite : Test 9 | suite = 10 | describe "Char" 11 | [ evalTest "Char.toCode UTF-16" "Char.toCode '𝌆'" Int <| Char.toCode '𝌆' 12 | , evalTest "Char.fromCode UTF-16" "Char.fromCode 0x0001D306" Char <| Char.fromCode 0x0001D306 13 | , evalTest_ "Char.toLocaleLower 'Ì'" Char <| Char.toLocaleLower 'Ì' 14 | , evalTest_ "Char.toLocaleLower 'ì'" Char <| Char.toLocaleLower 'ì' 15 | , evalTest_ "Char.toLocaleUpper 'Ì'" Char <| Char.toLocaleUpper 'Ì' 16 | , evalTest_ "Char.toLocaleUpper 'ì'" Char <| Char.toLocaleUpper 'ì' 17 | ] 18 | -------------------------------------------------------------------------------- /tests/CoreTests/CodeGen.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.CodeGen exposing (suite) 2 | 3 | import Test exposing (Test, describe) 4 | import TestUtils exposing (evalTest, evalTest_) 5 | import Types exposing (Value(..)) 6 | 7 | 8 | type Wrapper a 9 | = Wrapper a 10 | 11 | 12 | caseUnderscore : Maybe number -> number 13 | caseUnderscore m_ = 14 | case m_ of 15 | Just x -> 16 | x 17 | 18 | Nothing -> 19 | 0 20 | 21 | 22 | patternUnderscore : number 23 | patternUnderscore = 24 | case Just 42 of 25 | Just x_ -> 26 | x_ 27 | 28 | Nothing -> 29 | 0 30 | 31 | 32 | letQualified : number 33 | letQualified = 34 | let 35 | (Wrapper x) = 36 | Wrapper 42 37 | in 38 | x 39 | 40 | 41 | caseQualified : number 42 | caseQualified = 43 | case Just 42 of 44 | Maybe.Just x -> 45 | x 46 | 47 | Nothing -> 48 | 0 49 | 50 | 51 | suite : Test 52 | suite = 53 | describe "CodeGen" 54 | [ underscores 55 | , qualifiedPatterns 56 | , hex 57 | ] 58 | 59 | 60 | underscores : Test 61 | underscores = 62 | describe "Underscores" 63 | [ evalTest "case" 64 | """ 65 | let 66 | caseUnderscore : Maybe number -> number 67 | caseUnderscore m_ = 68 | case m_ of 69 | Just x -> 70 | x 71 | 72 | Nothing -> 73 | 0 74 | in caseUnderscore (Just 42)""" 75 | Int 76 | (caseUnderscore (Just 42)) 77 | , evalTest "pattern" 78 | """ 79 | let 80 | patternUnderscore : number 81 | patternUnderscore = 82 | case Just 42 of 83 | Just x_ -> 84 | x_ 85 | 86 | Nothing -> 87 | 0 88 | in 89 | patternUnderscore""" 90 | Int 91 | patternUnderscore 92 | ] 93 | 94 | 95 | qualifiedPatterns : Test 96 | qualifiedPatterns = 97 | describe "Qualified Patterns" 98 | [ evalTest "let" 99 | """ 100 | let 101 | letQualified : number 102 | letQualified = 103 | let 104 | (Wrapper x) = 105 | Wrapper 42 106 | in 107 | x 108 | in 109 | letQualified""" 110 | Int 111 | letQualified 112 | , evalTest "case" 113 | """ 114 | let 115 | caseQualified : number 116 | caseQualified = 117 | case Just 42 of 118 | Maybe.Just x -> 119 | x 120 | 121 | Nothing -> 122 | 0 123 | in 124 | caseQualified""" 125 | Int 126 | caseQualified 127 | ] 128 | 129 | 130 | hex : Test 131 | hex = 132 | describe "Hex" 133 | [ evalTest_ "0xFFFFFFFF" Int 0xFFFFFFFF 134 | , evalTest_ "0xD066F00D" Int 0xD066F00D 135 | , evalTest_ "0x00" Int 0x00 136 | ] 137 | -------------------------------------------------------------------------------- /tests/CoreTests/Equality.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.Equality exposing (suite) 2 | 3 | import Fuzz 4 | import Test exposing (Test, describe) 5 | import TestUtils exposing (evalExpect, evalTest, withInt) 6 | import Types exposing (Value(..)) 7 | 8 | 9 | type Different 10 | = A String 11 | | B (List Int) 12 | 13 | 14 | suite : Test 15 | suite = 16 | describe "Equality Tests" 17 | [ diffTests 18 | , recordTests 19 | , listTests 20 | ] 21 | 22 | 23 | listTests : Test 24 | listTests = 25 | Test.skip <| 26 | describe "List equality" 27 | [ Test.fuzz2 28 | (Fuzz.intRange 100 10000) 29 | (Fuzz.intRange 100 10000) 30 | "Simple comparison" 31 | <| 32 | \size1 size2 -> 33 | evalExpect 34 | (withInt "size1" size1 <| 35 | withInt "size2" size2 <| 36 | "List.range 0 size1 == List.range 0 size2" 37 | ) 38 | Bool 39 | (List.range 0 size1 == List.range 0 size2) 40 | ] 41 | 42 | 43 | diffTests : Test 44 | diffTests = 45 | describe "ADT equality" 46 | [ evalTest "As eq" 47 | """(A "a" == A "a")""" 48 | Bool 49 | (A "a" == A "a") 50 | , evalTest "Bs eq" 51 | """(B [ 1 ] == B [ 1 ])""" 52 | Bool 53 | (B [ 1 ] == B [ 1 ]) 54 | , evalTest "A left neq" 55 | """(A "a" /= B [ 1 ])""" 56 | Bool 57 | (A "a" /= B [ 1 ]) 58 | , evalTest "A right neq" 59 | """(B [ 1 ] /= A "a")""" 60 | Bool 61 | (B [ 1 ] /= A "a") 62 | ] 63 | 64 | 65 | recordTests : Test 66 | recordTests = 67 | describe "Record equality" 68 | [ evalTest "empty same" 69 | """({} == {})""" 70 | Bool 71 | ({} == {}) 72 | , evalTest "ctor same" 73 | """({ field = Just 3 } == { field = Just 3 })""" 74 | Bool 75 | ({ field = Just 3 } == { field = Just 3 }) 76 | , evalTest "ctor same, special case" 77 | """({ ctor = Just 3 } == { ctor = Just 3 })""" 78 | Bool 79 | ({ ctor = Just 3 } == { ctor = Just 3 }) 80 | , evalTest "ctor diff" 81 | """({ field = Just 3 } /= { field = Nothing })""" 82 | Bool 83 | ({ field = Just 3 } /= { field = Nothing }) 84 | , evalTest "ctor diff, special case" 85 | """({ ctor = Just 3 } /= { ctor = Nothing })""" 86 | Bool 87 | ({ ctor = Just 3 } /= { ctor = Nothing }) 88 | ] 89 | -------------------------------------------------------------------------------- /tests/CoreTests/List.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.List exposing (suite) 2 | 3 | import Test exposing (Test, describe) 4 | import TestUtils exposing (evalTest, list, maybe, slowTest, tuple) 5 | import Types exposing (Value(..)) 6 | 7 | 8 | suite : Test 9 | suite = 10 | describe "List Tests" 11 | [ testListOfN 0 12 | , testListOfN 1 13 | , testListOfN 2 14 | , slowTest testListOfN 15 | ] 16 | 17 | 18 | evalTestN : Int -> String -> String -> (e -> Value) -> e -> Test 19 | evalTestN n description code toValue value = 20 | evalTest description 21 | (""" 22 | let 23 | n : Int 24 | n = 25 | """ ++ String.fromInt n ++ """ 26 | 27 | xs : List Int 28 | xs = 29 | List.range 1 n 30 | 31 | xsOpp : List Int 32 | xsOpp = 33 | List.range -n -1 34 | 35 | xsNeg : List Int 36 | xsNeg = 37 | List.foldl (::) [] xsOpp 38 | 39 | -- assume foldl and (::) work 40 | zs : List Int 41 | zs = 42 | List.range 0 n 43 | 44 | mid : Int 45 | mid = 46 | n // 2 47 | in 48 | """ ++ code) 49 | toValue 50 | value 51 | 52 | 53 | testListOfN : Int -> Test 54 | testListOfN n = 55 | let 56 | xs : List Int 57 | xs = 58 | List.range 1 n 59 | 60 | xsOpp : List Int 61 | xsOpp = 62 | List.range -n -1 63 | 64 | xsNeg : List Int 65 | xsNeg = 66 | List.foldl (::) [] xsOpp 67 | 68 | -- assume foldl and (::) work 69 | zs : List Int 70 | zs = 71 | List.range 0 n 72 | 73 | mid : Int 74 | mid = 75 | n // 2 76 | in 77 | describe (String.fromInt n ++ " elements") 78 | [ describe "foldl" 79 | [ evalTestN n 80 | "order" 81 | "List.foldl (\\x _ -> x) 0 xs" 82 | Int 83 | (List.foldl (\x _ -> x) 0 xs) 84 | , evalTestN n 85 | "total" 86 | "List.foldl (+) 0 xs" 87 | Int 88 | (List.foldl (+) 0 xs) 89 | ] 90 | , describe "foldr" 91 | [ evalTestN n 92 | "order" 93 | "List.foldr (\\x _ -> x) 0 xs" 94 | Int 95 | (List.foldr (\x _ -> x) 0 xs) 96 | , evalTestN n 97 | "total" 98 | "List.foldl (+) 0 xs" 99 | Int 100 | (List.foldl (+) 0 xs) 101 | ] 102 | , describe "map" 103 | [ evalTestN n 104 | "identity" 105 | "List.map identity xs" 106 | (list Int) 107 | (List.map identity xs) 108 | , evalTestN n 109 | "linear" 110 | "List.map ((+) 1) xs" 111 | (list Int) 112 | (List.map ((+) 1) xs) 113 | ] 114 | , evalTestN n 115 | "isEmpty" 116 | "List.isEmpty xs" 117 | Bool 118 | (List.isEmpty xs) 119 | , evalTestN n 120 | "length" 121 | "List.length xs" 122 | Int 123 | (List.length xs) 124 | , evalTestN n 125 | "reverse" 126 | "List.reverse xsNeg" 127 | (list Int) 128 | (List.reverse xsNeg) 129 | , describe "member" 130 | [ evalTestN n 131 | "positive" 132 | "List.member n zs" 133 | Bool 134 | (List.member n zs) 135 | , evalTestN n 136 | "negative" 137 | "List.member (n + 1) xs" 138 | Bool 139 | (List.member (n + 1) xs) 140 | ] 141 | , evalTestN n 142 | "head" 143 | "List.head xs" 144 | (maybe Int) 145 | (List.head xs) 146 | , describe "List.filter" 147 | [ evalTestN n 148 | "none" 149 | "List.filter (\\x -> x > n) xs" 150 | (list Int) 151 | (List.filter (\x -> x > n) xs) 152 | , evalTestN n 153 | "one" 154 | "List.filter (\\z -> z == n) zs" 155 | (list Int) 156 | (List.filter (\z -> z == n) zs) 157 | , evalTestN n 158 | "all" 159 | "List.filter (\\x -> x <= n) xs" 160 | (list Int) 161 | (List.filter (\x -> x <= n) xs) 162 | ] 163 | , describe "take" 164 | [ evalTestN n 165 | "none" 166 | "List.take 0 xs" 167 | (list Int) 168 | (List.take 0 xs) 169 | , evalTestN n 170 | "some" 171 | "List.take n zs" 172 | (list Int) 173 | (List.take n zs) 174 | , evalTestN n 175 | "all" 176 | "List.take n xs" 177 | (list Int) 178 | (List.take n xs) 179 | , evalTestN n 180 | "all+" 181 | "List.take (n + 1) xs" 182 | (list Int) 183 | (List.take (n + 1) xs) 184 | ] 185 | , describe "drop" 186 | [ evalTestN n 187 | "none" 188 | "List.drop 0 xs" 189 | (list Int) 190 | (List.drop 0 xs) 191 | , evalTestN n 192 | "some" 193 | "List.drop n zs" 194 | (list Int) 195 | (List.drop n zs) 196 | , evalTestN n 197 | "all" 198 | "List.drop n xs" 199 | (list Int) 200 | (List.drop n xs) 201 | , evalTestN n 202 | "all+" 203 | "List.drop (n + 1) xs" 204 | (list Int) 205 | (List.drop (n + 1) xs) 206 | ] 207 | , evalTestN n 208 | "repeat" 209 | "List.repeat n -1" 210 | (list Int) 211 | (List.repeat n -1) 212 | , evalTestN n 213 | "append" 214 | "List.append xs xs |> List.foldl (+) 0" 215 | Int 216 | (List.append xs xs |> List.foldl (+) 0) 217 | , evalTestN n 218 | "(::)" 219 | "-1 :: xs" 220 | (list Int) 221 | (-1 :: xs) 222 | , evalTestN n 223 | "List.concat" 224 | "List.concat [ xs, zs, xs ]" 225 | (list Int) 226 | (List.concat [ xs, zs, xs ]) 227 | , evalTestN n 228 | "intersperse" 229 | "List.intersperse -1 xs |> List.foldl (\\x ( c1, c2 ) -> ( c2, c1 + x )) ( 0, 0 )" 230 | (tuple Int Int) 231 | (List.intersperse -1 xs |> List.foldl (\x ( c1, c2 ) -> ( c2, c1 + x )) ( 0, 0 )) 232 | , describe "partition" 233 | [ evalTestN n 234 | "left" 235 | "List.partition (\\x -> x > 0) xs" 236 | (tuple (list Int) (list Int)) 237 | (List.partition (\x -> x > 0) xs) 238 | , evalTestN n 239 | "right" 240 | "List.partition (\\x -> x < 0) xs" 241 | (tuple (list Int) (list Int)) 242 | (List.partition (\x -> x < 0) xs) 243 | , evalTestN n 244 | "split" 245 | "List.partition (\\x -> x > mid) xs" 246 | (tuple (list Int) (list Int)) 247 | (List.partition (\x -> x > mid) xs) 248 | ] 249 | , describe "map2" 250 | [ evalTestN n 251 | "same length" 252 | "List.map2 (+) xs xs" 253 | (list Int) 254 | (List.map2 (+) xs xs) 255 | , evalTestN n 256 | "long first" 257 | "List.map2 (+) zs xs" 258 | (list Int) 259 | (List.map2 (+) zs xs) 260 | , evalTestN n 261 | "short first" 262 | "List.map2 (+) xs zs" 263 | (list Int) 264 | (List.map2 (+) xs zs) 265 | ] 266 | , evalTestN n 267 | "unzip" 268 | "List.map (\\x -> ( -x, x )) xs |> List.unzip" 269 | (tuple (list Int) (list Int)) 270 | (List.map (\x -> ( -x, x )) xs |> List.unzip) 271 | , describe "filterMap" 272 | [ evalTestN n 273 | "none" 274 | "List.filterMap (\\_ -> Nothing) xs" 275 | (list Int) 276 | (List.filterMap (\_ -> Nothing) xs) 277 | , evalTestN n 278 | "all" 279 | "List.filterMap (\\x -> Just -x) xs" 280 | (list Int) 281 | (List.filterMap (\x -> Just -x) xs) 282 | , let 283 | halve : Int -> Maybe Int 284 | halve x = 285 | if modBy 2 x == 0 then 286 | Just (x // 2) 287 | 288 | else 289 | Nothing 290 | in 291 | evalTestN n 292 | "some" 293 | "let halve x = if modBy 2 x == 0 then Just (x // 2) else Nothing in List.filterMap halve xs" 294 | (list Int) 295 | (List.filterMap halve xs) 296 | ] 297 | , describe "concatMap" 298 | [ evalTestN n 299 | "none" 300 | "List.concatMap (\\_ -> []) xs" 301 | (list Int) 302 | (List.concatMap (\_ -> []) xs) 303 | , evalTestN n 304 | "all" 305 | "List.concatMap (\\x -> [ -x ]) xs" 306 | (list Int) 307 | (List.concatMap (\x -> [ -x ]) xs) 308 | ] 309 | , evalTestN n 310 | "indexedMap" 311 | "List.indexedMap (\\i x -> ( i, -x )) xs" 312 | (list (tuple Int Int)) 313 | (List.indexedMap (\i x -> ( i, -x )) xs) 314 | , evalTestN n 315 | "sum" 316 | "List.sum xs" 317 | Int 318 | (List.sum xs) 319 | , evalTestN n 320 | "product" 321 | "List.product zs" 322 | Int 323 | (List.product zs) 324 | , evalTestN n 325 | "maximum" 326 | "List.maximum xs" 327 | (maybe Int) 328 | (List.maximum xs) 329 | , evalTestN n 330 | "minimum" 331 | "List.minimum xs" 332 | (maybe Int) 333 | (List.minimum xs) 334 | , describe "all" 335 | [ evalTestN n 336 | "false" 337 | "List.all (\\z -> z < n) zs" 338 | Bool 339 | (List.all (\z -> z < n) zs) 340 | , evalTestN n 341 | "true" 342 | "List.all (\\x -> x <= n) xs" 343 | Bool 344 | (List.all (\x -> x <= n) xs) 345 | ] 346 | , describe "any" 347 | [ evalTestN n 348 | "false" 349 | "List.any (\\x -> x > n) xs" 350 | Bool 351 | (List.any (\x -> x > n) xs) 352 | , evalTestN n 353 | "true" 354 | "List.any (\\z -> z >= n) zs" 355 | Bool 356 | (List.any (\z -> z >= n) zs) 357 | ] 358 | , describe "sort" 359 | [ evalTestN n 360 | "sorted" 361 | "List.sort xs" 362 | (list Int) 363 | (List.sort xs) 364 | , evalTestN n 365 | "unsorted" 366 | "List.sort xsNeg" 367 | (list Int) 368 | (List.sort xsNeg) 369 | ] 370 | , describe "sortBy" 371 | [ evalTestN n 372 | "sorted" 373 | "List.sortBy negate xsNeg" 374 | (list Int) 375 | (List.sortBy negate xsNeg) 376 | , evalTestN n 377 | "unsorted" 378 | "List.sortBy negate xsOpp" 379 | (list Int) 380 | (List.sortBy negate xsOpp) 381 | ] 382 | , describe "sortWith" 383 | [ evalTestN n 384 | "sorted" 385 | "List.sortWith (\\x -> \\y -> compare y x) xsNeg" 386 | (list Int) 387 | (List.sortWith (\x -> \y -> compare y x) xsNeg) 388 | , evalTestN n 389 | "unsorted" 390 | "List.sortWith (\\x -> \\y -> compare y x) xsOpp" 391 | (list Int) 392 | (List.sortWith (\x -> \y -> compare y x) xsOpp) 393 | ] 394 | ] 395 | -------------------------------------------------------------------------------- /tests/CoreTests/Maybe.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.Maybe exposing (suite) 2 | 3 | import Test exposing (Test, describe) 4 | import TestUtils exposing (evalTest, maybe) 5 | import Types exposing (Value(..)) 6 | 7 | 8 | suite : Test 9 | suite = 10 | describe "Maybe Tests" 11 | [ describe "Common Helpers Tests" 12 | [ describe "withDefault Tests" 13 | [ evalTest "no default used" 14 | "Maybe.withDefault 5 (Just 0)" 15 | Int 16 | (Maybe.withDefault 5 (Just 0)) 17 | , evalTest "default used" 18 | "Maybe.withDefault 5 Nothing" 19 | Int 20 | (Maybe.withDefault 5 Nothing) 21 | ] 22 | , describe "map Tests" 23 | (let 24 | f : number -> number 25 | f = 26 | \n -> n + 1 27 | in 28 | [ evalTest "on Just" 29 | "let f n = n + 1 in Maybe.map f (Just 0)" 30 | (maybe Int) 31 | (Maybe.map f (Just 0)) 32 | , evalTest "on Nothing" 33 | "let f n = n + 1 in Maybe.map f Nothing" 34 | (maybe Int) 35 | (Maybe.map f Nothing) 36 | ] 37 | ) 38 | , describe "map2 Tests" 39 | (let 40 | f : number -> number -> number 41 | f = 42 | (+) 43 | in 44 | [ evalTest "on (Just, Just)" 45 | "let f = (+) in Maybe.map2 f (Just 0) (Just 1)" 46 | (maybe Int) 47 | (Maybe.map2 f (Just 0) (Just 1)) 48 | , evalTest "on (Just, Nothing)" 49 | "let f = (+) in Maybe.map2 f (Just 0) Nothing" 50 | (maybe Int) 51 | (Maybe.map2 f (Just 0) Nothing) 52 | , evalTest "on (Nothing, Just)" 53 | "let f = (+) in Maybe.map2 f Nothing (Just 0)" 54 | (maybe Int) 55 | (Maybe.map2 f Nothing (Just 0)) 56 | ] 57 | ) 58 | , describe "map3 Tests" 59 | (let 60 | f : number -> number -> number -> number 61 | f = 62 | \a b c -> a + b + c 63 | in 64 | [ evalTest "on (Just, Just, Just)" 65 | "let f a b c = a + b + c in Maybe.map3 f (Just 1) (Just 1) (Just 1)" 66 | (maybe Int) 67 | (Maybe.map3 f (Just 1) (Just 1) (Just 1)) 68 | , evalTest "on (Just, Just, Nothing)" 69 | "let f a b c = a + b + c in Maybe.map3 f (Just 1) (Just 1) Nothing" 70 | (maybe Int) 71 | (Maybe.map3 f (Just 1) (Just 1) Nothing) 72 | , evalTest "on (Just, Nothing, Just)" 73 | "let f a b c = a + b + c in Maybe.map3 f (Just 1) Nothing (Just 1)" 74 | (maybe Int) 75 | (Maybe.map3 f (Just 1) Nothing (Just 1)) 76 | , evalTest "on (Nothing, Just, Just)" 77 | "let f a b c = a + b + c in Maybe.map3 f Nothing (Just 1) (Just 1)" 78 | (maybe Int) 79 | (Maybe.map3 f Nothing (Just 1) (Just 1)) 80 | ] 81 | ) 82 | , describe "map4 Tests" 83 | (let 84 | f : number -> number -> number -> number -> number 85 | f = 86 | \a b c d -> a + b + c + d 87 | in 88 | [ evalTest "on (Just, Just, Just, Just)" 89 | "let f a b c d = a + b + c + d in Maybe.map4 f (Just 1) (Just 1) (Just 1) (Just 1)" 90 | (maybe Int) 91 | (Maybe.map4 f (Just 1) (Just 1) (Just 1) (Just 1)) 92 | , evalTest "on (Just, Just, Just, Nothing)" 93 | "let f a b c d = a + b + c + d in Maybe.map4 f (Just 1) (Just 1) (Just 1) Nothing" 94 | (maybe Int) 95 | (Maybe.map4 f (Just 1) (Just 1) (Just 1) Nothing) 96 | , evalTest "on (Just, Just, Nothing, Just)" 97 | "let f a b c d = a + b + c + d in Maybe.map4 f (Just 1) (Just 1) Nothing (Just 1)" 98 | (maybe Int) 99 | (Maybe.map4 f (Just 1) (Just 1) Nothing (Just 1)) 100 | , evalTest "on (Just, Nothing, Just, Just)" 101 | "let f a b c d = a + b + c + d in Maybe.map4 f (Just 1) Nothing (Just 1) (Just 1)" 102 | (maybe Int) 103 | (Maybe.map4 f (Just 1) Nothing (Just 1) (Just 1)) 104 | , evalTest "on (Nothing, Just, Just, Just)" 105 | "let f a b c d = a + b + c + d in Maybe.map4 f Nothing (Just 1) (Just 1) (Just 1)" 106 | (maybe Int) 107 | (Maybe.map4 f Nothing (Just 1) (Just 1) (Just 1)) 108 | ] 109 | ) 110 | , describe "map5 Tests" 111 | (let 112 | f : number -> number -> number -> number -> number -> number 113 | f = 114 | \a b c d e -> a + b + c + d + e 115 | in 116 | [ evalTest "on (Just, Just, Just, Just, Just)" 117 | "let f a b c d e = a + b + c + d + e in Maybe.map5 f (Just 1) (Just 1) (Just 1) (Just 1) (Just 1)" 118 | (maybe Int) 119 | (Maybe.map5 f (Just 1) (Just 1) (Just 1) (Just 1) (Just 1)) 120 | , evalTest "on (Just, Just, Just, Just, Nothing)" 121 | "let f a b c d e = a + b + c + d + e in Maybe.map5 f (Just 1) (Just 1) (Just 1) (Just 1) Nothing" 122 | (maybe Int) 123 | (Maybe.map5 f (Just 1) (Just 1) (Just 1) (Just 1) Nothing) 124 | , evalTest "on (Just, Just, Just, Nothing, Just)" 125 | "let f a b c d e = a + b + c + d + e in Maybe.map5 f (Just 1) (Just 1) (Just 1) Nothing (Just 1)" 126 | (maybe Int) 127 | (Maybe.map5 f (Just 1) (Just 1) (Just 1) Nothing (Just 1)) 128 | , evalTest "on (Just, Just, Nothing, Just, Just)" 129 | "let f a b c d e = a + b + c + d + e in Maybe.map5 f (Just 1) (Just 1) Nothing (Just 1) (Just 1)" 130 | (maybe Int) 131 | (Maybe.map5 f (Just 1) (Just 1) Nothing (Just 1) (Just 1)) 132 | , evalTest "on (Just, Nothing, Just, Just, Just)" 133 | "let f a b c d e = a + b + c + d + e in Maybe.map5 f (Just 1) Nothing (Just 1) (Just 1) (Just 1)" 134 | (maybe Int) 135 | (Maybe.map5 f (Just 1) Nothing (Just 1) (Just 1) (Just 1)) 136 | , evalTest "on (Nothing, Just, Just, Just, Just)" 137 | "let f a b c d e = a + b + c + d + e in Maybe.map5 f Nothing (Just 1) (Just 1) (Just 1) (Just 1)" 138 | (maybe Int) 139 | (Maybe.map5 f Nothing (Just 1) (Just 1) (Just 1) (Just 1)) 140 | ] 141 | ) 142 | ] 143 | , describe "Chaining Maybes Tests" 144 | [ describe "andThen Tests" 145 | [ evalTest "succeeding chain" 146 | "Maybe.andThen (\\a -> Just a) (Just 1)" 147 | (maybe Int) 148 | (Maybe.andThen (\a -> Just a) (Just 1)) 149 | , evalTest "failing chain (original Maybe failed)" 150 | "Maybe.andThen (\\a -> Just a) Nothing" 151 | (maybe Int) 152 | (Maybe.andThen (\a -> Just a) Nothing) 153 | , evalTest "failing chain (chained function failed)" 154 | "Maybe.andThen (\\a -> Nothing) (Just 1)" 155 | (maybe Int) 156 | (Maybe.andThen (\_ -> Nothing) (Just 1)) 157 | ] 158 | ] 159 | ] 160 | -------------------------------------------------------------------------------- /tests/CoreTests/Result.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.Result exposing (suite) 2 | 3 | import Test exposing (Test, describe) 4 | import TestUtils exposing (evalTest, result) 5 | import Types exposing (Value(..)) 6 | 7 | 8 | isEven : Int -> Result String Int 9 | isEven n = 10 | if modBy 2 n == 0 then 11 | Ok n 12 | 13 | else 14 | Err "number is odd" 15 | 16 | 17 | withIsEven : String -> String 18 | withIsEven source = 19 | "let isEven n = if modBy 2 n == 0 then Ok n else Err \"number is odd\" in " ++ source 20 | 21 | 22 | toIntResult : String -> Result String Int 23 | toIntResult s = 24 | case String.toInt s of 25 | Just i -> 26 | Ok i 27 | 28 | Nothing -> 29 | Err <| "could not convert string '" ++ s ++ "' to an Int" 30 | 31 | 32 | withToIntResult : String -> String 33 | withToIntResult source = 34 | """ 35 | let 36 | toIntResult s = 37 | case String.toInt s of 38 | Just i -> 39 | Ok i 40 | 41 | Nothing -> 42 | Err ("could not convert string '" ++ s ++ "' to an Int") 43 | in """ ++ source 44 | 45 | 46 | add3 : number -> number -> number -> number 47 | add3 a b c = 48 | a + b + c 49 | 50 | 51 | add4 : number -> number -> number -> number -> number 52 | add4 a b c d = 53 | a + b + c + d 54 | 55 | 56 | add5 : number -> number -> number -> number -> number -> number 57 | add5 a b c d e = 58 | a + b + c + d + e 59 | 60 | 61 | suite : Test 62 | suite = 63 | describe "Result Tests" 64 | [ mapTests 65 | , mapNTests 66 | , andThenTests 67 | ] 68 | 69 | 70 | mapTests : Test 71 | mapTests = 72 | describe "map Tests" 73 | [ evalTest "map Ok" 74 | """Result.map ((+) 1) (Ok 2)""" 75 | (result String Int) 76 | (Result.map ((+) 1) (Ok 2)) 77 | , evalTest "map Err" 78 | """Result.map ((+) 1) (Err "error")""" 79 | (result String Int) 80 | (Result.map ((+) 1) (Err "error")) 81 | ] 82 | 83 | 84 | mapNTests : Test 85 | mapNTests = 86 | describe "mapN Tests" 87 | [ evalTest "map2 Ok" 88 | """Result.map2 (+) (Ok 1) (Ok 2)""" 89 | (result String Int) 90 | (Result.map2 (+) (Ok 1) (Ok 2)) 91 | , evalTest "map2 Err" 92 | """Result.map2 (+) (Ok 1) (Err "x")""" 93 | (result String Int) 94 | (Result.map2 (+) (Ok 1) (Err "x")) 95 | , evalTest "map3 Ok" 96 | """let add3 a b c = a + b + c in Result.map3 add3 (Ok 1) (Ok 2) (Ok 3)""" 97 | (result String Int) 98 | (Result.map3 add3 (Ok 1) (Ok 2) (Ok 3)) 99 | , evalTest "map3 Err" 100 | """let add3 a b c = a + b + c in Result.map3 add3 (Ok 1) (Ok 2) (Err "x")""" 101 | (result String Int) 102 | (Result.map3 add3 (Ok 1) (Ok 2) (Err "x")) 103 | , evalTest "map4 Ok" 104 | """let add4 a b c d = a + b + c + d in Result.map4 add4 (Ok 1) (Ok 2) (Ok 3) (Ok 4)""" 105 | (result String Int) 106 | (Result.map4 add4 (Ok 1) (Ok 2) (Ok 3) (Ok 4)) 107 | , evalTest "map4 Err" 108 | """let add4 a b c d = a + b + c + d in Result.map4 add4 (Ok 1) (Ok 2) (Ok 3) (Err "x")""" 109 | (result String Int) 110 | (Result.map4 add4 (Ok 1) (Ok 2) (Ok 3) (Err "x")) 111 | , evalTest "map5 Ok" 112 | """let add5 a b c d e = a + b + c + d + e in Result.map5 add5 (Ok 1) (Ok 2) (Ok 3) (Ok 4) (Ok 5)""" 113 | (result String Int) 114 | (Result.map5 add5 (Ok 1) (Ok 2) (Ok 3) (Ok 4) (Ok 5)) 115 | , evalTest "map5 Err" 116 | """let add5 a b c d e = a + b + c + d + e in Result.map5 add5 (Ok 1) (Ok 2) (Ok 3) (Ok 4) (Err "x")""" 117 | (result String Int) 118 | (Result.map5 add5 (Ok 1) (Ok 2) (Ok 3) (Ok 4) (Err "x")) 119 | ] 120 | 121 | 122 | andThenTests : Test 123 | andThenTests = 124 | describe "andThen Tests" 125 | [ evalTest "andThen Ok" 126 | (withToIntResult <| withIsEven """toIntResult "42" |> Result.andThen isEven""") 127 | (result String Int) 128 | (toIntResult "42" |> Result.andThen isEven) 129 | , evalTest "andThen first Err" 130 | (withToIntResult <| withIsEven """toIntResult "4.2" |> Result.andThen isEven""") 131 | (result String Int) 132 | (toIntResult "4.2" |> Result.andThen isEven) 133 | , evalTest "andThen second Err" 134 | (withToIntResult <| withIsEven """toIntResult "41" |> Result.andThen isEven""") 135 | (result String Int) 136 | (toIntResult "41" |> Result.andThen isEven) 137 | ] 138 | -------------------------------------------------------------------------------- /tests/CoreTests/String.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.String exposing (suite) 2 | 3 | import Expect 4 | import Test exposing (Test, describe, test) 5 | import TestUtils exposing (evalTest_, list) 6 | import Types exposing (Value(..)) 7 | 8 | 9 | suite : Test 10 | suite = 11 | describe "String" 12 | [ simpleTests 13 | , combiningTests 14 | , intTests 15 | , floatTests 16 | , encodingTests 17 | ] 18 | 19 | 20 | simpleTests : Test 21 | simpleTests = 22 | describe "Simple Stuff" 23 | [ evalTest_ "String.isEmpty \"\"" Bool <| String.isEmpty "" 24 | , evalTest_ "String.isEmpty \"the world\"" Bool <| String.isEmpty "the world" 25 | , evalTest_ "String.length \"innumerable\"" Int <| String.length "innumerable" 26 | , evalTest_ "String.endsWith \"ship\" \"spaceship\"" Bool <| String.endsWith "ship" "spaceship" 27 | , evalTest_ "String.reverse \"stressed\"" String <| String.reverse "stressed" 28 | , evalTest_ "String.repeat 3 \"ha\"" String <| String.repeat 3 "ha" 29 | , evalTest_ "String.indexes \"a\" \"aha\"" (list Int) <| String.indexes "a" "aha" 30 | , evalTest_ "String.indexes \"\" \"aha\"" (list Int) <| String.indexes "" "aha" 31 | ] 32 | 33 | 34 | combiningTests : Test 35 | combiningTests = 36 | describe "Combining Strings" 37 | [ test "uncons non-empty" <| \() -> Expect.equal (Just ( 'a', "bc" )) (String.uncons "abc") 38 | , test "uncons empty" <| \() -> Expect.equal Nothing (String.uncons "") 39 | , test "append 1" <| \() -> Expect.equal "butterfly" (String.append "butter" "fly") 40 | , test "append 2" <| \() -> Expect.equal "butter" (String.append "butter" "") 41 | , test "append 3" <| \() -> Expect.equal "butter" (String.append "" "butter") 42 | , test "concat" <| \() -> Expect.equal "nevertheless" (String.concat [ "never", "the", "less" ]) 43 | , test "split commas" <| \() -> Expect.equal [ "cat", "dog", "cow" ] (String.split "," "cat,dog,cow") 44 | , test "split slashes" <| \() -> Expect.equal [ "home", "steve", "Desktop", "" ] (String.split "/" "home/steve/Desktop/") 45 | , test "join spaces" <| \() -> Expect.equal "cat dog cow" (String.join " " [ "cat", "dog", "cow" ]) 46 | , test "join slashes" <| \() -> Expect.equal "home/steve/Desktop" (String.join "/" [ "home", "steve", "Desktop" ]) 47 | , test "slice 1" <| \() -> Expect.equal "c" (String.slice 2 3 "abcd") 48 | , test "slice 2" <| \() -> Expect.equal "abc" (String.slice 0 3 "abcd") 49 | , test "slice 3" <| \() -> Expect.equal "abc" (String.slice 0 -1 "abcd") 50 | , test "slice 4" <| \() -> Expect.equal "cd" (String.slice -2 4 "abcd") 51 | ] 52 | 53 | 54 | intTests : Test 55 | intTests = 56 | describe "String.toInt" 57 | [ goodInt "1234" 1234 58 | , goodInt "+1234" 1234 59 | , goodInt "-1234" -1234 60 | , badInt "1.34" 61 | , badInt "1e31" 62 | , badInt "123a" 63 | , goodInt "0123" 123 64 | , badInt "0x001A" 65 | , badInt "0x001a" 66 | , badInt "0xBEEF" 67 | , badInt "0x12.0" 68 | , badInt "0x12an" 69 | ] 70 | 71 | 72 | floatTests : Test 73 | floatTests = 74 | describe "String.toFloat" 75 | [ goodFloat "123" 123 76 | , goodFloat "3.14" 3.14 77 | , goodFloat "+3.14" 3.14 78 | , goodFloat "-3.14" -3.14 79 | , goodFloat "0.12" 0.12 80 | , goodFloat ".12" 0.12 81 | , goodFloat "1e-42" 1.0e-42 82 | , goodFloat "6.022e23" 6.022e23 83 | , goodFloat "6.022E23" 6.022e23 84 | , goodFloat "6.022e+23" 6.022e23 85 | , badFloat "6.022e" 86 | , badFloat "6.022n" 87 | , badFloat "6.022.31" 88 | ] 89 | 90 | 91 | encodingTests : Test 92 | encodingTests = 93 | describe "UTF-16 Encoding" 94 | [ test "reverse 1" <| \() -> Expect.equal "𝌆c𝌆b𝌆a𝌆" (String.reverse "𝌆a𝌆b𝌆c𝌆") 95 | , test "reverse 2" <| \() -> Expect.equal "nàm" (String.reverse "màn") 96 | , test "reverse 3" <| \() -> Expect.equal "😣ba" (String.reverse "ab😣") 97 | , test "filter" <| \() -> Expect.equal "mànabc" (String.filter (\c -> c /= '😣') "màn😣abc") 98 | , test "toList" <| \() -> Expect.equal [ '𝌆', 'a', '𝌆', 'b', '𝌆' ] (String.toList "𝌆a𝌆b𝌆") 99 | , test "uncons" <| \() -> Expect.equal (Just ( '😃', "bc" )) (String.uncons "😃bc") 100 | , test "map 1" <| \() -> Expect.equal "aaa" (String.map (\_ -> 'a') "😃😃😃") 101 | , test "map 2" <| \() -> Expect.equal "😃😃😃" (String.map (\_ -> '😃') "aaa") 102 | , test "foldl" <| \() -> Expect.equal 3 (String.foldl (\_ c -> c + 1) 0 "😃😃😃") 103 | , test "foldr" <| \() -> Expect.equal 3 (String.foldr (\_ c -> c + 1) 0 "😃😃😃") 104 | , test "all" <| \() -> Expect.equal True (String.all ((==) '😃') "😃😃😃") 105 | , test "any" <| \() -> Expect.equal True (String.any ((==) '😃') "abc😃123") 106 | ] 107 | 108 | 109 | 110 | -- NUMBER HELPERS 111 | 112 | 113 | goodInt : String -> Int -> Test 114 | goodInt str int = 115 | test str <| 116 | \_ -> 117 | Expect.equal (Just int) (String.toInt str) 118 | 119 | 120 | badInt : String -> Test 121 | badInt str = 122 | test str <| 123 | \_ -> 124 | Expect.equal 125 | Nothing 126 | (String.toInt str) 127 | 128 | 129 | goodFloat : String -> Float -> Test 130 | goodFloat str float = 131 | test str <| 132 | \_ -> 133 | Expect.equal (Just float) (String.toFloat str) 134 | 135 | 136 | badFloat : String -> Test 137 | badFloat str = 138 | test str <| 139 | \_ -> 140 | Expect.equal 141 | Nothing 142 | (String.toFloat str) 143 | -------------------------------------------------------------------------------- /tests/CoreTests/Tuple.elm: -------------------------------------------------------------------------------- 1 | module CoreTests.Tuple exposing (suite) 2 | 3 | import Test exposing (Test, describe) 4 | import TestUtils exposing (evalTest, tuple) 5 | import Types exposing (Value(..)) 6 | 7 | 8 | suite : Test 9 | suite = 10 | describe "Tuple Tests" 11 | [ describe "first" 12 | [ evalTest "extracts first element" 13 | "Tuple.first ( 1, 2 )" 14 | Int 15 | (Tuple.first ( 1, 2 )) 16 | ] 17 | , describe "second" 18 | [ evalTest "extracts second element" 19 | "Tuple.second ( 1, 2 )" 20 | Int 21 | (Tuple.second ( 1, 2 )) 22 | ] 23 | , describe "mapFirst" 24 | [ evalTest "applies function to first element" 25 | "Tuple.mapFirst ((*) 5) ( 1, 1 )" 26 | (tuple Int Int) 27 | (Tuple.mapFirst ((*) 5) ( 1, 1 )) 28 | ] 29 | , describe "mapSecond" 30 | [ evalTest "applies function to second element" 31 | "Tuple.mapSecond ((*) 5) ( 1, 1 )" 32 | (tuple Int Int) 33 | (Tuple.mapSecond ((*) 5) ( 1, 1 )) 34 | ] 35 | ] 36 | -------------------------------------------------------------------------------- /tests/EndToEnd.elm: -------------------------------------------------------------------------------- 1 | module EndToEnd exposing (suite) 2 | 3 | import Elm.Syntax.Expression as Expression 4 | import Eval.Module 5 | import Expect 6 | import Test exposing (Test, describe, test) 7 | import TestUtils exposing (evalTest, evalTest_, list, slowTest) 8 | import Types exposing (Value(..)) 9 | 10 | 11 | suite : Test 12 | suite = 13 | describe "Some end to end tests" 14 | [ helloWorldTest 15 | , sumTest 16 | , fibonacciTest 17 | , recordTest 18 | , customTypeTest 19 | , standardLibraryTest 20 | , tailCallTest 21 | , closureTest 22 | , tooMuchApplyTest 23 | , mutualRecursionTest 24 | , tuplesTest 25 | , negationTest 26 | , kernelTest 27 | , joinTest 28 | , modulesTest 29 | , higherOrderTest 30 | , shadowingTest 31 | ] 32 | 33 | 34 | helloWorldTest : Test 35 | helloWorldTest = 36 | evalTest_ "\"Hello, World\"" String "Hello, World" 37 | 38 | 39 | sumTest : Test 40 | sumTest = 41 | evalTest "2 + 3" "2 + 3" Int 5 42 | 43 | 44 | fibonacciTest : Test 45 | fibonacciTest = 46 | evalTest "Fibonacci" 47 | "let fib n = if n <= 2 then 1 else fib (n - 1) + fib (n - 2) in fib 7" 48 | Int 49 | 13 50 | 51 | 52 | recordTest : Test 53 | recordTest = 54 | evalTest "Record" "{ a = 13, b = 'c'}.b" Char 'c' 55 | 56 | 57 | customTypeTest : Test 58 | customTypeTest = 59 | evalTest "Custom type" 60 | """let 61 | foo = Just [] 62 | in 63 | case foo of 64 | Nothing -> -1 65 | Just [ x ] -> 1 66 | Just [] -> 0 67 | """ 68 | Int 69 | 0 70 | 71 | 72 | standardLibraryTest : Test 73 | standardLibraryTest = 74 | evalTest "Stdlib" 75 | "List.isEmpty [()]" 76 | Bool 77 | False 78 | 79 | 80 | tailCallTest : Test 81 | tailCallTest = 82 | slowTest <| 83 | \i -> 84 | describe "Tail call" 85 | [ evalTest "Inline" 86 | ("let boom x = if x <= 0 then False else boom (x - 1) in boom " ++ String.fromInt i) 87 | Bool 88 | False 89 | , evalTestModule "As module" 90 | ("""module TailCall exposing (boom) 91 | 92 | boom : Int -> Bool 93 | boom x = 94 | let 95 | a = 0 96 | in 97 | if x <= 0 then 98 | False 99 | else 100 | boom (x - 1) 101 | 102 | main : Bool 103 | main = 104 | boom """ ++ String.fromInt i) 105 | Bool 106 | False 107 | ] 108 | 109 | 110 | closureTest : Test 111 | closureTest = 112 | describe "Closures" 113 | [ evalTest "Simple" 114 | "let a = 3 in let closed x = a + x in closed 2" 115 | Int 116 | 5 117 | , evalTest "Recursive" """let 118 | closure = 119 | let 120 | odd x = 121 | x < 0 || even (x - 1) 122 | even x = 123 | x <= 0 || odd (x - 1) 124 | in 125 | odd 126 | in 127 | closure 3""" Bool True 128 | ] 129 | 130 | 131 | tooMuchApplyTest : Test 132 | tooMuchApplyTest = 133 | evalTest "Too much apply" 134 | "(\\a -> Foo a) 0 1 2" 135 | identity 136 | <| 137 | Custom 138 | { moduleName = [ "Main" ], name = "Foo" } 139 | [ Int 0, Int 1, Int 2 ] 140 | 141 | 142 | mutualRecursionTest : Test 143 | mutualRecursionTest = 144 | describe "Mutual recursion" 145 | [ evalTestModule "At the top level" 146 | """module Test exposing (..) 147 | 148 | fib1 n = 149 | if n <= 2 then 150 | 1 151 | else 152 | fib2 (n - 1) + fib2 (n - 2) 153 | 154 | fib2 n = 155 | if n <= 2 then 156 | 1 157 | else 158 | fib1 (n - 1) + fib1 (n - 2) 159 | 160 | main = 161 | fib1 7""" 162 | Int 163 | 13 164 | , evalTest "Inside a let" """let 165 | fib1 n = 166 | if n <= 2 then 167 | 1 168 | else 169 | fib2 (n - 1) + fib2 (n - 2) 170 | 171 | fib2 n = 172 | if n <= 2 then 173 | 1 174 | else 175 | fib1 (n - 1) + fib1 (n - 2) 176 | in 177 | fib1 7""" Int 13 178 | , evalTest "[let] Constant using a function" """let 179 | a = foo 0 180 | foo x = x 181 | in 182 | a 183 | """ Int 0 184 | , evalTest "[let] Constant using a constant before it" """let 185 | a = 0 186 | b = a 187 | in 188 | b 189 | """ Int 0 190 | , evalTest "[let] Constant using a constant after it" """let 191 | a = b 192 | b = 0 193 | in 194 | b 195 | """ Int 0 196 | ] 197 | 198 | 199 | tuplesTest : Test 200 | tuplesTest = 201 | evalTest "Tuples" 202 | """let (a, b) = (2, 3) in let (c, d, e) = (4, 5, 6) in a + b + c + d + e""" 203 | Int 204 | 20 205 | 206 | 207 | negationTest : Test 208 | negationTest = 209 | evalTest_ "-2" Int -2 210 | 211 | 212 | kernelTest : Test 213 | kernelTest = 214 | describe "Kernel" 215 | [ evalTest_ "String.length \"a\"" Int 1 216 | , evalTest_ "Basics.e" Float e 217 | ] 218 | 219 | 220 | joinTest : Test 221 | joinTest = 222 | let 223 | list : List Value 224 | list = 225 | [ String "0" 226 | , String "1" 227 | , String "2" 228 | ] 229 | in 230 | describe "String.join" 231 | [ evalTest_ """["0","1","2"]""" List list 232 | , evalTest_ """String.join "." ["0","1","2"]""" String "0.1.2" 233 | ] 234 | 235 | 236 | modulesTest : Test 237 | modulesTest = 238 | evalTest_ "List.sum [ 1, 2, 3 ]" Int 6 239 | 240 | 241 | higherOrderTest : Test 242 | higherOrderTest = 243 | evalTest_ "String.map Char.toUpper \"Hello, world!\"" String <| 244 | String.map Char.toUpper "Hello, world!" 245 | 246 | 247 | evalTestModule : String -> String -> (a -> Value) -> a -> Test 248 | evalTestModule name expression toValue a = 249 | test name <| 250 | \_ -> 251 | Eval.Module.eval expression (Expression.FunctionOrValue [] "main") 252 | |> Expect.equal (Ok (toValue a)) 253 | 254 | 255 | shadowingTest : Test 256 | shadowingTest = 257 | evalTestModule "shadowing in let/in" """module Temp exposing (main) 258 | 259 | foo : a -> List a -> List a 260 | foo nodes acc = 261 | let 262 | node = 263 | nodes 264 | 265 | newAcc = 266 | node :: acc 267 | in 268 | newAcc 269 | 270 | 271 | main : List (List number) 272 | main = 273 | let 274 | node = 275 | [ 0, 1 ] 276 | in 277 | foo [ 4, 5 ] [ node ]""" (list (list Int)) [ [ 4, 5 ], [ 0, 1 ] ] 278 | -------------------------------------------------------------------------------- /tests/Example.elm.txt: -------------------------------------------------------------------------------- 1 | module Example exposing (main) 2 | 3 | main = 4 | fib 4 5 | 6 | fib n = 7 | if n < 2 then 8 | 1 9 | else 10 | fib (n - 1) + fib (n - 2) 11 | -------------------------------------------------------------------------------- /tests/KernelTests.elm: -------------------------------------------------------------------------------- 1 | module KernelTests exposing (suite) 2 | 3 | import Core 4 | import Elm.Syntax.Expression exposing (Case, CaseBlock, Expression(..), Function, FunctionImplementation, Lambda, LetBlock, LetDeclaration(..), RecordSetter) 5 | import Elm.Syntax.ModuleName exposing (ModuleName) 6 | import Elm.Syntax.Node as Node exposing (Node(..)) 7 | import Eval.Expression 8 | import Expect 9 | import FastDict as Dict 10 | import Kernel 11 | import Rope exposing (Rope) 12 | import Syntax 13 | import Test exposing (Test, describe, test) 14 | 15 | 16 | suite : Test 17 | suite = 18 | kernelFunctions 19 | |> List.map testDefined 20 | |> describe "Check that all Kernel functions have been defined" 21 | 22 | 23 | kernelFunctions : List ( ( ModuleName, String ), List String ) 24 | kernelFunctions = 25 | Core.functions 26 | |> Dict.values 27 | |> Rope.fromList 28 | |> Rope.concatMap (\module_ -> Dict.values module_ |> Rope.fromList) 29 | |> Rope.concatMap 30 | (\function -> 31 | let 32 | (Node _ name) = 33 | function.name 34 | in 35 | visitFunctionImplementation function 36 | |> Rope.map (\required -> ( required, name )) 37 | ) 38 | |> Rope.toList 39 | |> List.foldl 40 | (\( required, by ) acc -> 41 | Dict.insert 42 | required 43 | (by :: Maybe.withDefault [] (Dict.get required acc)) 44 | acc 45 | ) 46 | Dict.empty 47 | |> Dict.toList 48 | 49 | 50 | visitFunctionImplementation : FunctionImplementation -> Rope ( ModuleName, String ) 51 | visitFunctionImplementation { expression } = 52 | visitExpression expression 53 | 54 | 55 | visitExpression : Node Expression -> Rope ( ModuleName, String ) 56 | visitExpression (Node _ expression) = 57 | case expression of 58 | Application children -> 59 | Rope.fromList children 60 | |> Rope.concatMap visitExpression 61 | 62 | OperatorApplication _ _ l r -> 63 | Rope.fromList [ l, r ] 64 | |> Rope.concatMap visitExpression 65 | 66 | FunctionOrValue ("Elm" :: "Kernel" :: "Scheduler" :: _) _ -> 67 | Rope.empty 68 | 69 | FunctionOrValue ("Elm" :: "Kernel" :: "Platform" :: _) _ -> 70 | Rope.empty 71 | 72 | FunctionOrValue ("Elm" :: "Kernel" :: "Process" :: _) _ -> 73 | Rope.empty 74 | 75 | FunctionOrValue (("Elm" :: "Kernel" :: _) as moduleName) name -> 76 | Rope.singleton ( moduleName, name ) 77 | 78 | IfBlock cond true false -> 79 | Rope.fromList [ cond, true, false ] 80 | |> Rope.concatMap visitExpression 81 | 82 | Negation child -> 83 | visitExpression child 84 | 85 | TupledExpression children -> 86 | Rope.fromList children 87 | |> Rope.concatMap visitExpression 88 | 89 | ParenthesizedExpression child -> 90 | visitExpression child 91 | 92 | LetExpression letBlock -> 93 | visitLetBlock letBlock 94 | 95 | CaseExpression caseBlock -> 96 | visitCaseBlock caseBlock 97 | 98 | LambdaExpression lambda -> 99 | visitLambda lambda 100 | 101 | RecordExpr setters -> 102 | setters 103 | |> Rope.fromList 104 | |> Rope.concatMap visitRecordSetter 105 | 106 | ListExpr children -> 107 | Rope.fromList children 108 | |> Rope.concatMap visitExpression 109 | 110 | RecordAccess child _ -> 111 | visitExpression child 112 | 113 | RecordUpdateExpression _ setters -> 114 | setters 115 | |> Rope.fromList 116 | |> Rope.concatMap visitRecordSetter 117 | 118 | _ -> 119 | Rope.empty 120 | 121 | 122 | visitLambda : Lambda -> Rope ( ModuleName, String ) 123 | visitLambda { expression } = 124 | visitExpression expression 125 | 126 | 127 | visitRecordSetter : Node RecordSetter -> Rope ( ModuleName, String ) 128 | visitRecordSetter (Node _ ( _, expression )) = 129 | visitExpression expression 130 | 131 | 132 | visitCaseBlock : CaseBlock -> Rope ( ModuleName, String ) 133 | visitCaseBlock { expression, cases } = 134 | cases 135 | |> Rope.fromList 136 | |> Rope.concatMap visitCase 137 | |> Rope.appendTo (visitExpression expression) 138 | 139 | 140 | visitCase : Case -> Rope ( ModuleName, String ) 141 | visitCase ( _, expression ) = 142 | visitExpression expression 143 | 144 | 145 | visitLetBlock : LetBlock -> Rope ( ModuleName, String ) 146 | visitLetBlock { declarations, expression } = 147 | declarations 148 | |> Rope.fromList 149 | |> Rope.concatMap visitDeclaration 150 | |> Rope.appendTo (visitExpression expression) 151 | 152 | 153 | visitDeclaration : Node LetDeclaration -> Rope ( ModuleName, String ) 154 | visitDeclaration (Node _ letDeclaration) = 155 | case letDeclaration of 156 | LetFunction function -> 157 | visitFunction function 158 | 159 | LetDestructuring _ child -> 160 | visitExpression child 161 | 162 | 163 | visitFunction : Function -> Rope ( ModuleName, String ) 164 | visitFunction { declaration } = 165 | visitFunctionImplementation (Node.value declaration) 166 | 167 | 168 | testDefined : ( ( ModuleName, String ), List String ) -> Test 169 | testDefined ( ( moduleName, name ), requiredBy ) = 170 | case Dict.get moduleName (Kernel.functions Eval.Expression.evalFunction) of 171 | Just kernelModule -> 172 | if Dict.member name kernelModule then 173 | let 174 | fullName : String 175 | fullName = 176 | Syntax.qualifiedNameToString 177 | { moduleName = moduleName 178 | , name = name 179 | } 180 | in 181 | test fullName <| 182 | \_ -> Expect.pass 183 | 184 | else 185 | trySearchingElmCoded moduleName requiredBy name 186 | 187 | Nothing -> 188 | trySearchingElmCoded moduleName requiredBy name 189 | 190 | 191 | trySearchingElmCoded : ModuleName -> List String -> String -> Test 192 | trySearchingElmCoded moduleName requiredBy name = 193 | let 194 | fullName : String 195 | fullName = 196 | Syntax.qualifiedNameToString 197 | { moduleName = moduleName 198 | , name = name 199 | } 200 | in 201 | case Dict.get moduleName Core.functions of 202 | Nothing -> 203 | error fullName requiredBy 204 | 205 | Just kernelModule -> 206 | if Dict.member name kernelModule then 207 | test fullName <| 208 | \_ -> Expect.pass 209 | 210 | else 211 | error fullName requiredBy 212 | 213 | 214 | error : String -> List String -> Test 215 | error fullName requiredBy = 216 | Test.todo 217 | (fullName 218 | ++ " is not defined, but it's required by " 219 | ++ String.join ", " requiredBy 220 | ) 221 | -------------------------------------------------------------------------------- /tests/TestUtils.elm: -------------------------------------------------------------------------------- 1 | module TestUtils exposing (evalExpect, evalTest, evalTest_, list, maybe, result, slowTest, tuple, withInt) 2 | 3 | import Eval 4 | import Expect 5 | import Syntax 6 | import Test exposing (Test, test) 7 | import Types exposing (Error(..), Value(..)) 8 | 9 | 10 | evalTest_ : String -> (a -> Value) -> a -> Test 11 | evalTest_ expr toValue a = 12 | evalTest expr expr toValue a 13 | 14 | 15 | evalTest : String -> String -> (a -> Value) -> a -> Test 16 | evalTest name expression toValue a = 17 | test name <| 18 | \_ -> 19 | evalExpect expression toValue a 20 | 21 | 22 | evalExpect : String -> (a -> Value) -> a -> Expect.Expectation 23 | evalExpect expression toValue a = 24 | let 25 | res : Value 26 | res = 27 | toValue a 28 | in 29 | case ( Eval.eval expression, res ) of 30 | ( Ok (Int i), Float _ ) -> 31 | (Float <| toFloat i) 32 | |> Expect.equal res 33 | 34 | ( Err (EvalError e), _ ) -> 35 | Expect.fail <| 36 | Debug.toString e.error 37 | ++ "\nCall stack:\n - " 38 | ++ String.join 39 | "\n - " 40 | (List.reverse <| List.map Syntax.qualifiedNameToString e.callStack) 41 | 42 | ( Err e, _ ) -> 43 | Expect.fail <| Debug.toString e 44 | 45 | ( v, _ ) -> 46 | v |> Expect.equal (Ok res) 47 | 48 | 49 | slowTest : (Int -> Test) -> Test 50 | slowTest test = 51 | -- Change this to 10 to make it fast 52 | test 10 53 | 54 | 55 | tuple : (a -> Value) -> (b -> Value) -> ( a, b ) -> Value 56 | tuple lf rf ( l, r ) = 57 | Tuple (lf l) (rf r) 58 | 59 | 60 | list : (a -> Value) -> List a -> Value 61 | list f xs = 62 | List (List.map f xs) 63 | 64 | 65 | maybe : (a -> Value) -> Maybe a -> Value 66 | maybe f mx = 67 | case mx of 68 | Nothing -> 69 | Custom { moduleName = [ "Maybe" ], name = "Nothing" } [] 70 | 71 | Just x -> 72 | Custom { moduleName = [ "Maybe" ], name = "Just" } [ f x ] 73 | 74 | 75 | result : (e -> Value) -> (x -> Value) -> Result e x -> Value 76 | result ef xf rx = 77 | case rx of 78 | Err e -> 79 | Custom { moduleName = [ "Result" ], name = "Err" } [ ef e ] 80 | 81 | Ok x -> 82 | Custom { moduleName = [ "Result" ], name = "Ok" } [ xf x ] 83 | 84 | 85 | withInt : String -> Int -> String -> String 86 | withInt name value code = 87 | "let " ++ name ++ " = " ++ String.fromInt value ++ " in " ++ code 88 | -------------------------------------------------------------------------------- /tests/TopologicalSortTests.elm: -------------------------------------------------------------------------------- 1 | module TopologicalSortTests exposing (suite) 2 | 3 | import Expect 4 | import FastDict as Dict exposing (Dict) 5 | import Set 6 | import Test exposing (Test, describe, test) 7 | import TopologicalSort 8 | 9 | 10 | suite : Test 11 | suite = 12 | describe "Tests for TopologicalSort" 13 | [ acyclicGraphTest 14 | , cyclicGraphTest 15 | ] 16 | 17 | 18 | acyclicGraphTest : Test 19 | acyclicGraphTest = 20 | describe "Acyclic graph" 21 | [ sortTest "Linear graph" 22 | [ ( "a", "b" ), ( "b", "c" ), ( "c", "" ) ] 23 | (Ok [ "a", "b", "c" ]) 24 | , sortTest "Unconnected nodes" 25 | [ ( "a", "b" ), ( "b", "c" ), ( "c", "" ), ( "d", "a" ), ( "e", "c" ), ( "f", "" ) ] 26 | (Ok [ "d", "a", "b", "e", "c", "f" ]) 27 | , sortTest "No shortcuts" 28 | [ ( "a", "bcd" ), ( "b", "cd" ), ( "c", "d" ), ( "d", "" ) ] 29 | (Ok [ "a", "b", "c", "d" ]) 30 | , sortTest "No doubles" 31 | [ ( "a", "bc" ), ( "b", "d" ), ( "cd", "e" ), ( "e", "" ) ] 32 | (Ok [ "a", "b", "cd", "e" ]) 33 | , sortTest "With functions" 34 | [ ( "a", "b" ), ( "b()", "c" ), ( "c()", "d" ), ( "d", "" ) ] 35 | (Ok [ "a", "b()", "c()", "d" ]) 36 | ] 37 | 38 | 39 | cyclicGraphTest : Test 40 | cyclicGraphTest = 41 | describe "Cyclic graph" 42 | [ sortTest "Mutually recursive" 43 | [ ( "a()", "b" ), ( "b()", "a" ) ] 44 | (Ok [ "b()", "a()" ]) 45 | , sortTest "Larger cycle" 46 | [ ( "a()", "b" ), ( "b()", "c" ), ( "c()", "d" ), ( "d()", "e" ), ( "e()", "a" ) ] 47 | (Ok [ "e()", "a()", "b()", "c()", "d()" ]) 48 | , sortTest "With dependencies" 49 | [ ( "a", "b" ), ( "b()", "ce" ), ( "c()", "df" ), ( "d()", "be" ), ( "e", "" ), ( "f", "" ) ] 50 | (Ok [ "a", "d()", "b()", "c()", "e", "f" ]) 51 | , sortTest "Line of cycles" 52 | [ ( "a", "b" ), ( "b()", "cd" ), ( "c()", "b" ), ( "d", "e" ), ( "e()", "f" ), ( "f()", "eg" ), ( "g", "" ) ] 53 | (Ok [ "a", "c()", "b()", "d", "f()", "e()", "g" ]) 54 | , sortTest "Connected cycles" 55 | (let 56 | -- to avoid warnings about concatenating list literals 57 | emptyList : List a 58 | emptyList = 59 | [] 60 | in 61 | [ ( "a", "b" ), ( "b()", "ce" ), ( "c()", "bd" ), ( "d", "" ) ] 62 | ++ emptyList 63 | ++ [ ( "e()", "f" ), ( "f()", "gi" ), ( "g()", "hj" ), ( "h()", "b" ), ( "i", "" ) ] 64 | ++ emptyList 65 | ++ [ ( "j()", "gk" ), ( "k", "" ) ] 66 | ) 67 | (Ok [ "a", "j()", "g()", "h()", "b()", "e()", "f()", "i", "c()", "d", "k" ]) 68 | , sortTest "Illegal cycle" 69 | [ ( "a()", "b" ), ( "b", "c" ), ( "c()", "a" ) ] 70 | (Err TopologicalSort.IllegalCycle) 71 | ] 72 | 73 | 74 | sortTest : String -> List ( String, String ) -> Result TopologicalSort.SortError (List String) -> Test 75 | sortTest name graph result = 76 | test name <| 77 | \_ -> 78 | let 79 | nodes : Dict String ( Int, String ) 80 | nodes = 81 | graph 82 | |> List.indexedMap (\i ( n, r ) -> ( n, ( i + 1, r ) )) 83 | |> Dict.fromList 84 | in 85 | TopologicalSort.sort 86 | { id = \n -> Dict.get n nodes |> Maybe.map Tuple.first |> Maybe.withDefault -1 87 | , defVars = String.toList >> Set.fromList >> Set.remove '(' >> Set.remove ')' 88 | , refVars = \n -> Dict.get n nodes |> Maybe.map (Tuple.second >> String.toList) |> Maybe.withDefault [] |> Set.fromList 89 | , cycleAllowed = String.endsWith "()" 90 | } 91 | (Dict.keys nodes) 92 | |> Expect.equal result 93 | --------------------------------------------------------------------------------