Merge pull request #20 from Zokka-Dev/fix-occurs-check-bug

Fix occurs check bug

.github/workflows/haskell.yml

@@ -69,6 +69,9 @@ jobs:
  - name: Run elm-test-rs tests
  run: python3 run-test-rs-tests.py
 
+ - name: Run compiler-output tests
+ run: python3 run-compiler-output-tests.py
+
  - name: Upload Artifacts
  uses: actions/upload-artifact@v4
  with:

.github/workflows/release.yml

@@ -63,6 +63,9 @@ jobs:
  - name: Run elm-test-rs tests
  run: python3 run-test-rs-tests.py
 
+ - name: Run compiler-output tests
+ run: python3 run-compiler-output-tests.py
+
  # Extract the current git tag
  - name: Extract Git Tag
  id: get_version

compiler-output-tests/elm.json

@@ -0,0 +1,25 @@
+{
+ "type": "application",
+ "source-directories": [
+ "src"
+ ],
+ "elm-version": "0.19.1",
+ "dependencies": {
+ "direct": {
+ "elm/browser": "1.0.2",
+ "elm/core": "1.0.5",
+ "elm/html": "1.0.0"
+ },
+ "indirect": {
+ "elm/json": "1.1.3",
+ "elm/time": "1.0.0",
+ "elm/url": "1.0.0",
+ "elm/virtual-dom": "1.0.3"
+ }
+ },
+ "test-dependencies": {
+ "direct": {},
+ "indirect": {}
+ },
+ "zokka-package-overrides": []
+}

compiler-output-tests/src/BadOccursCheck.elm

@@ -0,0 +1,12 @@
+module BadOccursCheck exposing (..)
+
+-- https://github.com/elm/compiler/issues/2241
+
+foldMap : (a -> b) -> (a -> c) -> (b -> c -> c) -> a -> c
+foldMap fab fac fbc a = fac a
+
+f : a -> a -> a
+f x y = x
+
+break : Float -> (Float, Float)
+break input = foldMap identity (\x -> (x, x)) (\( low, high ) x -> ( f low x, f high x )) input

compiler-output-tests/src/BadOccursCheck1.elm

@@ -0,0 +1,40 @@
+module BadOccursCheck1 exposing (..)
+-- From an error that showed up on incremental-elm Slack
+
+-- This file will cause the vanilla Elm compiler to hang when compiling.
+
+type Effect msg = Effect
+
+type Msg = Msg1 Int | Msg2 Int
+
+-- All our functions will be infinite loops since this is only meant to test
+-- type checking and we don't care about any runtime stuff
+-- We won't use Debug.todo just in case we want to double-check that all of
+-- this works fine when we run `--optimize` (although presently I can't
+-- think of any reason why --optimize would change anything WRT
+-- typechecking, but just in case!)
+applyIf : Bool -> (a -> a) -> a -> a
+applyIf x = applyIf x
+
+update : model -> ( model, Effect msg )
+update x = update x
+
+withQuery : (data -> msg) -> Effect msg -> ( model, Effect msg ) -> ( model, Effect msg )
+withQuery f = withQuery f
+
+-- A nice hack to get us values without resorting to Debug.todo
+-- Can't just directly do x = x because the Elm compiler detects that
+makeAnything : a -> b
+makeAnything x = makeAnything x
+
+query1 = makeAnything ()
+
+query2 = makeAnything ()
+
+model = makeAnything ()
+
+result condition =
+ model
+ |> update
+ |> applyIf condition withQuery Msg1 query1
+ |> applyIf condition withQuery Msg1 query2

compiler/src/Generate/JavaScript.hs

@@ -30,7 +30,6 @@ import qualified Generate.Mode as Mode
 import qualified Reporting.Doc as D
 import qualified Reporting.Render.Type as RT
 import qualified Reporting.Render.Type.Localizer as L
-import qualified Debug.Trace as Debug
 import Control.Exception (Exception, throw)
 import qualified Elm.Package as Pkg
 import qualified Data.Maybe as Maybe

compiler/src/Generate/JavaScript/Expression.hs

@@ -36,7 +36,6 @@ import qualified Json.Encode as Encode
 import Json.Encode ((==>))
 import qualified Optimize.DecisionTree as DT
 import qualified Reporting.Annotation as A
-import qualified Debug.Trace as Debug
 
 
 

compiler/src/Type/Unify.hs

@@ -166,15 +166,33 @@ fresh (Context _ (Descriptor _ rank1 _ _) _ (Descriptor _ rank2 _ _)) content =
 guardedUnify :: Variable -> Variable -> Unify ()
 guardedUnify left right =
  Unify $ \vars ok err ->
- do equivalent <- UF.equivalent left right
- if equivalent
- then ok vars ()
+ do -- It might be possible to actually just do == instead of >. This is
+ -- because it might be the case that if a variable is not infinite
+ -- right now, it won't ever be infinite during this particular unify
+ -- call. But I haven't really thought that through enough to be
+ -- confident putting it in.
+ --
+ -- Note that we ultimately decided against doing a recursion depth check
+ -- as detailed in
+ -- https://github.com/Zokka-Dev/zokka-compiler/pull/20#issuecomment-2234089482
+ -- This is because we didn't want to have an unpredictable performance
+ -- profile (i.e. mysterious immediate slowdown).
+ -- If we see slowdown we want to know soon so that we can think about a
+ -- better fix. So far benchmarks seem to show that this causes minimal slowdown.
+ occursLeft <- Occurs.occurs left
+ occursRight <- Occurs.occurs right
+ equivalent <- UF.equivalent left right
+ if occursLeft || occursRight
+ then err vars ()
  else
- do leftDesc <- UF.get left
- rightDesc <- UF.get right
- case actuallyUnify (Context left leftDesc right rightDesc) of
- Unify k ->
- k vars ok err
+ if equivalent
+ then ok vars ()
+ else
+ do leftDesc <- UF.get left
+ rightDesc <- UF.get right
+ case actuallyUnify (Context left leftDesc right rightDesc) of
+ Unify k ->
+ k vars ok err
 
 
 subUnify :: Variable -> Variable -> Unify ()

elm-test-rs-tests/tests/Tests.elm

@@ -12,7 +12,7 @@ import TCOMiscompilation4 exposing (tcoMiscompilation4Test0, tcoMiscompilation4T
 
 
 suite : Test
-suite = describe "TCO tests" 
+suite = describe "All tests" 
  [ anotherBadClosureTest
  , tcoProducesBadClosuresTest
  , tcoMiscompilation0Test

run-compiler-output-tests.py

@@ -0,0 +1,40 @@
+import subprocess
+import os
+import timeit
+
+def run_zokka_make(zokka_cmd, file_to_make, project_dir):
+ return subprocess.run([zokka_cmd, "make", file_to_make], cwd=project_dir)
+
+if __name__ == "__main__":
+
+ start_time = timeit.default_timer()
+
+ find_zokka_cmd = ["cabal", "list-bin", "zokka"]
+
+
+ zokka_exec_location = \
+ subprocess.run(find_zokka_cmd, capture_output=True).stdout.strip()
+
+ run_zokka_make_cmd = [zokka_exec_location, ]
+
+ current_dir = "."
+
+ top_level_tests_dir = os.path.join(current_dir, "compiler-output-tests")
+
+ print(f"=========\nRunning compiler-output tests found in {top_level_tests_dir}\n=========\n")
+
+ bad_occurs_check_test_0 =\
+ run_zokka_make(zokka_exec_location, os.path.join("src", "BadOccursCheck.elm"), top_level_tests_dir)
+
+ if bad_occurs_check_test_0.returncode == 0:
+ raise Exception("Our bad occurs check failed! The compiler succeeded when it should have failed!")
+
+ bad_occurs_check_test_1 =\
+ run_zokka_make(zokka_exec_location, os.path.join("src", "BadOccursCheck1.elm"), top_level_tests_dir)
+
+ if bad_occurs_check_test_1.returncode == 0:
+ raise Exception("Our bad occurs check failed! The compiler succeeded when it should have failed!")
+
+ total_test_duration = timeit.default_timer() - start_time
+
+ print(f"=========\nTotal test duration: {total_test_duration} seconds\n=========\n")