Repository: luc-tielen/eclair-lang
Branch: main
Commit: 5254a56ef14e
Files: 183
Total size: 857.3 KB
Directory structure:
gitextract_d5o1d0tz/
├── .dockerignore
├── .ghci
├── .github/
│ ├── FUNDING.yml
│ └── workflows/
│ ├── build.yml
│ └── ci.yml
├── .gitignore
├── .hlint.yaml
├── CHANGELOG.md
├── CODE_OF_CONDUCT.md
├── Dockerfile
├── LICENSE
├── Makefile
├── README.md
├── cabal.project
├── cbits/
│ └── semantic_analysis.dl
├── docs/
│ ├── architecture_choices.md
│ └── getting_started.md
├── eclair-lang.cabal
├── hie.yaml
├── lib/
│ ├── Eclair/
│ │ ├── AST/
│ │ │ ├── Analysis.hs
│ │ │ ├── Codegen.hs
│ │ │ ├── IR.hs
│ │ │ ├── Lower.hs
│ │ │ ├── Transforms/
│ │ │ │ ├── ConstantFolding.hs
│ │ │ │ ├── DeadCodeElimination.hs
│ │ │ │ ├── NormalizeRules.hs
│ │ │ │ ├── RemoveAliases.hs
│ │ │ │ └── ReplaceStrings.hs
│ │ │ └── Transforms.hs
│ │ ├── ArgParser.hs
│ │ ├── Common/
│ │ │ ├── Config.hs
│ │ │ ├── Extern.hs
│ │ │ ├── Id.hs
│ │ │ ├── Literal.hs
│ │ │ ├── Location.hs
│ │ │ ├── Operator.hs
│ │ │ └── Pretty.hs
│ │ ├── Comonads.hs
│ │ ├── EIR/
│ │ │ ├── IR.hs
│ │ │ ├── Lower/
│ │ │ │ ├── API.hs
│ │ │ │ ├── Codegen.hs
│ │ │ │ └── Externals.hs
│ │ │ └── Lower.hs
│ │ ├── Error.hs
│ │ ├── JSON.hs
│ │ ├── LLVM/
│ │ │ ├── Allocator/
│ │ │ │ ├── Arena.hs
│ │ │ │ ├── Common.hs
│ │ │ │ ├── Malloc.hs
│ │ │ │ └── Page.hs
│ │ │ ├── BTree/
│ │ │ │ ├── Bounds.hs
│ │ │ │ ├── Compare.hs
│ │ │ │ ├── Create.hs
│ │ │ │ ├── Destroy.hs
│ │ │ │ ├── Find.hs
│ │ │ │ ├── Insert.hs
│ │ │ │ ├── Iterator.hs
│ │ │ │ ├── Size.hs
│ │ │ │ └── Types.hs
│ │ │ ├── BTree.hs
│ │ │ ├── Codegen.hs
│ │ │ ├── Config.hs
│ │ │ ├── Externals.hs
│ │ │ ├── Hash.hs
│ │ │ ├── HashMap.hs
│ │ │ ├── Metadata.hs
│ │ │ ├── Symbol.hs
│ │ │ ├── SymbolTable.hs
│ │ │ ├── Table.hs
│ │ │ ├── Template.hs
│ │ │ └── Vector.hs
│ │ ├── LSP/
│ │ │ ├── Handlers/
│ │ │ │ ├── Diagnostics.hs
│ │ │ │ ├── DocumentHighlight.hs
│ │ │ │ └── Hover.hs
│ │ │ ├── Handlers.hs
│ │ │ ├── JSON.hs
│ │ │ ├── Monad.hs
│ │ │ ├── Types.hs
│ │ │ └── VFS.hs
│ │ ├── LSP.hs
│ │ ├── Parser.hs
│ │ ├── RA/
│ │ │ ├── Codegen.hs
│ │ │ ├── IR.hs
│ │ │ ├── IndexSelection.hs
│ │ │ ├── Lower.hs
│ │ │ ├── Transforms/
│ │ │ │ └── HoistConstraints.hs
│ │ │ └── Transforms.hs
│ │ ├── Souffle/
│ │ │ └── IR.hs
│ │ ├── Transform.hs
│ │ └── TypeSystem.hs
│ ├── Eclair.hs
│ └── Prelude.hs
├── src/
│ └── eclair/
│ └── Main.hs
└── tests/
├── .gitignore
├── ast_transforms/
│ ├── constant_folding.eclair
│ ├── copy_propagation.eclair
│ ├── dead_code_elimination.eclair
│ ├── remove_contradictions.eclair
│ └── shift_assignments.eclair
├── check.sh
├── eclair/
│ ├── Test/
│ │ └── Eclair/
│ │ ├── ArgParserSpec.hs
│ │ ├── JSONSpec.hs
│ │ ├── LLVM/
│ │ │ ├── Allocator/
│ │ │ │ ├── MallocSpec.hs
│ │ │ │ ├── PageSpec.hs
│ │ │ │ └── Utils.hs
│ │ │ ├── BTreeSpec.hs
│ │ │ ├── HashMapSpec.hs
│ │ │ ├── HashSpec.hs
│ │ │ ├── SymbolSpec.hs
│ │ │ ├── SymbolTableSpec.hs
│ │ │ ├── SymbolUtils.hs
│ │ │ └── VectorSpec.hs
│ │ ├── LSP/
│ │ │ ├── HandlersSpec.hs
│ │ │ └── JSONSpec.hs
│ │ └── RA/
│ │ └── IndexSelectionSpec.hs
│ ├── fixtures/
│ │ └── lsp/
│ │ ├── document_highlight.eclair
│ │ ├── hover.eclair
│ │ ├── invalid_syntax.eclair
│ │ ├── semantic_errors.eclair
│ │ ├── type_errors.eclair
│ │ └── unparsable.eclair
│ └── test.hs
├── end_to_end/
│ ├── compile_and_run_native.eclair
│ ├── compile_and_run_wasm.eclair
│ └── compile_and_run_with_extern.eclair
├── hello.eclair
├── lit.cfg
├── lowering/
│ ├── arithmetic.eclair
│ ├── clause_with_same_vars.eclair
│ ├── comparisons.eclair
│ ├── different_types.eclair
│ ├── extern_definitions.eclair
│ ├── multiple_clauses_same_name.eclair
│ ├── multiple_rule_clauses.eclair
│ ├── mutually_recursive_rules.eclair
│ ├── negation.eclair
│ ├── negation_with_wildcards.eclair
│ ├── no_top_level_facts.eclair
│ ├── recursive_mix_of_rules.eclair
│ ├── single_non_recursive_rule.eclair
│ ├── single_recursive_rule.eclair
│ ├── stratification.eclair
│ ├── top_level_facts.eclair
│ └── wasm_codegen.eclair
├── parser/
│ ├── error_recovery.eclair
│ ├── file_not_found.eclair
│ └── valid.eclair
├── runtime/
│ ├── hashmap_test.eclair
│ ├── symbol_table_test.eclair
│ └── vector_test.eclair
├── semantic_analysis/
│ ├── cyclic_negation.eclair
│ ├── dead_internal_relation.eclair
│ ├── invalid_extern_usage.eclair
│ ├── invalid_options_usage.eclair
│ ├── invalid_wildcard_usage.eclair
│ ├── no_output_relations.eclair
│ ├── unconstrained_variables.eclair
│ ├── ungrounded_variables.eclair
│ ├── ungrounded_variables_arithmetic.eclair
│ ├── ungrounded_variables_comparisons.eclair
│ └── ungrounded_variables_negations.eclair
├── string_support/
│ ├── encode_decode_string.eclair
│ ├── encode_decode_string_native.eclair
│ └── encode_decode_string_wasm.eclair
├── transpilation/
│ └── souffle.eclair
├── typesystem/
│ ├── arg_count_mismatch.eclair
│ ├── arithmetic.eclair
│ ├── comparisons.eclair
│ ├── duplicate_type_declarations.eclair
│ ├── extern_definitions.eclair
│ ├── negation.eclair
│ ├── no_rules_for_type.eclair
│ ├── type_mismatch_in_rule.eclair
│ ├── type_mismatch_in_rule_body.eclair
│ ├── type_mismatch_in_rule_head.eclair
│ ├── type_mismatch_top_level_atoms.eclair
│ ├── typed_holes.eclair
│ ├── unification_failure.eclair
│ ├── unknown_atom_in_rule_body.eclair
│ ├── unknown_atom_in_rule_head.eclair
│ ├── unknown_atoms.eclair
│ ├── unknown_top_level_atoms.eclair
│ └── valid.eclair
└── utils/
└── extract_snippet
================================================
FILE CONTENTS
================================================
================================================
FILE: .dockerignore
================================================
.direnv/
.git/
.github/
dist/
dist-newstyle/
result/
Dockerfile
.dockerignore
.envrc
.ghci
.gitignore
./*.ll
./*.o
./*.a
./*.wasm
./*.eclair
./*.dl
./logo*
hie.yaml
================================================
FILE: .ghci
================================================
:set prompt >
================================================
FILE: .github/FUNDING.yml
================================================
github: luc-tielen
================================================
FILE: .github/workflows/build.yml
================================================
name: "Build"
on: [push, pull_request]
jobs:
build:
strategy:
matrix:
os: [ubuntu-latest]
runs-on: ${{matrix.os}}
steps:
- uses: actions/checkout@v3
- name: Build and test
run: |
set -eo pipefail
export TIMESTAMP=$(date +%s)
docker build -f Dockerfile . -t eclair:$TIMESTAMP | tee eclair-lang-${{matrix.os}}.log
docker run --rm eclair:$TIMESTAMP bash -c "make test" | tee -a eclair-lang-${{matrix.os}}.log
- name: Check for disabled tests
run: |
./tests/check.sh
- name: Upload logs
if: ${{ always() }}
uses: actions/upload-artifact@v3
with:
name: eclair-lang-${{matrix.os}}.log
path: eclair-lang-${{matrix.os}}.log
================================================
FILE: .github/workflows/ci.yml
================================================
name: lint
on:
pull_request:
push:
branches:
- main
- "releases/*"
jobs:
hlint:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v3
- name: "Set up HLint"
uses: rwe/actions-hlint-setup@v1
with:
version: "3.6.1"
- name: "Run HLint"
uses: rwe/actions-hlint-run@v2
with:
path: '["lib/", "src/", "tests/"]'
fail-on: warning
================================================
FILE: .gitignore
================================================
dist-newstyle/
dist/
.direnv/
.devcontainer/
cabal.project.local*
*.ll
*.bc
*.o
*.a
*.s
/*.wasm
/*.dl
/*.eclair
/*.js
result
eclair.prof
eclair.svg
*.eventlog*
eclair.hp
perf.data
perf.data.old
perf.svg
TODO*
================================================
FILE: .hlint.yaml
================================================
# HLint configuration file
# https://github.com/ndmitchell/hlint
##########################
# This file contains a template configuration file, which is typically
# placed as .hlint.yaml in the root of your project
# Specify additional command line arguments
#
# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
# Control which extensions/flags/modules/functions can be used
#
# - extensions:
# - default: false # all extension are banned by default
# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
#
# - flags:
# - {name: -w, within: []} # -w is allowed nowhere
#
# - modules:
# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
# - {name: Control.Arrow, within: []} # Certain modules are banned entirely
#
# - functions:
# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
- arguments:
- "-XRecursiveDo"
# Add custom hints for this project
#
# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
# The hints are named by the string they display in warning messages.
# For example, if you see a warning starting like
#
# Main.hs:116:51: Warning: Redundant ==
#
# You can refer to that hint with `{name: Redundant ==}` (see below).
# Turn on hints that are off by default
#
# Ban "module X(module X) where", to require a real export list
# - warn: {name: Use explicit module export list}
#
# Replace a $ b $ c with a . b $ c
# - group: {name: dollar, enabled: true}
#
# Generalise map to fmap, ++ to <>
# - group: {name: generalise, enabled: true}
# Ignore some builtin hints
# - ignore: {name: Use let}
# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
- ignore: {name: Reduce duplication}
# Define some custom infix operators
# - fixity: infixr 3 ~^#^~
# To generate a suitable file for HLint do:
# $ hlint --default > .hlint.yaml
# Relude-specific (https://github.com/kowainik/relude/blob/main/.hlint.yaml)
- arguments:
- "-XConstraintKinds"
- "-XDeriveGeneric"
- "-XGeneralizedNewtypeDeriving"
- "-XLambdaCase"
- "-XOverloadedStrings"
- "-XRecordWildCards"
- "-XScopedTypeVariables"
- "-XStandaloneDeriving"
- "-XTupleSections"
- "-XTypeApplications"
- "-XViewPatterns"
- ignore:
name: Use head
- ignore:
name: Use Foldable.forM_
- hint:
lhs: "pure ()"
note: "Use 'pass'"
rhs: pass
- hint:
lhs: "return ()"
note: "Use 'pass'"
rhs: pass
- hint:
lhs: "(: [])"
note: "Use `one`"
rhs: one
- hint:
lhs: "(:| [])"
note: "Use `one`"
rhs: one
- hint:
lhs: Data.Sequence.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.Text.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.Text.Lazy.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.ByteString.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.ByteString.Lazy.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.Map.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.Map.Strict.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.HashMap.Strict.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.HashMap.Lazy.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.IntMap.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.IntMap.Strict.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.Set.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.HashSet.singleton
note: "Use `one`"
rhs: one
- hint:
lhs: Data.IntSet.singleton
note: "Use `one`"
rhs: one
- warn:
lhs: Control.Exception.evaluate
rhs: evaluateWHNF
- warn:
lhs: "Control.Exception.evaluate (force x)"
rhs: evaluateNF x
- warn:
lhs: "Control.Exception.evaluate (x `deepseq` ())"
rhs: evaluateNF_ x
- warn:
lhs: "void (evaluateWHNF x)"
rhs: evaluateWHNF_ x
- warn:
lhs: "void (evaluateNF x)"
rhs: evaluateNF_ x
- hint:
lhs: Control.Exception.throw
note: "Use 'impureThrow'"
rhs: impureThrow
- warn:
lhs: Data.Text.IO.readFile
rhs: readFileText
- warn:
lhs: Data.Text.IO.writeFile
rhs: writeFileText
- warn:
lhs: Data.Text.IO.appendFile
rhs: appendFileText
- warn:
lhs: Data.Text.Lazy.IO.readFile
rhs: readFileLText
- warn:
lhs: Data.Text.Lazy.IO.writeFile
rhs: writeFileLText
- warn:
lhs: Data.Text.Lazy.IO.appendFile
rhs: appendFileLText
- warn:
lhs: Data.ByteString.readFile
rhs: readFileBS
- warn:
lhs: Data.ByteString.writeFile
rhs: writeFileBS
- warn:
lhs: Data.ByteString.appendFile
rhs: appendFileBS
- warn:
lhs: Data.ByteString.Lazy.readFile
rhs: readFileLBS
- warn:
lhs: Data.ByteString.Lazy.writeFile
rhs: writeFileLBS
- warn:
lhs: Data.ByteString.Lazy.appendFile
rhs: appendFileLBS
- hint:
lhs: "foldl' (flip f)"
note: "Use 'flipfoldl''"
rhs: "flipfoldl' f"
- warn:
lhs: "foldl' (+) 0"
rhs: sum
- warn:
lhs: "foldl' (*) 1"
rhs: product
- hint:
lhs: "fmap and (sequence s)"
note: Applying this hint would mean that some actions that were being executed previously would no longer be executed.
rhs: andM s
- hint:
lhs: "and <$> sequence s"
note: Applying this hint would mean that some actions that were being executed previously would no longer be executed.
rhs: andM s
- hint:
lhs: "fmap or (sequence s)"
note: Applying this hint would mean that some actions that were being executed previously would no longer be executed.
rhs: orM s
- hint:
lhs: "or <$> sequence s"
note: Applying this hint would mean that some actions that were being executed previously would no longer be executed.
rhs: orM s
- hint:
lhs: "fmap and (mapM f s)"
note: Applying this hint would mean that some actions that were being executed previously would no longer be executed.
rhs: allM f s
- hint:
lhs: "and <$> mapM f s"
note: Applying this hint would mean that some actions that were being executed previously would no longer be executed.
rhs: allM f s
- hint:
lhs: "fmap or (mapM f s)"
note: Applying this hint would mean that some actions that were being executed previously would no longer be executed.
rhs: anyM f s
- hint:
lhs: "or <$> mapM f s"
note: Applying this hint would mean that some actions that were being executed previously would no longer be executed.
rhs: anyM f s
- warn:
lhs: "getAlt (foldMap (Alt . f) xs)"
rhs: asumMap xs
- warn:
lhs: "getAlt . foldMap (Alt . f)"
rhs: asumMap
- hint:
lhs: "foldr (\\x acc -> f x <|> acc) empty"
note: "Use 'asumMap'"
rhs: asumMap f
- hint:
lhs: "asum (map f xs)"
note: "Use 'asumMap'"
rhs: asumMap f xs
- warn:
lhs: "map fst &&& map snd"
rhs: unzip
- hint:
lhs: "fmap (fmap f) x"
note: "Use '(<<$>>)'"
rhs: "f <<$>> x"
- hint:
lhs: "(\\f -> f x) <$> ff"
note: Use flap operator
rhs: "ff ?? x"
- hint:
lhs: "fmap (\\f -> f x) ff"
note: Use flap operator
rhs: "ff ?? x"
- hint:
lhs: "fmap ($ x) ff"
note: Use flap operator
rhs: "ff ?? x"
- hint:
lhs: "($ x) <$> ff"
note: Use flap operator
rhs: "ff ?? x"
- warn:
lhs: "fmap f (nonEmpty x)"
rhs: viaNonEmpty f x
- warn:
lhs: fmap f . nonEmpty
rhs: viaNonEmpty f
- warn:
lhs: "f <$> nonEmpty x"
rhs: viaNonEmpty f x
- warn:
lhs: partitionEithers . map f
rhs: partitionWith f
- warn:
lhs: partitionEithers $ map f x
rhs: partitionWith f x
- warn:
lhs: "f >>= guard"
rhs: guardM f
- warn:
lhs: guard =<< f
rhs: guardM f
- warn:
lhs: forever
note: "'forever' is loosely typed and may hide errors"
rhs: infinitely
- warn:
lhs: "whenM (not <$> x)"
rhs: unlessM x
- warn:
lhs: "unlessM (not <$> x)"
rhs: whenM x
- warn:
lhs: "either (const True) (const False)"
rhs: isLeft
- warn:
lhs: "either (const False) (const True)"
rhs: isRight
- warn:
lhs: "either id (const a)"
rhs: fromLeft a
- warn:
lhs: "either (const b) id"
rhs: fromRight b
- warn:
lhs: "either Just (const Nothing)"
rhs: leftToMaybe
- warn:
lhs: "either (const Nothing) Just"
rhs: rightToMaybe
- warn:
lhs: "maybe (Left l) Right"
rhs: maybeToRight l
- warn:
lhs: "maybe (Right r) Left"
rhs: maybeToLeft r
- warn:
lhs: "case m of Just x -> f x; Nothing -> pure ()"
rhs: whenJust m f
- warn:
lhs: "case m of Just x -> f x; Nothing -> return ()"
rhs: whenJust m f
- warn:
lhs: "case m of Just x -> f x; Nothing -> pass"
rhs: whenJust m f
- warn:
lhs: "case m of Nothing -> pure () ; Just x -> f x"
rhs: whenJust m f
- warn:
lhs: "case m of Nothing -> return (); Just x -> f x"
rhs: whenJust m f
- warn:
lhs: "case m of Nothing -> pass ; Just x -> f x"
rhs: whenJust m f
- warn:
lhs: "maybe (pure ()) f m"
rhs: whenJust m f
- warn:
lhs: "maybe (return ()) f m"
rhs: whenJust m f
- warn:
lhs: maybe pass f m
rhs: whenJust m f
- warn:
lhs: "m >>= \\a -> whenJust a f"
rhs: whenJustM m f
- warn:
lhs: "m >>= \\case Just x -> f x; Nothing -> pure ()"
rhs: whenJustM m f
- warn:
lhs: "m >>= \\case Just x -> f x; Nothing -> return ()"
rhs: whenJustM m f
- warn:
lhs: "m >>= \\case Just x -> f x; Nothing -> pass"
rhs: whenJustM m f
- warn:
lhs: "m >>= \\case Nothing -> pure () ; Just x -> f x"
rhs: whenJustM m f
- warn:
lhs: "m >>= \\case Nothing -> return (); Just x -> f x"
rhs: whenJustM m f
- warn:
lhs: "m >>= \\case Nothing -> pass ; Just x -> f x"
rhs: whenJustM m f
- warn:
lhs: "maybe (pure ()) f =<< m"
rhs: whenJustM m f
- warn:
lhs: "maybe (return ()) f =<< m"
rhs: whenJustM m f
- warn:
lhs: maybe pass f =<< m
rhs: whenJustM m f
- warn:
lhs: "m >>= maybe (pure ()) f"
rhs: whenJustM m f
- warn:
lhs: "m >>= maybe (return ()) f"
rhs: whenJustM m f
- warn:
lhs: "m >>= maybe pass f"
rhs: whenJustM m f
- warn:
lhs: "case m of Just _ -> pure () ; Nothing -> x"
rhs: whenNothing_ m x
- warn:
lhs: "case m of Just _ -> return (); Nothing -> x"
rhs: whenNothing_ m x
- warn:
lhs: "case m of Just _ -> pass ; Nothing -> x"
rhs: whenNothing_ m x
- warn:
lhs: "case m of Nothing -> x; Just _ -> pure ()"
rhs: whenNothing_ m x
- warn:
lhs: "case m of Nothing -> x; Just _ -> return ()"
rhs: whenNothing_ m x
- warn:
lhs: "case m of Nothing -> x; Just _ -> pass"
rhs: whenNothing_ m x
- warn:
lhs: "maybe x (\\_ -> pure () ) m"
rhs: whenNothing_ m x
- warn:
lhs: "maybe x (\\_ -> return () ) m"
rhs: whenNothing_ m x
- warn:
lhs: "maybe x (\\_ -> pass ) m"
rhs: whenNothing_ m x
- warn:
lhs: "maybe x (const (pure () )) m"
rhs: whenNothing_ m x
- warn:
lhs: "maybe x (const (return ())) m"
rhs: whenNothing_ m x
- warn:
lhs: "maybe x (const pass) m"
rhs: whenNothing_ m x
- warn:
lhs: "m >>= \\a -> whenNothing_ a x"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= \\case Just _ -> pure () ; Nothing -> x"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= \\case Just _ -> return (); Nothing -> x"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= \\case Just _ -> pass ; Nothing -> x"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= \\case Nothing -> x; Just _ -> pure ()"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= \\case Nothing -> x; Just _ -> return ()"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= \\case Nothing -> x; Just _ -> pass"
rhs: whenNothingM_ m x
- warn:
lhs: "maybe x (\\_ -> pure () ) =<< m"
rhs: whenNothingM_ m x
- warn:
lhs: "maybe x (\\_ -> return () ) =<< m"
rhs: whenNothingM_ m x
- warn:
lhs: "maybe x (\\_ -> pass ) =<< m"
rhs: whenNothingM_ m x
- warn:
lhs: "maybe x (const (pure () )) =<< m"
rhs: whenNothingM_ m x
- warn:
lhs: "maybe x (const (return ())) =<< m"
rhs: whenNothingM_ m x
- warn:
lhs: "maybe x (const pass) =<< m"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= maybe x (\\_ -> pure ())"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= maybe x (\\_ -> return ())"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= maybe x (\\_ -> pass)"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= maybe x (const (pure ()) )"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= maybe x (const (return ()))"
rhs: whenNothingM_ m x
- warn:
lhs: "m >>= maybe x (const pass)"
rhs: whenNothingM_ m x
- warn:
lhs: "whenLeft ()"
rhs: whenLeft_
- warn:
lhs: "case m of Left x -> f x; Right _ -> pure ()"
rhs: whenLeft_ m f
- warn:
lhs: "case m of Left x -> f x; Right _ -> return ()"
rhs: whenLeft_ m f
- warn:
lhs: "case m of Left x -> f x; Right _ -> pass"
rhs: whenLeft_ m f
- warn:
lhs: "case m of Right _ -> pure () ; Left x -> f x"
rhs: whenLeft_ m f
- warn:
lhs: "case m of Right _ -> return (); Left x -> f x"
rhs: whenLeft_ m f
- warn:
lhs: "case m of Right _ -> pass ; Left x -> f x"
rhs: whenLeft_ m f
- warn:
lhs: "either f (\\_ -> pure () ) m"
rhs: whenLeft_ m f
- warn:
lhs: "either f (\\_ -> return () ) m"
rhs: whenLeft_ m f
- warn:
lhs: "either f (\\_ -> pass ) m"
rhs: whenLeft_ m f
- warn:
lhs: "either f (const (pure () )) m"
rhs: whenLeft_ m f
- warn:
lhs: "either f (const (return ())) m"
rhs: whenLeft_ m f
- warn:
lhs: "either f (const pass) m"
rhs: whenLeft_ m f
- warn:
lhs: "m >>= \\a -> whenLeft_ a f"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= \\case Left x -> f x; Right _ -> pure ()"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= \\case Left x -> f x; Right _ -> return ()"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= \\case Left x -> f x; Right _ -> pass"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= \\case Right _ -> pure () ; Left x -> f x"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= \\case Right _ -> return (); Left x -> f x"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= \\case Right _ -> pass ; Left x -> f x"
rhs: whenLeftM_ m f
- warn:
lhs: "either f (\\_ -> pure () ) =<< m"
rhs: whenLeftM_ m f
- warn:
lhs: "either f (\\_ -> return () ) =<< m"
rhs: whenLeftM_ m f
- warn:
lhs: "either f (\\_ -> pass ) =<< m"
rhs: whenLeftM_ m f
- warn:
lhs: "either f (const (pure () )) =<< m"
rhs: whenLeftM_ m f
- warn:
lhs: "either f (const (return ())) =<< m"
rhs: whenLeftM_ m f
- warn:
lhs: "either f (const pass) =<< m"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= either f (\\_ -> pure ())"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= either f (\\_ -> return ())"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= either f (\\_ -> pass)"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= either f (const (pure ()) )"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= either f (const (return ()))"
rhs: whenLeftM_ m f
- warn:
lhs: "m >>= either f (const pass)"
rhs: whenLeftM_ m f
- warn:
lhs: "whenRight ()"
rhs: whenRight_
- warn:
lhs: "case m of Right x -> f x; Left _ -> pure ()"
rhs: whenRight_ m f
- warn:
lhs: "case m of Right x -> f x; Left _ -> return ()"
rhs: whenRight_ m f
- warn:
lhs: "case m of Right x -> f x; Left _ -> pass"
rhs: whenRight_ m f
- warn:
lhs: "case m of Left _ -> pure () ; Right x -> f x"
rhs: whenRight_ m f
- warn:
lhs: "case m of Left _ -> return (); Right x -> f x"
rhs: whenRight_ m f
- warn:
lhs: "case m of Left _ -> pass ; Right x -> f x"
rhs: whenRight_ m f
- warn:
lhs: "either (\\_ -> pure () ) f m"
rhs: whenRight_ m f
- warn:
lhs: "either (\\_ -> return () ) f m"
rhs: whenRight_ m f
- warn:
lhs: "either (\\_ -> pass ) f m"
rhs: whenRight_ m f
- warn:
lhs: "either (const (pure () )) f m"
rhs: whenRight_ m f
- warn:
lhs: "either (const (return ())) f m"
rhs: whenRight_ m f
- warn:
lhs: "either (const pass) f m"
rhs: whenRight_ m f
- warn:
lhs: "m >>= \\a -> whenRight_ a f"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= \\case Right x -> f x; Left _ -> pure () "
rhs: whenRightM_ m f
- warn:
lhs: "m >>= \\case Right x -> f x; Left _ -> return ()"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= \\case Right x -> f x; Left _ -> pass"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= \\case Left _ -> pure () ; Right x -> f x"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= \\case Left _ -> return (); Right x -> f x"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= \\case Left _ -> pass ; Right x -> f x"
rhs: whenRightM_ m f
- warn:
lhs: "either (\\_ -> pure () ) f =<< m"
rhs: whenRightM_ m f
- warn:
lhs: "either (\\_ -> return () ) f =<< m"
rhs: whenRightM_ m f
- warn:
lhs: "either (\\_ -> pass ) f =<< m"
rhs: whenRightM_ m f
- warn:
lhs: "either (const (pure () )) f =<< m"
rhs: whenRightM_ m f
- warn:
lhs: "either (const (return ())) f =<< m"
rhs: whenRightM_ m f
- warn:
lhs: "either (const pass) f =<< m"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= either (\\_ -> pure ()) f"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= either (\\_ -> return ()) f"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= either (\\_ -> pass) f"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= either (const (pure ()) ) f"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= either (const (return ())) f"
rhs: whenRightM_ m f
- warn:
lhs: "m >>= either (const pass) f"
rhs: whenRightM_ m f
- warn:
lhs: "case m of Left x -> f x; Right _ -> pure d "
rhs: whenLeft d m f
- warn:
lhs: "case m of Left x -> f x; Right _ -> return d"
rhs: whenLeft d m f
- warn:
lhs: "case m of Right _ -> pure d ; Left x -> f x"
rhs: whenLeft d m f
- warn:
lhs: "case m of Right _ -> return d; Left x -> f x"
rhs: whenLeft d m f
- warn:
lhs: "either f (\\_ -> pure d ) m"
rhs: whenLeft d m f
- warn:
lhs: "either f (\\_ -> return d ) m"
rhs: whenLeft d m f
- warn:
lhs: "either f (const (pure d )) m"
rhs: whenLeft d m f
- warn:
lhs: "either f (const (return d)) m"
rhs: whenLeft d m f
- warn:
lhs: "m >>= \\a -> whenLeft d a f"
rhs: whenLeftM d m f
- warn:
lhs: "m >>= \\case Left x -> f x; Right _ -> pure d"
rhs: whenLeftM d m f
- warn:
lhs: "m >>= \\case Left x -> f x; Right _ -> return d"
rhs: whenLeftM d m f
- warn:
lhs: "m >>= \\case Right _ -> pure d ; Left x -> f x"
rhs: whenLeftM d m f
- warn:
lhs: "m >>= \\case Right _ -> return d; Left x -> f x"
rhs: whenLeftM d m f
- warn:
lhs: "either f (\\_ -> pure d ) =<< m"
rhs: whenLeftM d m f
- warn:
lhs: "either f (\\_ -> return d ) =<< m"
rhs: whenLeftM d m f
- warn:
lhs: "either f (const (pure d )) =<< m"
rhs: whenLeftM d m f
- warn:
lhs: "either f (const (return d)) =<< m"
rhs: whenLeftM d m f
- warn:
lhs: "m >>= either f (\\_ -> pure d)"
rhs: whenLeftM d m f
- warn:
lhs: "m >>= either f (\\_ -> return d)"
rhs: whenLeftM d m f
- warn:
lhs: "m >>= either f (const (pure d))"
rhs: whenLeftM d m f
- warn:
lhs: "m >>= either f (const (return d))"
rhs: whenLeftM d m f
- warn:
lhs: "case m of Right x -> f x; Left _ -> pure d"
rhs: whenRight d m f
- warn:
lhs: "case m of Right x -> f x; Left _ -> return d"
rhs: whenRight d m f
- warn:
lhs: "case m of Left _ -> pure d ; Right x -> f x"
rhs: whenRight d m f
- warn:
lhs: "case m of Left _ -> return d; Right x -> f x"
rhs: whenRight d m f
- warn:
lhs: "either (\\_ -> pure d ) f m"
rhs: whenRight d m f
- warn:
lhs: "either (\\_ -> return d ) f m"
rhs: whenRight d m f
- warn:
lhs: "either (const (pure d )) f m"
rhs: whenRight d m f
- warn:
lhs: "either (const (return d)) f m"
rhs: whenRight d m f
- warn:
lhs: "m >>= \\a -> whenRight d a f"
rhs: whenRightM d m f
- warn:
lhs: "m >>= \\case Right x -> f x; Left _ -> pure d"
rhs: whenRightM d m f
- warn:
lhs: "m >>= \\case Right x -> f x; Left _ -> return d"
rhs: whenRightM d m f
- warn:
lhs: "m >>= \\case Left _ -> pure d ; Right x -> f x"
rhs: whenRightM d m f
- warn:
lhs: "m >>= \\case Left _ -> return d; Right x -> f x"
rhs: whenRightM d m f
- warn:
lhs: "either (\\_ -> pure d ) f =<< m"
rhs: whenRightM d m f
- warn:
lhs: "either (\\_ -> return d ) f =<< m"
rhs: whenRightM d m f
- warn:
lhs: "either (const (pure d )) f =<< m"
rhs: whenRightM d m f
- warn:
lhs: "either (const (return d)) f =<< m"
rhs: whenRightM d m f
- warn:
lhs: "m >>= either (\\_ -> pure d) f"
rhs: whenRightM d m f
- warn:
lhs: "m >>= either (\\_ -> return d) f"
rhs: whenRightM d m f
- warn:
lhs: "m >>= either (const (pure d) ) f"
rhs: whenRightM d m f
- warn:
lhs: "m >>= either (const (return d)) f"
rhs: whenRightM d m f
- warn:
lhs: "case m of [] -> return (); (x:xs) -> f (x :| xs)"
rhs: whenNotNull m f
- warn:
lhs: "case m of [] -> pure () ; (x:xs) -> f (x :| xs)"
rhs: whenNotNull m f
- warn:
lhs: "case m of [] -> pass ; (x:xs) -> f (x :| xs)"
rhs: whenNotNull m f
- warn:
lhs: "case m of (x:xs) -> f (x :| xs); [] -> return ()"
rhs: whenNotNull m f
- warn:
lhs: "case m of (x:xs) -> f (x :| xs); [] -> pure () "
rhs: whenNotNull m f
- warn:
lhs: "case m of (x:xs) -> f (x :| xs); [] -> pass "
rhs: whenNotNull m f
- warn:
lhs: "m >>= \\case [] -> pass ; (x:xs) -> f (x :| xs)"
rhs: whenNotNullM m f
- warn:
lhs: "m >>= \\case [] -> pure () ; (x:xs) -> f (x :| xs)"
rhs: whenNotNullM m f
- warn:
lhs: "m >>= \\case [] -> return (); (x:xs) -> f (x :| xs)"
rhs: whenNotNullM m f
- warn:
lhs: "m >>= \\case (x:xs) -> f (x :| xs); [] -> pass "
rhs: whenNotNullM m f
- warn:
lhs: "m >>= \\case (x:xs) -> f (x :| xs); [] -> pure () "
rhs: whenNotNullM m f
- warn:
lhs: "m >>= \\case (x:xs) -> f (x :| xs); [] -> return ()"
rhs: whenNotNullM m f
- warn:
lhs: mapMaybe leftToMaybe
rhs: lefts
- warn:
lhs: mapMaybe rightToMaybe
rhs: rights
- warn:
lhs: flip runReaderT
rhs: usingReaderT
- warn:
lhs: flip runReader
rhs: usingReader
- warn:
lhs: flip runStateT
rhs: usingStateT
- warn:
lhs: flip runState
rhs: usingState
- warn:
lhs: "fst <$> usingStateT s st"
rhs: evaluatingStateT s st
- warn:
lhs: "fst (usingState s st)"
rhs: evaluatingState s st
- warn:
lhs: "snd <$> usingStateT s st"
rhs: executingStateT s st
- warn:
lhs: "snd (usingState s st)"
rhs: executingState s st
- warn:
lhs: "MaybeT (pure m)"
rhs: hoistMaybe m
- warn:
lhs: "MaybeT (return m)"
rhs: hoistMaybe m
- warn:
lhs: MaybeT . pure
rhs: hoistMaybe
- warn:
lhs: MaybeT . return
rhs: hoistMaybe
- warn:
lhs: "ExceptT (pure m)"
rhs: hoistEither m
- warn:
lhs: "ExceptT (return m)"
rhs: hoistEither m
- warn:
lhs: ExceptT . pure
rhs: hoistEither
- warn:
lhs: ExceptT . return
rhs: hoistEither
- warn:
lhs: fromMaybe mempty
rhs: maybeToMonoid
- warn:
lhs: "m ?: mempty"
rhs: maybeToMonoid m
- warn:
lhs: "Data.Map.toAscList (Data.Map.fromList x)"
rhs: sortWith fst x
- warn:
lhs: "Data.Map.toDescList (Data.Map.fromList x)"
rhs: "sortWith (Down . fst) x"
- warn:
lhs: "Data.Set.toList (Data.Set.fromList l)"
rhs: sortNub l
- warn:
lhs: "Data.Set.assocs (Data.Set.fromList l)"
rhs: sortNub l
- warn:
lhs: "Data.Set.toAscList (Data.Set.fromList l)"
rhs: sortNub l
- warn:
lhs: "Data.HashSet.toList (Data.HashSet.fromList l)"
rhs: unstableNub l
- warn:
lhs: nub
note: "'nub' is O(n^2), 'ordNub' is O(n log n)"
rhs: ordNub
- warn:
lhs: "sortBy (comparing f)"
note: "If the function you are using for 'comparing' is slow, use 'sortOn' instead of 'sortWith', because 'sortOn' caches applications the function and 'sortWith' doesn't."
rhs: sortWith f
- warn:
lhs: sortOn fst
note: "'sortWith' will be faster here because it doesn't do caching"
rhs: sortWith fst
- warn:
lhs: sortOn snd
note: "'sortWith' will be faster here because it doesn't do caching"
rhs: sortWith snd
- warn:
lhs: "sortOn (Down . fst)"
note: "'sortWith' will be faster here because it doesn't do caching"
rhs: "sortWith (Down . fst)"
- warn:
lhs: "sortOn (Down . snd)"
note: "'sortWith' will be faster here because it doesn't do caching"
rhs: "sortWith (Down . snd)"
- warn:
lhs: Data.Text.IO.putStr
rhs: putText
- warn:
lhs: Data.Text.IO.putStrLn
rhs: putTextLn
- warn:
lhs: Data.Text.Lazy.IO.putStr
rhs: putLText
- warn:
lhs: Data.Text.Lazy.IO.putStrLn
rhs: putLTextLn
- warn:
lhs: Data.ByteString.Char8.putStr
rhs: putBS
- warn:
lhs: Data.ByteString.Char8.putStrLn
rhs: putBSLn
- warn:
lhs: Data.ByteString.Lazy.Char8.putStr
rhs: putLBS
- warn:
lhs: Data.ByteString.Lazy.Char8.putStrLn
rhs: putLBSLn
- warn:
lhs: Data.Text.Lazy.Text
rhs: LText
- warn:
lhs: Data.ByteString.Lazy.ByteString
rhs: LByteString
- warn:
lhs: Data.ByteString.UTF8.fromString
rhs: encodeUtf8
- warn:
lhs: Data.ByteString.UTF8.toString
rhs: decodeUtf8
- warn:
lhs: Data.Text.Encoding.encodeUtf8
rhs: encodeUtf8
- warn:
lhs: Data.Text.Encoding.decodeUtf8
rhs: decodeUtf8
- warn:
lhs: "Data.ByteString.Lazy.toStrict (encodeUtf8 x)"
rhs: encodeUtf8 x
- warn:
lhs: "toStrict (encodeUtf8 x)"
rhs: encodeUtf8 x
- warn:
lhs: "decodeUtf8 (Data.ByteString.Lazy.fromStrict x)"
rhs: decodeUtf8 x
- warn:
lhs: "decodeUtf8 (fromStrict x)"
rhs: decodeUtf8 x
- warn:
lhs: Data.ByteString.Lazy.UTF8.fromString
rhs: encodeUtf8
- warn:
lhs: Data.ByteString.Lazy.UTF8.toString
rhs: decodeUtf8
- warn:
lhs: "Data.ByteString.Lazy.fromStrict (Data.Text.Encoding.encodeUtf8 x)"
rhs: encodeUtf8 x
- warn:
lhs: "Data.ByteString.Lazy.fromStrict (encodeUtf8 x)"
rhs: encodeUtf8 x
- warn:
lhs: "Data.Text.Encoding.decodeUtf8 (Data.ByteString.Lazy.toStrict x)"
rhs: decodeUtf8 x
- warn:
lhs: "Data.Text.Encoding.decodeUtf8 (toStrict x)"
rhs: decodeUtf8 x
- warn:
lhs: "decodeUtf8 (Data.ByteString.Lazy.toStrict x)"
rhs: decodeUtf8 x
- warn:
lhs: "decodeUtf8 (toStrict x)"
rhs: decodeUtf8 x
- warn:
lhs: Data.Text.pack
rhs: toText
- warn:
lhs: Data.Text.unpack
rhs: toString
- warn:
lhs: Data.Text.Lazy.pack
rhs: toLText
- warn:
lhs: Data.Text.Lazy.unpack
rhs: toString
- warn:
lhs: Data.Text.Lazy.toStrict
rhs: toText
- warn:
lhs: Data.Text.Lazy.fromStrict
rhs: toLText
- warn:
lhs: "Data.Text.pack (show x)"
rhs: show x
- warn:
lhs: "Data.Text.Lazy.pack (show x)"
rhs: show x
- warn:
lhs: Data.ByteString.Lazy.fromStrict
rhs: fromStrict
- warn:
lhs: Data.ByteString.Lazy.toStrict
rhs: toStrict
- warn:
lhs: Data.Text.Lazy.fromStrict
rhs: fromStrict
- warn:
lhs: Data.Text.Lazy.toStrict
rhs: toStrict
- warn:
lhs: Control.Applicative.Alternative
name: "Use 'Alternative' from Relude"
note: "'Alternative' is already exported from Relude"
rhs: Alternative
- warn:
lhs: Control.Applicative.empty
name: "Use 'empty' from Relude"
note: "'empty' is already exported from Relude"
rhs: empty
- warn:
lhs: "(Control.Applicative.<|>)"
name: "Use '<|>' from Relude"
note: "Operator '(<|>)' is already exported from Relude"
rhs: "(<|>)"
- warn:
lhs: Control.Applicative.some
name: "Use 'some' from Relude"
note: "'some' is already exported from Relude"
rhs: some
- warn:
lhs: Control.Applicative.many
name: "Use 'many' from Relude"
note: "'many' is already exported from Relude"
rhs: many
- warn:
lhs: Control.Applicative.Const
name: "Use 'Const' from Relude"
note: "'Const' is already exported from Relude"
rhs: Const
- warn:
lhs: Control.Applicative.getConst
name: "Use 'getConst' from Relude"
note: "'getConst' is already exported from Relude"
rhs: getConst
- warn:
lhs: Control.Applicative.ZipList
name: "Use 'ZipList' from Relude"
note: "'ZipList' is already exported from Relude"
rhs: ZipList
- warn:
lhs: Control.Applicative.getZipList
name: "Use 'getZipList' from Relude"
note: "'getZipList' is already exported from Relude"
rhs: getZipList
- warn:
lhs: Control.Applicative.liftA2
name: "Use 'liftA2' from Relude"
note: "'liftA2' is already exported from Relude"
rhs: liftA2
- warn:
lhs: Control.Applicative.liftA3
name: "Use 'liftA3' from Relude"
note: "'liftA3' is already exported from Relude"
rhs: liftA3
- warn:
lhs: Control.Applicative.optional
name: "Use 'optional' from Relude"
note: "'optional' is already exported from Relude"
rhs: optional
- warn:
lhs: "(Control.Applicative.<**>)"
name: "Use '<**>' from Relude"
note: "Operator '(<**>)' is already exported from Relude"
rhs: "(<**>)"
- warn:
lhs: Data.Bits.xor
name: "Use 'xor' from Relude"
note: "'xor' is already exported from Relude"
rhs: xor
- warn:
lhs: Data.Char.chr
name: "Use 'chr' from Relude"
note: "'chr' is already exported from Relude"
rhs: chr
- warn:
lhs: Data.Int.Int8
name: "Use 'Int8' from Relude"
note: "'Int8' is already exported from Relude"
rhs: Int8
- warn:
lhs: Data.Int.Int16
name: "Use 'Int16' from Relude"
note: "'Int16' is already exported from Relude"
rhs: Int16
- warn:
lhs: Data.Int.Int32
name: "Use 'Int32' from Relude"
note: "'Int32' is already exported from Relude"
rhs: Int32
- warn:
lhs: Data.Int.Int64
name: "Use 'Int64' from Relude"
note: "'Int64' is already exported from Relude"
rhs: Int64
- warn:
lhs: Data.Word.Word8
name: "Use 'Word8' from Relude"
note: "'Word8' is already exported from Relude"
rhs: Word8
- warn:
lhs: Data.Word.Word16
name: "Use 'Word16' from Relude"
note: "'Word16' is already exported from Relude"
rhs: Word16
- warn:
lhs: Data.Word.Word32
name: "Use 'Word32' from Relude"
note: "'Word32' is already exported from Relude"
rhs: Word32
- warn:
lhs: Data.Word.Word64
name: "Use 'Word64' from Relude"
note: "'Word64' is already exported from Relude"
rhs: Word64
- warn:
lhs: Data.Word.byteSwap16
name: "Use 'byteSwap16' from Relude"
note: "'byteSwap16' is already exported from Relude"
rhs: byteSwap16
- warn:
lhs: Data.Word.byteSwap32
name: "Use 'byteSwap32' from Relude"
note: "'byteSwap32' is already exported from Relude"
rhs: byteSwap32
- warn:
lhs: Data.Word.byteSwap64
name: "Use 'byteSwap64' from Relude"
note: "'byteSwap64' is already exported from Relude"
rhs: byteSwap64
- warn:
lhs: Numeric.Natural.Natural
name: "Use 'Natural' from Relude"
note: "'Natural' is already exported from Relude"
rhs: Natural
- warn:
lhs: System.IO.IOMode
name: "Use 'IOMode' from Relude"
note: "'IOMode' is already exported from Relude"
rhs: IOMode
- warn:
lhs: System.IO.ReadMode
name: "Use 'ReadMode' from Relude"
note: "'ReadMode' is already exported from Relude"
rhs: ReadMode
- warn:
lhs: System.IO.WriteMode
name: "Use 'WriteMode' from Relude"
note: "'WriteMode' is already exported from Relude"
rhs: WriteMode
- warn:
lhs: System.IO.AppendMode
name: "Use 'AppendMode' from Relude"
note: "'AppendMode' is already exported from Relude"
rhs: AppendMode
- warn:
lhs: System.IO.ReadWriteMode
name: "Use 'ReadWriteMode' from Relude"
note: "'ReadWriteMode' is already exported from Relude"
rhs: ReadWriteMode
- warn:
lhs: Data.Ord.Down
name: "Use 'Down' from Relude"
note: "'Down' is already exported from Relude"
rhs: Down
- warn:
lhs: Data.Ord.comparing
name: "Use 'comparing' from Relude"
note: "'comparing' is already exported from Relude"
rhs: comparing
- warn:
lhs: Data.Coerce.Coercible
name: "Use 'Coercible' from Relude"
note: "'Coercible' is already exported from Relude"
rhs: Coercible
- warn:
lhs: Data.Coerce.coerce
name: "Use 'coerce' from Relude"
note: "'coerce' is already exported from Relude"
rhs: coerce
- warn:
lhs: Data.Kind.Constraint
name: "Use 'Constraint' from Relude"
note: "'Constraint' is already exported from Relude"
rhs: Constraint
- warn:
lhs: Data.Kind.Type
name: "Use 'Type' from Relude"
note: "'Type' is already exported from Relude"
rhs: Type
- warn:
lhs: Data.Typeable.Typeable
name: "Use 'Typeable' from Relude"
note: "'Typeable' is already exported from Relude"
rhs: Typeable
- warn:
lhs: Data.Proxy.Proxy
name: "Use 'Proxy' from Relude"
note: "'Proxy' is already exported from Relude"
rhs: Proxy
- warn:
lhs: Data.Typeable.Typeable
name: "Use 'Typeable' from Relude"
note: "'Typeable' is already exported from Relude"
rhs: Typeable
- warn:
lhs: Data.Void.Void
name: "Use 'Void' from Relude"
note: "'Void' is already exported from Relude"
rhs: Void
- warn:
lhs: Data.Void.absurd
name: "Use 'absurd' from Relude"
note: "'absurd' is already exported from Relude"
rhs: absurd
- warn:
lhs: Data.Void.vacuous
name: "Use 'vacuous' from Relude"
note: "'vacuous' is already exported from Relude"
rhs: vacuous
- warn:
lhs: Data.Base.maxInt
name: "Use 'maxInt' from Relude"
note: "'maxInt' is already exported from Relude"
rhs: maxInt
- warn:
lhs: Data.Base.minInt
name: "Use 'minInt' from Relude"
note: "'minInt' is already exported from Relude"
rhs: minInt
- warn:
lhs: Data.Base.ord
name: "Use 'ord' from Relude"
note: "'ord' is already exported from Relude"
rhs: ord
- warn:
lhs: GHC.Enum.boundedEnumFrom
name: "Use 'boundedEnumFrom' from Relude"
note: "'boundedEnumFrom' is already exported from Relude"
rhs: boundedEnumFrom
- warn:
lhs: GHC.Enum.boundedEnumFromThen
name: "Use 'boundedEnumFromThen' from Relude"
note: "'boundedEnumFromThen' is already exported from Relude"
rhs: boundedEnumFromThen
- warn:
lhs: GHC.Generics.Generic
name: "Use 'Generic' from Relude"
note: "'Generic' is already exported from Relude"
rhs: Generic
- warn:
lhs: GHC.Real.Ratio
name: "Use 'Ratio' from Relude"
note: "'Ratio' is already exported from Relude"
rhs: Ratio
- warn:
lhs: GHC.Real.Rational
name: "Use 'Rational' from Relude"
note: "'Rational' is already exported from Relude"
rhs: Rational
- warn:
lhs: GHC.Real.denominator
name: "Use 'denominator' from Relude"
note: "'denominator' is already exported from Relude"
rhs: denominator
- warn:
lhs: GHC.Real.numerator
name: "Use 'numerator' from Relude"
note: "'numerator' is already exported from Relude"
rhs: numerator
- warn:
lhs: GHC.TypeNats.CmpNat
name: "Use 'CmpNat' from Relude"
note: "'CmpNat' is already exported from Relude"
rhs: CmpNat
- warn:
lhs: GHC.TypeNats.KnownNat
name: "Use 'KnownNat' from Relude"
note: "'KnownNat' is already exported from Relude"
rhs: KnownNat
- warn:
lhs: GHC.TypeNats.Nat
name: "Use 'Nat' from Relude"
note: "'Nat' is already exported from Relude"
rhs: Nat
- warn:
lhs: GHC.TypeNats.SomeNat
name: "Use 'SomeNat' from Relude"
note: "'SomeNat' is already exported from Relude"
rhs: SomeNat
- warn:
lhs: GHC.TypeNats.natVal
name: "Use 'natVal' from Relude"
note: "'natVal' is already exported from Relude"
rhs: natVal
- warn:
lhs: GHC.TypeNats.someNatVal
name: "Use 'someNatVal' from Relude"
note: "'someNatVal' is already exported from Relude"
rhs: someNatVal
- warn:
lhs: GHC.TypeLits.CmpNat
name: "Use 'CmpNat' from Relude"
note: "'CmpNat' is already exported from Relude"
rhs: CmpNat
- warn:
lhs: GHC.TypeLits.KnownNat
name: "Use 'KnownNat' from Relude"
note: "'KnownNat' is already exported from Relude"
rhs: KnownNat
- warn:
lhs: GHC.TypeLits.Nat
name: "Use 'Nat' from Relude"
note: "'Nat' is already exported from Relude"
rhs: Nat
- warn:
lhs: GHC.TypeLits.SomeNat
name: "Use 'SomeNat' from Relude"
note: "'SomeNat' is already exported from Relude"
rhs: SomeNat
- warn:
lhs: GHC.TypeLits.natVal
name: "Use 'natVal' from Relude"
note: "'natVal' is already exported from Relude"
rhs: natVal
- warn:
lhs: GHC.TypeLits.someNatVal
name: "Use 'someNatVal' from Relude"
note: "'someNatVal' is already exported from Relude"
rhs: someNatVal
- warn:
lhs: GHC.ExecutionStack.getStackTrace
name: "Use 'getStackTrace' from Relude"
note: "'getStackTrace' is already exported from Relude"
rhs: getStackTrace
- warn:
lhs: GHC.ExecutionStack.showStackTrace
name: "Use 'showStackTrace' from Relude"
note: "'showStackTrace' is already exported from Relude"
rhs: showStackTrace
- warn:
lhs: GHC.OverloadedLabels.IsLabel
name: "Use 'IsLabel' from Relude"
note: "'IsLabel' is already exported from Relude"
rhs: IsLabel
- warn:
lhs: GHC.OverloadedLabels.fromLabel
name: "Use 'fromLabel' from Relude"
note: "'fromLabel' is already exported from Relude"
rhs: fromLabel
- warn:
lhs: GHC.Stack.CallStack
name: "Use 'CallStack' from Relude"
note: "'CallStack' is already exported from Relude"
rhs: CallStack
- warn:
lhs: GHC.Stack.HasCallStack
name: "Use 'HasCallStack' from Relude"
note: "'HasCallStack' is already exported from Relude"
rhs: HasCallStack
- warn:
lhs: GHC.Stack.callStack
name: "Use 'callStack' from Relude"
note: "'callStack' is already exported from Relude"
rhs: callStack
- warn:
lhs: GHC.Stack.currentCallStack
name: "Use 'currentCallStack' from Relude"
note: "'currentCallStack' is already exported from Relude"
rhs: currentCallStack
- warn:
lhs: GHC.Stack.getCallStack
name: "Use 'getCallStack' from Relude"
note: "'getCallStack' is already exported from Relude"
rhs: getCallStack
- warn:
lhs: GHC.Stack.prettyCallStack
name: "Use 'prettyCallStack' from Relude"
note: "'prettyCallStack' is already exported from Relude"
rhs: prettyCallStack
- warn:
lhs: GHC.Stack.prettySrcLoc
name: "Use 'prettySrcLoc' from Relude"
note: "'prettySrcLoc' is already exported from Relude"
rhs: prettySrcLoc
- warn:
lhs: GHC.Stack.withFrozenCallStack
name: "Use 'withFrozenCallStack' from Relude"
note: "'withFrozenCallStack' is already exported from Relude"
rhs: withFrozenCallStack
- warn:
lhs: Data.Bifoldable.Bifoldable
name: "Use 'Bifoldable' from Relude"
note: "'Bifoldable' is already exported from Relude"
rhs: Bifoldable
- warn:
lhs: Data.Bifoldable.bifold
name: "Use 'bifold' from Relude"
note: "'bifold' is already exported from Relude"
rhs: bifold
- warn:
lhs: Data.Bifoldable.bifoldMap
name: "Use 'bifoldMap' from Relude"
note: "'bifoldMap' is already exported from Relude"
rhs: bifoldMap
- warn:
lhs: Data.Bifoldable.bifoldr
name: "Use 'bifoldr' from Relude"
note: "'bifoldr' is already exported from Relude"
rhs: bifoldr
- warn:
lhs: Data.Bifoldable.bifoldl
name: "Use 'bifoldl' from Relude"
note: "'bifoldl' is already exported from Relude"
rhs: bifoldl
- warn:
lhs: "Data.Bifoldable.bifoldl'"
name: "Use 'bifoldl'' from Relude"
note: "'bifoldl'' is already exported from Relude"
rhs: "bifoldl'"
- warn:
lhs: Data.Bifoldable.bifoldlM
name: "Use 'bifoldlM' from Relude"
note: "'bifoldlM' is already exported from Relude"
rhs: bifoldlM
- warn:
lhs: "Data.Bifoldable.bifoldr'"
name: "Use 'bifoldr'' from Relude"
note: "'bifoldr'' is already exported from Relude"
rhs: "bifoldr'"
- warn:
lhs: Data.Bifoldable.bifoldrM
name: "Use 'bifoldrM' from Relude"
note: "'bifoldrM' is already exported from Relude"
rhs: bifoldrM
- warn:
lhs: Data.Bifoldable.bitraverse_
name: "Use 'bitraverse_' from Relude"
note: "'bitraverse_' is already exported from Relude"
rhs: bitraverse_
- warn:
lhs: Data.Bifoldable.bifor_
name: "Use 'bifor_' from Relude"
note: "'bifor_' is already exported from Relude"
rhs: bifor_
- warn:
lhs: Data.Bifoldable.biasum
name: "Use 'biasum' from Relude"
note: "'biasum' is already exported from Relude"
rhs: biasum
- warn:
lhs: Data.Bifoldable.bisequence_
name: "Use 'bisequence_' from Relude"
note: "'bisequence_' is already exported from Relude"
rhs: bisequence_
- warn:
lhs: Data.Bifoldable.biList
name: "Use 'biList' from Relude"
note: "'biList' is already exported from Relude"
rhs: biList
- warn:
lhs: Data.Bifoldable.binull
name: "Use 'binull' from Relude"
note: "'binull' is already exported from Relude"
rhs: binull
- warn:
lhs: Data.Bifoldable.bilength
name: "Use 'bilength' from Relude"
note: "'bilength' is already exported from Relude"
rhs: bilength
- warn:
lhs: Data.Bifoldable.bielem
name: "Use 'bielem' from Relude"
note: "'bielem' is already exported from Relude"
rhs: bielem
- warn:
lhs: Data.Bifoldable.biand
name: "Use 'biand' from Relude"
note: "'biand' is already exported from Relude"
rhs: biand
- warn:
lhs: Data.Bifoldable.bior
name: "Use 'bior' from Relude"
note: "'bior' is already exported from Relude"
rhs: bior
- warn:
lhs: Data.Bifoldable.biany
name: "Use 'biany' from Relude"
note: "'biany' is already exported from Relude"
rhs: biany
- warn:
lhs: Data.Bifoldable.biall
name: "Use 'biall' from Relude"
note: "'biall' is already exported from Relude"
rhs: biall
- warn:
lhs: Data.Bifoldable.bifind
name: "Use 'bifind' from Relude"
note: "'bifind' is already exported from Relude"
rhs: bifind
- warn:
lhs: Data.Bitraversable.Bitraversable
name: "Use 'Bitraversable' from Relude"
note: "'Bitraversable' is already exported from Relude"
rhs: Bitraversable
- warn:
lhs: Data.Bitraversable.bitraverse
name: "Use 'bitraverse' from Relude"
note: "'bitraverse' is already exported from Relude"
rhs: bitraverse
- warn:
lhs: Data.Bitraversable.bisequence
name: "Use 'bisequence' from Relude"
note: "'bisequence' is already exported from Relude"
rhs: bisequence
- warn:
lhs: Data.Bitraversable.bifor
name: "Use 'bifor' from Relude"
note: "'bifor' is already exported from Relude"
rhs: bifor
- warn:
lhs: Data.Bitraversable.bimapDefault
name: "Use 'bimapDefault' from Relude"
note: "'bimapDefault' is already exported from Relude"
rhs: bimapDefault
- warn:
lhs: Data.Bitraversable.bifoldMapDefault
name: "Use 'bifoldMapDefault' from Relude"
note: "'bifoldMapDefault' is already exported from Relude"
rhs: bifoldMapDefault
- warn:
lhs: Control.Monad.guard
name: "Use 'guard' from Relude"
note: "'guard' is already exported from Relude"
rhs: guard
- warn:
lhs: Control.Monad.unless
name: "Use 'unless' from Relude"
note: "'unless' is already exported from Relude"
rhs: unless
- warn:
lhs: Control.Monad.when
name: "Use 'when' from Relude"
note: "'when' is already exported from Relude"
rhs: when
- warn:
lhs: Data.Bool.bool
name: "Use 'bool' from Relude"
note: "'bool' is already exported from Relude"
rhs: bool
- warn:
lhs: Data.Hashable.Hashable
name: "Use 'Hashable' from Relude"
note: "'Hashable' is already exported from Relude"
rhs: Hashable
- warn:
lhs: Data.Hashable.hashWithSalt
name: "Use 'hashWithSalt' from Relude"
note: "'hashWithSalt' is already exported from Relude"
rhs: hashWithSalt
- warn:
lhs: Data.HashMap.Strict.HashMap
name: "Use 'HashMap' from Relude"
note: "'HashMap' is already exported from Relude"
rhs: HashMap
- warn:
lhs: Data.HashSet.HashSet
name: "Use 'HashSet' from Relude"
note: "'HashSet' is already exported from Relude"
rhs: HashSet
- warn:
lhs: Data.IntMap.Strict.IntMap
name: "Use 'IntMap' from Relude"
note: "'IntMap' is already exported from Relude"
rhs: IntMap
- warn:
lhs: Data.IntSet.IntSet
name: "Use 'IntSet' from Relude"
note: "'IntSet' is already exported from Relude"
rhs: IntSet
- warn:
lhs: Data.Map.Strict.Map
name: "Use 'Map' from Relude"
note: "'Map' is already exported from Relude"
rhs: Map
- warn:
lhs: Data.Sequence.Sequence
name: "Use 'Sequence' from Relude"
note: "'Sequence' is already exported from Relude"
rhs: Sequence
- warn:
lhs: Data.Set.Set
name: "Use 'Set' from Relude"
note: "'Set' is already exported from Relude"
rhs: Set
- warn:
lhs: Data.Tuple.swap
name: "Use 'swap' from Relude"
note: "'swap' is already exported from Relude"
rhs: swap
- warn:
lhs: Data.Vector.Vector
name: "Use 'Vector' from Relude"
note: "'Vector' is already exported from Relude"
rhs: Vector
- warn:
lhs: GHC.Exts.IsList
name: "Use 'IsList' from Relude"
note: "'IsList' is already exported from Relude"
rhs: IsList
- warn:
lhs: GHC.Exts.fromList
name: "Use 'fromList' from Relude"
note: "'fromList' is already exported from Relude"
rhs: fromList
- warn:
lhs: GHC.Exts.fromListN
name: "Use 'fromListN' from Relude"
note: "'fromListN' is already exported from Relude"
rhs: fromListN
- warn:
lhs: Debug.Trace.trace
name: "Use 'trace' from Relude"
note: "'trace' is already exported from Relude"
rhs: trace
- warn:
lhs: Debug.Trace.traceShow
name: "Use 'traceShow' from Relude"
note: "'traceShow' is already exported from Relude"
rhs: traceShow
- warn:
lhs: Debug.Trace.traceShowId
name: "Use 'traceShowId' from Relude"
note: "'traceShowId' is already exported from Relude"
rhs: traceShowId
- warn:
lhs: Debug.Trace.traceShowM
name: "Use 'traceShowM' from Relude"
note: "'traceShowM' is already exported from Relude"
rhs: traceShowM
- warn:
lhs: Debug.Trace.traceM
name: "Use 'traceM' from Relude"
note: "'traceM' is already exported from Relude"
rhs: traceM
- warn:
lhs: Debug.Trace.traceId
name: "Use 'traceId' from Relude"
note: "'traceId' is already exported from Relude"
rhs: traceId
- warn:
lhs: Control.DeepSeq.NFData
name: "Use 'NFData' from Relude"
note: "'NFData' is already exported from Relude"
rhs: NFData
- warn:
lhs: Control.DeepSeq.rnf
name: "Use 'rnf' from Relude"
note: "'rnf' is already exported from Relude"
rhs: rnf
- warn:
lhs: Control.DeepSeq.deepseq
name: "Use 'deepseq' from Relude"
note: "'deepseq' is already exported from Relude"
rhs: deepseq
- warn:
lhs: Control.DeepSeq.force
name: "Use 'force' from Relude"
note: "'force' is already exported from Relude"
rhs: force
- warn:
lhs: "(Control.DeepSeq.$!!)"
name: "Use '$!!' from Relude"
note: "Operator '($!!)' is already exported from Relude"
rhs: "($!!)"
- warn:
lhs: Control.Exception.Exception
name: "Use 'Exception' from Relude"
note: "'Exception' is already exported from Relude"
rhs: Exception
- warn:
lhs: Control.Exception.SomeException
name: "Use 'SomeException' from Relude"
note: "'SomeException' is already exported from Relude"
rhs: SomeException
- warn:
lhs: Control.Exception.toException
name: "Use 'toException' from Relude"
note: "'toException' is already exported from Relude"
rhs: toException
- warn:
lhs: Control.Exception.fromException
name: "Use 'fromException' from Relude"
note: "'fromException' is already exported from Relude"
rhs: fromException
- warn:
lhs: Control.Exception.displayException
name: "Use 'displayException' from Relude"
note: "'displayException' is already exported from Relude"
rhs: displayException
- warn:
lhs: Data.Foldable.asum
name: "Use 'asum' from Relude"
note: "'asum' is already exported from Relude"
rhs: asum
- warn:
lhs: Data.Foldable.find
name: "Use 'find' from Relude"
note: "'find' is already exported from Relude"
rhs: find
- warn:
lhs: Data.Foldable.find
name: "Use 'find' from Relude"
note: "'find' is already exported from Relude"
rhs: find
# - warn:
# lhs: Data.Foldable.fold
# name: "Use 'fold' from Relude"
# note: "'fold' is already exported from Relude"
# rhs: fold
- warn:
lhs: "Data.Foldable.foldl'"
name: "Use 'foldl'' from Relude"
note: "'foldl'' is already exported from Relude"
rhs: "foldl'"
- warn:
lhs: Data.Foldable.forM_
name: "Use 'forM_' from Relude"
note: "'forM_' is already exported from Relude"
rhs: forM_
- warn:
lhs: Data.Foldable.for_
name: "Use 'for_' from Relude"
note: "'for_' is already exported from Relude"
rhs: for_
- warn:
lhs: Data.Foldable.sequenceA_
name: "Use 'sequenceA_' from Relude"
note: "'sequenceA_' is already exported from Relude"
rhs: sequenceA_
- warn:
lhs: Data.Foldable.toList
name: "Use 'toList' from Relude"
note: "'toList' is already exported from Relude"
rhs: toList
- warn:
lhs: Data.Foldable.traverse_
name: "Use 'traverse_' from Relude"
note: "'traverse_' is already exported from Relude"
rhs: traverse_
- warn:
lhs: Data.Traversable.forM
name: "Use 'forM' from Relude"
note: "'forM' is already exported from Relude"
rhs: forM
- warn:
lhs: Data.Traversable.mapAccumL
name: "Use 'mapAccumL' from Relude"
note: "'mapAccumL' is already exported from Relude"
rhs: mapAccumL
- warn:
lhs: Data.Traversable.mapAccumR
name: "Use 'mapAccumR' from Relude"
note: "'mapAccumR' is already exported from Relude"
rhs: mapAccumR
- warn:
lhs: "(Control.Arrow.&&&)"
name: "Use '&&&' from Relude"
note: "Operator '(&&&)' is already exported from Relude"
rhs: "(&&&)"
- warn:
lhs: "(Control.Category.>>>)"
name: "Use '>>>' from Relude"
note: "Operator '(>>>)' is already exported from Relude"
rhs: "(>>>)"
- warn:
lhs: "(Control.Category.<<<)"
name: "Use '<<<' from Relude"
note: "Operator '(<<<)' is already exported from Relude"
rhs: "(<<<)"
- warn:
lhs: Data.Function.fix
name: "Use 'fix' from Relude"
note: "'fix' is already exported from Relude"
rhs: fix
- warn:
lhs: Data.Function.on
name: "Use 'on' from Relude"
note: "'on' is already exported from Relude"
rhs: 'on'
- warn:
lhs: Data.Bifunctor.Bifunctor
name: "Use 'Bifunctor' from Relude"
note: "'Bifunctor' is already exported from Relude"
rhs: Bifunctor
- warn:
lhs: Data.Bifunctor.bimap
name: "Use 'bimap' from Relude"
note: "'bimap' is already exported from Relude"
rhs: bimap
- warn:
lhs: Data.Bifunctor.first
name: "Use 'first' from Relude"
note: "'first' is already exported from Relude"
rhs: first
- warn:
lhs: Data.Bifunctor.second
name: "Use 'second' from Relude"
note: "'second' is already exported from Relude"
rhs: second
- warn:
lhs: Data.Functor.void
name: "Use 'void' from Relude"
note: "'void' is already exported from Relude"
rhs: void
- warn:
lhs: "(Data.Functor.$>)"
name: "Use '$>' from Relude"
note: "Operator '($>)' is already exported from Relude"
rhs: "($>)"
- warn:
lhs: "(Data.Functor.<&>)"
name: "Use '<&>' from Relude"
note: "Operator '(<&>)' is already exported from Relude"
rhs: "(<&>)"
- warn:
lhs: Data.Functor.Compose.Compose
name: "Use 'Compose' from Relude"
note: "'Compose' is already exported from Relude"
rhs: Compose
- warn:
lhs: Data.Functor.Compose.getCompose
name: "Use 'getCompose' from Relude"
note: "'getCompose' is already exported from Relude"
rhs: getCompose
- warn:
lhs: Data.Functor.Identity.Identity
name: "Use 'Identity' from Relude"
note: "'Identity' is already exported from Relude"
rhs: Identity
- warn:
lhs: Data.Functor.Identity.runIdentity
name: "Use 'runIdentity' from Relude"
note: "'runIdentity' is already exported from Relude"
rhs: runIdentity
- warn:
lhs: Control.Concurrent.MVar.MVar
name: "Use 'MVar' from Relude"
note: "'MVar' is already exported from Relude"
rhs: MVar
- warn:
lhs: Control.Concurrent.MVar.newEmptyMVar
name: "Use 'newEmptyMVar' from Relude"
note: "'newEmptyMVar' is already exported from Relude"
rhs: newEmptyMVar
- warn:
lhs: Control.Concurrent.MVar.newMVar
name: "Use 'newMVar' from Relude"
note: "'newMVar' is already exported from Relude"
rhs: newMVar
- warn:
lhs: Control.Concurrent.MVar.putMVar
name: "Use 'putMVar' from Relude"
note: "'putMVar' is already exported from Relude"
rhs: putMVar
- warn:
lhs: Control.Concurrent.MVar.readMVar
name: "Use 'readMVar' from Relude"
note: "'readMVar' is already exported from Relude"
rhs: readMVar
- warn:
lhs: Control.Concurrent.MVar.swapMVar
name: "Use 'swapMVar' from Relude"
note: "'swapMVar' is already exported from Relude"
rhs: swapMVar
- warn:
lhs: Control.Concurrent.MVar.takeMVar
name: "Use 'takeMVar' from Relude"
note: "'takeMVar' is already exported from Relude"
rhs: takeMVar
- warn:
lhs: Control.Concurrent.MVar.tryPutMVar
name: "Use 'tryPutMVar' from Relude"
note: "'tryPutMVar' is already exported from Relude"
rhs: tryPutMVar
- warn:
lhs: Control.Concurrent.MVar.tryReadMVar
name: "Use 'tryReadMVar' from Relude"
note: "'tryReadMVar' is already exported from Relude"
rhs: tryReadMVar
- warn:
lhs: Control.Concurrent.MVar.tryTakeMVar
name: "Use 'tryTakeMVar' from Relude"
note: "'tryTakeMVar' is already exported from Relude"
rhs: tryTakeMVar
- warn:
lhs: Control.Monad.STM.STM
name: "Use 'STM' from Relude"
note: "'STM' is already exported from Relude"
rhs: STM
- warn:
lhs: Control.Monad.STM.atomically
name: "Use 'atomically' from Relude"
note: "'atomically' is already exported from Relude"
rhs: atomically
- warn:
lhs: Control.Monad.STM.throwSTM
name: "Use 'throwSTM' from Relude"
note: "'throwSTM' is already exported from Relude"
rhs: throwSTM
- warn:
lhs: Control.Monad.STM.catchSTM
name: "Use 'catchSTM' from Relude"
note: "'catchSTM' is already exported from Relude"
rhs: catchSTM
- warn:
lhs: Control.Concurrent.STM.TVar.TVar
name: "Use 'TVar' from Relude"
note: "'TVar' is already exported from Relude"
rhs: TVar
- warn:
lhs: Control.Concurrent.STM.TVar.newTVarIO
name: "Use 'newTVarIO' from Relude"
note: "'newTVarIO' is already exported from Relude"
rhs: newTVarIO
- warn:
lhs: Control.Concurrent.STM.TVar.readTVarIO
name: "Use 'readTVarIO' from Relude"
note: "'readTVarIO' is already exported from Relude"
rhs: readTVarIO
- warn:
lhs: "Control.Concurrent.STM.TVar.modifyTVar'"
name: "Use 'modifyTVar'' from Relude"
note: "'modifyTVar'' is already exported from Relude"
rhs: "modifyTVar'"
- warn:
lhs: Control.Concurrent.STM.TVar.newTVar
name: "Use 'newTVar' from Relude"
note: "'newTVar' is already exported from Relude"
rhs: newTVar
- warn:
lhs: Control.Concurrent.STM.TVar.readTVar
name: "Use 'readTVar' from Relude"
note: "'readTVar' is already exported from Relude"
rhs: readTVar
- warn:
lhs: Control.Concurrent.STM.TVar.writeTVar
name: "Use 'writeTVar' from Relude"
note: "'writeTVar' is already exported from Relude"
rhs: writeTVar
- warn:
lhs: Control.Concurrent.STM.TMVar.TMVar
name: "Use 'TMVar' from Relude"
note: "'TMVar' is already exported from Relude"
rhs: TMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.newTMVar
name: "Use 'newTMVar' from Relude"
note: "'newTMVar' is already exported from Relude"
rhs: newTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.newEmptyTMVar
name: "Use 'newEmptyTMVar' from Relude"
note: "'newEmptyTMVar' is already exported from Relude"
rhs: newEmptyTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.newTMVarIO
name: "Use 'newTMVarIO' from Relude"
note: "'newTMVarIO' is already exported from Relude"
rhs: newTMVarIO
- warn:
lhs: Control.Concurrent.STM.TMVar.newEmptyTMVarIO
name: "Use 'newEmptyTMVarIO' from Relude"
note: "'newEmptyTMVarIO' is already exported from Relude"
rhs: newEmptyTMVarIO
- warn:
lhs: Control.Concurrent.STM.TMVar.takeTMVar
name: "Use 'takeTMVar' from Relude"
note: "'takeTMVar' is already exported from Relude"
rhs: takeTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.putTMVar
name: "Use 'putTMVar' from Relude"
note: "'putTMVar' is already exported from Relude"
rhs: putTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.readTMVar
name: "Use 'readTMVar' from Relude"
note: "'readTMVar' is already exported from Relude"
rhs: readTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.tryReadTMVar
name: "Use 'tryReadTMVar' from Relude"
note: "'tryReadTMVar' is already exported from Relude"
rhs: tryReadTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.swapTMVar
name: "Use 'swapTMVar' from Relude"
note: "'swapTMVar' is already exported from Relude"
rhs: swapTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.tryTakeTMVar
name: "Use 'tryTakeTMVar' from Relude"
note: "'tryTakeTMVar' is already exported from Relude"
rhs: tryTakeTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.tryPutTMVar
name: "Use 'tryPutTMVar' from Relude"
note: "'tryPutTMVar' is already exported from Relude"
rhs: tryPutTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.isEmptyTMVar
name: "Use 'isEmptyTMVar' from Relude"
note: "'isEmptyTMVar' is already exported from Relude"
rhs: isEmptyTMVar
- warn:
lhs: Control.Concurrent.STM.TMVar.mkWeakTMVar
name: "Use 'mkWeakTMVar' from Relude"
note: "'mkWeakTMVar' is already exported from Relude"
rhs: mkWeakTMVar
- warn:
lhs: Data.IORef.IORef
name: "Use 'IORef' from Relude"
note: "'IORef' is already exported from Relude"
rhs: IORef
- warn:
lhs: Data.IORef.atomicModifyIORef
name: "Use 'atomicModifyIORef' from Relude"
note: "'atomicModifyIORef' is already exported from Relude"
rhs: atomicModifyIORef
- warn:
lhs: "Data.IORef.atomicModifyIORef'"
name: "Use 'atomicModifyIORef'' from Relude"
note: "'atomicModifyIORef'' is already exported from Relude"
rhs: "atomicModifyIORef'"
- warn:
lhs: Data.IORef.atomicWriteIORef
name: "Use 'atomicWriteIORef' from Relude"
note: "'atomicWriteIORef' is already exported from Relude"
rhs: atomicWriteIORef
- warn:
lhs: Data.IORef.modifyIORef
name: "Use 'modifyIORef' from Relude"
note: "'modifyIORef' is already exported from Relude"
rhs: modifyIORef
- warn:
lhs: "Data.IORef.modifyIORef'"
name: "Use 'modifyIORef'' from Relude"
note: "'modifyIORef'' is already exported from Relude"
rhs: "modifyIORef'"
- warn:
lhs: Data.IORef.newIORef
name: "Use 'newIORef' from Relude"
note: "'newIORef' is already exported from Relude"
rhs: newIORef
- warn:
lhs: Data.IORef.readIORef
name: "Use 'readIORef' from Relude"
note: "'readIORef' is already exported from Relude"
rhs: readIORef
- warn:
lhs: Data.IORef.writeIORef
name: "Use 'writeIORef' from Relude"
note: "'writeIORef' is already exported from Relude"
rhs: writeIORef
- warn:
lhs: "atomicModifyIORef ref (\\a -> (f a, ()))"
rhs: atomicModifyIORef_ ref f
- warn:
lhs: "atomicModifyIORef ref $ \\a -> (f a, ())"
rhs: atomicModifyIORef_ ref f
- warn:
lhs: "atomicModifyIORef' ref $ \\a -> (f a, ())"
rhs: "atomicModifyIORef'_ ref f"
- warn:
lhs: "atomicModifyIORef' ref (\\a -> (f a, ()))"
rhs: "atomicModifyIORef'_ ref f"
- warn:
lhs: Data.Text.IO.getLine
name: "Use 'getLine' from Relude"
note: "'getLine' is already exported from Relude"
rhs: getLine
- warn:
lhs: System.IO.hFlush
name: "Use 'hFlush' from Relude"
note: "'hFlush' is already exported from Relude"
rhs: hFlush
- warn:
lhs: System.IO.hIsEOF
name: "Use 'hIsEOF' from Relude"
note: "'hIsEOF' is already exported from Relude"
rhs: hIsEOF
- warn:
lhs: System.IO.hSetBuffering
name: "Use 'hSetBuffering' from Relude"
note: "'hSetBuffering' is already exported from Relude"
rhs: hSetBuffering
- warn:
lhs: System.IO.hGetBuffering
name: "Use 'hGetBuffering' from Relude"
note: "'hGetBuffering' is already exported from Relude"
rhs: hGetBuffering
- warn:
lhs: System.IO.Handle
name: "Use 'Handle' from Relude"
note: "'Handle' is already exported from Relude"
rhs: Handle
- warn:
lhs: System.IO.stdin
name: "Use 'stdin' from Relude"
note: "'stdin' is already exported from Relude"
rhs: stdin
- warn:
lhs: System.IO.stdout
name: "Use 'stdout' from Relude"
note: "'stdout' is already exported from Relude"
rhs: stdout
- warn:
lhs: System.IO.stderr
name: "Use 'stderr' from Relude"
note: "'stderr' is already exported from Relude"
rhs: stderr
- warn:
lhs: System.IO.withFile
name: "Use 'withFile' from Relude"
note: "'withFile' is already exported from Relude"
rhs: withFile
- warn:
lhs: System.IO.BufferMode
name: "Use 'BufferMode' from Relude"
note: "'BufferMode' is already exported from Relude"
rhs: BufferMode
- warn:
lhs: System.Environment.getArgs
name: "Use 'getArgs' from Relude"
note: "'getArgs' is already exported from Relude"
rhs: getArgs
- warn:
lhs: System.Environment.lookupEnv
name: "Use 'lookupEnv' from Relude"
note: "'lookupEnv' is already exported from Relude"
rhs: lookupEnv
- warn:
lhs: Data.List.genericDrop
name: "Use 'genericDrop' from Relude"
note: "'genericDrop' is already exported from Relude"
rhs: genericDrop
- warn:
lhs: Data.List.genericLength
name: "Use 'genericLength' from Relude"
note: "'genericLength' is already exported from Relude"
rhs: genericLength
- warn:
lhs: Data.List.genericReplicate
name: "Use 'genericReplicate' from Relude"
note: "'genericReplicate' is already exported from Relude"
rhs: genericReplicate
- warn:
lhs: Data.List.genericSplitAt
name: "Use 'genericSplitAt' from Relude"
note: "'genericSplitAt' is already exported from Relude"
rhs: genericSplitAt
- warn:
lhs: Data.List.genericTake
name: "Use 'genericTake' from Relude"
note: "'genericTake' is already exported from Relude"
rhs: genericTake
- warn:
lhs: Data.List.group
name: "Use 'group' from Relude"
note: "'group' is already exported from Relude"
rhs: group
- warn:
lhs: Data.List.inits
name: "Use 'inits' from Relude"
note: "'inits' is already exported from Relude"
rhs: inits
- warn:
lhs: Data.List.intercalate
name: "Use 'intercalate' from Relude"
note: "'intercalate' is already exported from Relude"
rhs: intercalate
- warn:
lhs: Data.List.intersperse
name: "Use 'intersperse' from Relude"
note: "'intersperse' is already exported from Relude"
rhs: intersperse
- warn:
lhs: Data.List.isPrefixOf
name: "Use 'isPrefixOf' from Relude"
note: "'isPrefixOf' is already exported from Relude"
rhs: isPrefixOf
- warn:
lhs: Data.List.permutations
name: "Use 'permutations' from Relude"
note: "'permutations' is already exported from Relude"
rhs: permutations
- warn:
lhs: "Data.List.scanl'"
name: "Use 'scanl'' from Relude"
note: "'scanl'' is already exported from Relude"
rhs: "scanl'"
- warn:
lhs: Data.List.sort
name: "Use 'sort' from Relude"
note: "'sort' is already exported from Relude"
rhs: sort
- warn:
lhs: Data.List.sortBy
name: "Use 'sortBy' from Relude"
note: "'sortBy' is already exported from Relude"
rhs: sortBy
- warn:
lhs: Data.List.sortOn
name: "Use 'sortOn' from Relude"
note: "'sortOn' is already exported from Relude"
rhs: sortOn
- warn:
lhs: Data.List.subsequences
name: "Use 'subsequences' from Relude"
note: "'subsequences' is already exported from Relude"
rhs: subsequences
- warn:
lhs: Data.List.tails
name: "Use 'tails' from Relude"
note: "'tails' is already exported from Relude"
rhs: tails
- warn:
lhs: Data.List.transpose
name: "Use 'transpose' from Relude"
note: "'transpose' is already exported from Relude"
rhs: transpose
- warn:
lhs: Data.List.uncons
name: "Use 'uncons' from Relude"
note: "'uncons' is already exported from Relude"
rhs: uncons
- warn:
lhs: Data.List.unfoldr
name: "Use 'unfoldr' from Relude"
note: "'unfoldr' is already exported from Relude"
rhs: unfoldr
- warn:
lhs: Data.List.NonEmpty.NonEmpty
name: "Use 'NonEmpty' from Relude"
note: "'NonEmpty' is already exported from Relude"
rhs: NonEmpty
- warn:
lhs: "(Data.List.NonEmpty.:|)"
name: "Use ':|' from Relude"
note: "Operator '(:|)' is already exported from Relude"
rhs: "(:|)"
- warn:
lhs: Data.List.NonEmpty.nonEmpty
name: "Use 'nonEmpty' from Relude"
note: "'nonEmpty' is already exported from Relude"
rhs: nonEmpty
- warn:
lhs: Data.List.NonEmpty.head
name: "Use 'head' from Relude"
note: "'head' is already exported from Relude"
rhs: head
- warn:
lhs: Data.List.NonEmpty.init
name: "Use 'init' from Relude"
note: "'init' is already exported from Relude"
rhs: init
- warn:
lhs: Data.List.NonEmpty.last
name: "Use 'last' from Relude"
note: "'last' is already exported from Relude"
rhs: last
- warn:
lhs: Data.List.NonEmpty.tail
name: "Use 'tail' from Relude"
note: "'tail' is already exported from Relude"
rhs: tail
- warn:
lhs: GHC.Exts.sortWith
name: "Use 'sortWith' from Relude"
note: "'sortWith' is already exported from Relude"
rhs: sortWith
- warn:
lhs: Control.Monad.Except.ExceptT
name: "Use 'ExceptT' from Relude"
note: "'ExceptT' is already exported from Relude"
rhs: ExceptT
- warn:
lhs: Control.Monad.Except.runExceptT
name: "Use 'runExceptT' from Relude"
note: "'runExceptT' is already exported from Relude"
rhs: runExceptT
- warn:
lhs: Control.Monad.Reader.MonadReader
name: "Use 'MonadReader' from Relude"
note: "'MonadReader' is already exported from Relude"
rhs: MonadReader
- warn:
lhs: Control.Monad.Reader.Reader
name: "Use 'Reader' from Relude"
note: "'Reader' is already exported from Relude"
rhs: Reader
- warn:
lhs: Control.Monad.Reader.ReaderT
name: "Use 'ReaderT' from Relude"
note: "'ReaderT' is already exported from Relude"
rhs: ReaderT
- warn:
lhs: Control.Monad.Reader.runReaderT
name: "Use 'runReaderT' from Relude"
note: "'runReaderT' is already exported from Relude"
rhs: runReaderT
- warn:
lhs: Control.Monad.Reader.ask
name: "Use 'ask' from Relude"
note: "'ask' is already exported from Relude"
rhs: ask
- warn:
lhs: Control.Monad.Reader.asks
name: "Use 'asks' from Relude"
note: "'asks' is already exported from Relude"
rhs: asks
- warn:
lhs: Control.Monad.Reader.local
name: "Use 'local' from Relude"
note: "'local' is already exported from Relude"
rhs: local
- warn:
lhs: Control.Monad.Reader.reader
name: "Use 'reader' from Relude"
note: "'reader' is already exported from Relude"
rhs: reader
- warn:
lhs: Control.Monad.Reader.runReader
name: "Use 'runReader' from Relude"
note: "'runReader' is already exported from Relude"
rhs: runReader
- warn:
lhs: Control.Monad.Reader.withReader
name: "Use 'withReader' from Relude"
note: "'withReader' is already exported from Relude"
rhs: withReader
- warn:
lhs: Control.Monad.Reader.withReaderT
name: "Use 'withReaderT' from Relude"
note: "'withReaderT' is already exported from Relude"
rhs: withReaderT
- warn:
lhs: Control.Monad.State.Strict.MonadState
name: "Use 'MonadState' from Relude"
note: "'MonadState' is already exported from Relude"
rhs: MonadState
- warn:
lhs: Control.Monad.State.Strict.State
name: "Use 'State' from Relude"
note: "'State' is already exported from Relude"
rhs: State
- warn:
lhs: Control.Monad.State.Strict.StateT
name: "Use 'StateT' from Relude"
note: "'StateT' is already exported from Relude"
rhs: StateT
- warn:
lhs: Control.Monad.State.Strict.runStateT
name: "Use 'runStateT' from Relude"
note: "'runStateT' is already exported from Relude"
rhs: runStateT
- warn:
lhs: Control.Monad.State.Strict.evalState
name: "Use 'evalState' from Relude"
note: "'evalState' is already exported from Relude"
rhs: evalState
- warn:
lhs: Control.Monad.State.Strict.evalStateT
name: "Use 'evalStateT' from Relude"
note: "'evalStateT' is already exported from Relude"
rhs: evalStateT
- warn:
lhs: Control.Monad.State.Strict.execState
name: "Use 'execState' from Relude"
note: "'execState' is already exported from Relude"
rhs: execState
- warn:
lhs: Control.Monad.State.Strict.execStateT
name: "Use 'execStateT' from Relude"
note: "'execStateT' is already exported from Relude"
rhs: execStateT
- warn:
lhs: Control.Monad.State.Strict.get
name: "Use 'get' from Relude"
note: "'get' is already exported from Relude"
rhs: get
- warn:
lhs: Control.Monad.State.Strict.gets
name: "Use 'gets' from Relude"
note: "'gets' is already exported from Relude"
rhs: gets
- warn:
lhs: Control.Monad.State.Strict.modify
name: "Use 'modify' from Relude"
note: "'modify' is already exported from Relude"
rhs: modify
- warn:
lhs: "Control.Monad.State.Strict.modify'"
name: "Use 'modify'' from Relude"
note: "'modify'' is already exported from Relude"
rhs: "modify'"
- warn:
lhs: Control.Monad.State.Strict.put
name: "Use 'put' from Relude"
note: "'put' is already exported from Relude"
rhs: put
- warn:
lhs: Control.Monad.State.Strict.runState
name: "Use 'runState' from Relude"
note: "'runState' is already exported from Relude"
rhs: runState
- warn:
lhs: Control.Monad.State.Strict.state
name: "Use 'state' from Relude"
note: "'state' is already exported from Relude"
rhs: state
- warn:
lhs: Control.Monad.State.Strict.withState
name: "Use 'withState' from Relude"
note: "'withState' is already exported from Relude"
rhs: withState
- warn:
lhs: Control.Monad.Trans.MonadIO
name: "Use 'MonadIO' from Relude"
note: "'MonadIO' is already exported from Relude"
rhs: MonadIO
- warn:
lhs: Control.Monad.Trans.MonadTrans
name: "Use 'MonadTrans' from Relude"
note: "'MonadTrans' is already exported from Relude"
rhs: MonadTrans
- warn:
lhs: Control.Monad.Trans.lift
name: "Use 'lift' from Relude"
note: "'lift' is already exported from Relude"
rhs: lift
- warn:
lhs: Control.Monad.Trans.liftIO
name: "Use 'liftIO' from Relude"
note: "'liftIO' is already exported from Relude"
rhs: liftIO
- warn:
lhs: Control.Monad.Trans.Identity.IdentityT
name: "Use 'IdentityT' from Relude"
note: "'IdentityT' is already exported from Relude"
rhs: IdentityT
- warn:
lhs: Control.Monad.Trans.Identity.runIdentityT
name: "Use 'runIdentityT' from Relude"
note: "'runIdentityT' is already exported from Relude"
rhs: runIdentityT
- warn:
lhs: Control.Monad.Trans.Maybe.MaybeT
name: "Use 'MaybeT' from Relude"
note: "'MaybeT' is already exported from Relude"
rhs: MaybeT
- warn:
lhs: Control.Monad.Trans.Maybe.maybeToExceptT
name: "Use 'maybeToExceptT' from Relude"
note: "'maybeToExceptT' is already exported from Relude"
rhs: maybeToExceptT
- warn:
lhs: Control.Monad.Trans.Maybe.exceptToMaybeT
name: "Use 'exceptToMaybeT' from Relude"
note: "'exceptToMaybeT' is already exported from Relude"
rhs: exceptToMaybeT
- warn:
lhs: Control.Monad.MonadPlus
name: "Use 'MonadPlus' from Relude"
note: "'MonadPlus' is already exported from Relude"
rhs: MonadPlus
- warn:
lhs: Control.Monad.mzero
name: "Use 'mzero' from Relude"
note: "'mzero' is already exported from Relude"
rhs: mzero
- warn:
lhs: Control.Monad.mplus
name: "Use 'mplus' from Relude"
note: "'mplus' is already exported from Relude"
rhs: mplus
- warn:
lhs: Control.Monad.filterM
name: "Use 'filterM' from Relude"
note: "'filterM' is already exported from Relude"
rhs: filterM
- warn:
lhs: Control.Monad.forever
name: "Use 'forever' from Relude"
note: "'forever' is already exported from Relude"
rhs: forever
- warn:
lhs: Control.Monad.join
name: "Use 'join' from Relude"
note: "'join' is already exported from Relude"
rhs: join
- warn:
lhs: Control.Monad.mapAndUnzipM
name: "Use 'mapAndUnzipM' from Relude"
note: "'mapAndUnzipM' is already exported from Relude"
rhs: mapAndUnzipM
- warn:
lhs: Control.Monad.mfilter
name: "Use 'mfilter' from Relude"
note: "'mfilter' is already exported from Relude"
rhs: mfilter
- warn:
lhs: Control.Monad.replicateM
name: "Use 'replicateM' from Relude"
note: "'replicateM' is already exported from Relude"
rhs: replicateM
- warn:
lhs: Control.Monad.replicateM_
name: "Use 'replicateM_' from Relude"
note: "'replicateM_' is already exported from Relude"
rhs: replicateM_
- warn:
lhs: Control.Monad.zipWithM
name: "Use 'zipWithM' from Relude"
note: "'zipWithM' is already exported from Relude"
rhs: zipWithM
- warn:
lhs: Control.Monad.zipWithM_
name: "Use 'zipWithM_' from Relude"
note: "'zipWithM_' is already exported from Relude"
rhs: zipWithM_
- warn:
lhs: "(Control.Monad.<$!>)"
name: "Use '<$!>' from Relude"
note: "Operator '(<$!>)' is already exported from Relude"
rhs: "(<$!>)"
- warn:
lhs: "(Control.Monad.<=<)"
name: "Use '<=<' from Relude"
note: "Operator '(<=<)' is already exported from Relude"
rhs: "(<=<)"
- warn:
lhs: "(Control.Monad.=<<)"
name: "Use '=<<' from Relude"
note: "Operator '(=<<)' is already exported from Relude"
rhs: "(=<<)"
- warn:
lhs: "(Control.Monad.>=>)"
name: "Use '>=>' from Relude"
note: "Operator '(>=>)' is already exported from Relude"
rhs: "(>=>)"
- warn:
lhs: Control.Monad.Fail.MonadFail
name: "Use 'MonadFail' from Relude"
note: "'MonadFail' is already exported from Relude"
rhs: MonadFail
- warn:
lhs: Data.Maybe.catMaybes
name: "Use 'catMaybes' from Relude"
note: "'catMaybes' is already exported from Relude"
rhs: catMaybes
- warn:
lhs: Data.Maybe.fromMaybe
name: "Use 'fromMaybe' from Relude"
note: "'fromMaybe' is already exported from Relude"
rhs: fromMaybe
- warn:
lhs: Data.Maybe.isJust
name: "Use 'isJust' from Relude"
note: "'isJust' is already exported from Relude"
rhs: isJust
- warn:
lhs: Data.Maybe.isNothing
name: "Use 'isNothing' from Relude"
note: "'isNothing' is already exported from Relude"
rhs: isNothing
- warn:
lhs: Data.Maybe.listToMaybe
name: "Use 'listToMaybe' from Relude"
note: "'listToMaybe' is already exported from Relude"
rhs: listToMaybe
- warn:
lhs: Data.Maybe.mapMaybe
name: "Use 'mapMaybe' from Relude"
note: "'mapMaybe' is already exported from Relude"
rhs: mapMaybe
- warn:
lhs: Data.Maybe.maybeToList
name: "Use 'maybeToList' from Relude"
note: "'maybeToList' is already exported from Relude"
rhs: maybeToList
- warn:
lhs: Data.Either.isLeft
name: "Use 'isLeft' from Relude"
note: "'isLeft' is already exported from Relude"
rhs: isLeft
- warn:
lhs: Data.Either.isRight
name: "Use 'isRight' from Relude"
note: "'isRight' is already exported from Relude"
rhs: isRight
- warn:
lhs: Data.Either.lefts
name: "Use 'lefts' from Relude"
note: "'lefts' is already exported from Relude"
rhs: lefts
- warn:
lhs: Data.Either.partitionEithers
name: "Use 'partitionEithers' from Relude"
note: "'partitionEithers' is already exported from Relude"
rhs: partitionEithers
- warn:
lhs: Data.Either.rights
name: "Use 'rights' from Relude"
note: "'rights' is already exported from Relude"
rhs: rights
- warn:
lhs: Data.Monoid.All
name: "Use 'All' from Relude"
note: "'All' is already exported from Relude"
rhs: All
- warn:
lhs: Data.Monoid.getAll
name: "Use 'getAll' from Relude"
note: "'getAll' is already exported from Relude"
rhs: getAll
- warn:
lhs: Data.Monoid.Alt
name: "Use 'Alt' from Relude"
note: "'Alt' is already exported from Relude"
rhs: Alt
- warn:
lhs: Data.Monoid.getAlt
name: "Use 'getAlt' from Relude"
note: "'getAlt' is already exported from Relude"
rhs: getAlt
- warn:
lhs: Data.Monoid.Any
name: "Use 'Any' from Relude"
note: "'Any' is already exported from Relude"
rhs: Any
- warn:
lhs: Data.Monoid.getAny
name: "Use 'getAny' from Relude"
note: "'getAny' is already exported from Relude"
rhs: getAny
- warn:
lhs: Data.Monoid.Ap
name: "Use 'Ap' from Relude"
note: "'Ap' is already exported from Relude"
rhs: Ap
- warn:
lhs: Data.Monoid.getAp
name: "Use 'getAp' from Relude"
note: "'getAp' is already exported from Relude"
rhs: getAp
- warn:
lhs: Data.Monoid.Dual
name: "Use 'Dual' from Relude"
note: "'Dual' is already exported from Relude"
rhs: Dual
- warn:
lhs: Data.Monoid.getDual
name: "Use 'getDual' from Relude"
note: "'getDual' is already exported from Relude"
rhs: getDual
- warn:
lhs: Data.Monoid.Endo
name: "Use 'Endo' from Relude"
note: "'Endo' is already exported from Relude"
rhs: Endo
- warn:
lhs: Data.Monoid.appEndo
name: "Use 'appEndo' from Relude"
note: "'appEndo' is already exported from Relude"
rhs: appEndo
- warn:
lhs: Data.Monoid.First
name: "Use 'First' from Relude"
note: "'First' is already exported from Relude"
rhs: First
- warn:
lhs: Data.Monoid.getFirst
name: "Use 'getFirst' from Relude"
note: "'getFirst' is already exported from Relude"
rhs: getFirst
- warn:
lhs: Data.Monoid.Last
name: "Use 'Last' from Relude"
note: "'Last' is already exported from Relude"
rhs: Last
- warn:
lhs: Data.Monoid.getLast
name: "Use 'getLast' from Relude"
note: "'getLast' is already exported from Relude"
rhs: getLast
- warn:
lhs: Data.Monoid.Product
name: "Use 'Product' from Relude"
note: "'Product' is already exported from Relude"
rhs: Product
- warn:
lhs: Data.Monoid.getProduct
name: "Use 'getProduct' from Relude"
note: "'getProduct' is already exported from Relude"
rhs: getProduct
- warn:
lhs: Data.Monoid.Sum
name: "Use 'Sum' from Relude"
note: "'Sum' is already exported from Relude"
rhs: Sum
- warn:
lhs: Data.Monoid.getSum
name: "Use 'getSum' from Relude"
note: "'getSum' is already exported from Relude"
rhs: getSum
- warn:
lhs: Data.Semigroup.Semigroup
name: "Use 'Semigroup' from Relude"
note: "'Semigroup' is already exported from Relude"
rhs: Semigroup
- warn:
lhs: Data.Semigroup.sconcat
name: "Use 'sconcat' from Relude"
note: "'sconcat' is already exported from Relude"
rhs: sconcat
- warn:
lhs: Data.Semigroup.stimes
name: "Use 'stimes' from Relude"
note: "'stimes' is already exported from Relude"
rhs: stimes
- warn:
lhs: "(Data.Semigroup.<>)"
name: "Use '<>' from Relude"
note: "Operator '(<>)' is already exported from Relude"
rhs: "(<>)"
- warn:
lhs: Data.Semigroup.WrappedMonoid
name: "Use 'WrappedMonoid' from Relude"
note: "'WrappedMonoid' is already exported from Relude"
rhs: WrappedMonoid
- warn:
lhs: Data.Semigroup.cycle1
name: "Use 'cycle1' from Relude"
note: "'cycle1' is already exported from Relude"
rhs: cycle1
- warn:
lhs: Data.Semigroup.mtimesDefault
name: "Use 'mtimesDefault' from Relude"
note: "'mtimesDefault' is already exported from Relude"
rhs: mtimesDefault
- warn:
lhs: Data.Semigroup.stimesIdempotent
name: "Use 'stimesIdempotent' from Relude"
note: "'stimesIdempotent' is already exported from Relude"
rhs: stimesIdempotent
- warn:
lhs: Data.Semigroup.stimesIdempotentMonoid
name: "Use 'stimesIdempotentMonoid' from Relude"
note: "'stimesIdempotentMonoid' is already exported from Relude"
rhs: stimesIdempotentMonoid
- warn:
lhs: Data.Semigroup.stimesMonoid
name: "Use 'stimesMonoid' from Relude"
note: "'stimesMonoid' is already exported from Relude"
rhs: stimesMonoid
- warn:
lhs: Data.ByteString.ByteString
name: "Use 'ByteString' from Relude"
note: "'ByteString' is already exported from Relude"
rhs: ByteString
- warn:
lhs: Data.ByteString.Short.ShortByteString
name: "Use 'ShortByteString' from Relude"
note: "'ShortByteString' is already exported from Relude"
rhs: ShortByteString
- warn:
lhs: Data.ByteString.Short.toShort
name: "Use 'toShort' from Relude"
note: "'toShort' is already exported from Relude"
rhs: toShort
- warn:
lhs: Data.ByteString.Short.fromShort
name: "Use 'fromShort' from Relude"
note: "'fromShort' is already exported from Relude"
rhs: fromShort
- warn:
lhs: Data.String.IsString
name: "Use 'IsString' from Relude"
note: "'IsString' is already exported from Relude"
rhs: IsString
- warn:
lhs: Data.String.fromString
name: "Use 'fromString' from Relude"
note: "'fromString' is already exported from Relude"
rhs: fromString
- warn:
lhs: Data.Text.Text
name: "Use 'Text' from Relude"
note: "'Text' is already exported from Relude"
rhs: Text
- warn:
lhs: Data.Text.lines
name: "Use 'lines' from Relude"
note: "'lines' is already exported from Relude"
rhs: lines
- warn:
lhs: Data.Text.unlines
name: "Use 'unlines' from Relude"
note: "'unlines' is already exported from Relude"
rhs: unlines
- warn:
lhs: Data.Text.words
name: "Use 'words' from Relude"
note: "'words' is already exported from Relude"
rhs: words
- warn:
lhs: Data.Text.unwords
name: "Use 'unwords' from Relude"
note: "'unwords' is already exported from Relude"
rhs: unwords
- warn:
lhs: "Data.Text.Encoding.decodeUtf8'"
name: "Use 'decodeUtf8'' from Relude"
note: "'decodeUtf8'' is already exported from Relude"
rhs: "decodeUtf8'"
- warn:
lhs: Data.Text.Encoding.decodeUtf8With
name: "Use 'decodeUtf8With' from Relude"
note: "'decodeUtf8With' is already exported from Relude"
rhs: decodeUtf8With
- warn:
lhs: Data.Text.Encoding.Error.OnDecodeError
name: "Use 'OnDecodeError' from Relude"
note: "'OnDecodeError' is already exported from Relude"
rhs: OnDecodeError
- warn:
lhs: Data.Text.Encoding.Error.OnError
name: "Use 'OnError' from Relude"
note: "'OnError' is already exported from Relude"
rhs: OnError
- warn:
lhs: Data.Text.Encoding.Error.UnicodeException
name: "Use 'UnicodeException' from Relude"
note: "'UnicodeException' is already exported from Relude"
rhs: UnicodeException
- warn:
lhs: Data.Text.Encoding.Error.lenientDecode
name: "Use 'lenientDecode' from Relude"
note: "'lenientDecode' is already exported from Relude"
rhs: lenientDecode
- warn:
lhs: Data.Text.Encoding.Error.strictDecode
name: "Use 'strictDecode' from Relude"
note: "'strictDecode' is already exported from Relude"
rhs: strictDecode
- warn:
lhs: Text.Read.Read
name: "Use 'Read' from Relude"
note: "'Read' is already exported from Relude"
rhs: Read
- warn:
lhs: Text.Read.readMaybe
name: "Use 'readMaybe' from Relude"
note: "'readMaybe' is already exported from Relude"
rhs: readMaybe
- warn:
lhs: "(liftIO (newEmptyMVar ))"
name: "'liftIO' is not needed"
note: "If you import 'newEmptyMVar' from Relude, it's already lifted"
rhs: newEmptyMVar
- warn:
lhs: "(liftIO (newMVar x))"
name: "'liftIO' is not needed"
note: "If you import 'newMVar' from Relude, it's already lifted"
rhs: newMVar
- warn:
lhs: "(liftIO (putMVar x y))"
name: "'liftIO' is not needed"
note: "If you import 'putMVar' from Relude, it's already lifted"
rhs: putMVar
- warn:
lhs: "(liftIO (readMVar x))"
name: "'liftIO' is not needed"
note: "If you import 'readMVar' from Relude, it's already lifted"
rhs: readMVar
- warn:
lhs: "(liftIO (swapMVar x y))"
name: "'liftIO' is not needed"
note: "If you import 'swapMVar' from Relude, it's already lifted"
rhs: swapMVar
- warn:
lhs: "(liftIO (takeMVar x))"
name: "'liftIO' is not needed"
note: "If you import 'takeMVar' from Relude, it's already lifted"
rhs: takeMVar
- warn:
lhs: "(liftIO (tryPutMVar x y))"
name: "'liftIO' is not needed"
note: "If you import 'tryPutMVar' from Relude, it's already lifted"
rhs: tryPutMVar
- warn:
lhs: "(liftIO (tryReadMVar x))"
name: "'liftIO' is not needed"
note: "If you import 'tryReadMVar' from Relude, it's already lifted"
rhs: tryReadMVar
- warn:
lhs: "(liftIO (tryTakeMVar x))"
name: "'liftIO' is not needed"
note: "If you import 'tryTakeMVar' from Relude, it's already lifted"
rhs: tryTakeMVar
- warn:
lhs: "(liftIO (atomically x))"
name: "'liftIO' is not needed"
note: "If you import 'atomically' from Relude, it's already lifted"
rhs: atomically
- warn:
lhs: "(liftIO (newTVarIO x))"
name: "'liftIO' is not needed"
note: "If you import 'newTVarIO' from Relude, it's already lifted"
rhs: newTVarIO
- warn:
lhs: "(liftIO (readTVarIO x))"
name: "'liftIO' is not needed"
note: "If you import 'readTVarIO' from Relude, it's already lifted"
rhs: readTVarIO
- warn:
lhs: "(liftIO (newTMVarIO x))"
name: "'liftIO' is not needed"
note: "If you import 'newTMVarIO' from Relude, it's already lifted"
rhs: newTMVarIO
- warn:
lhs: "(liftIO (newEmptyTMVarIO ))"
name: "'liftIO' is not needed"
note: "If you import 'newEmptyTMVarIO' from Relude, it's already lifted"
rhs: newEmptyTMVarIO
- warn:
lhs: "(liftIO (exitWith x))"
name: "'liftIO' is not needed"
note: "If you import 'exitWith' from Relude, it's already lifted"
rhs: exitWith
- warn:
lhs: "(liftIO (exitFailure ))"
name: "'liftIO' is not needed"
note: "If you import 'exitFailure' from Relude, it's already lifted"
rhs: exitFailure
- warn:
lhs: "(liftIO (exitSuccess ))"
name: "'liftIO' is not needed"
note: "If you import 'exitSuccess' from Relude, it's already lifted"
rhs: exitSuccess
- warn:
lhs: "(liftIO (die x))"
name: "'liftIO' is not needed"
note: "If you import 'die' from Relude, it's already lifted"
rhs: die
- warn:
lhs: "(liftIO (readFile x))"
name: "'liftIO' is not needed"
note: "If you import 'readFile' from Relude, it's already lifted"
rhs: readFile
- warn:
lhs: "(liftIO (writeFile x y))"
name: "'liftIO' is not needed"
note: "If you import 'writeFile' from Relude, it's already lifted"
rhs: writeFile
- warn:
lhs: "(liftIO (appendFile x y))"
name: "'liftIO' is not needed"
note: "If you import 'appendFile' from Relude, it's already lifted"
rhs: appendFile
- warn:
lhs: "(liftIO (readFileText x))"
name: "'liftIO' is not needed"
note: "If you import 'readFileText' from Relude, it's already lifted"
rhs: readFileText
- warn:
lhs: "(liftIO (writeFileText x y))"
name: "'liftIO' is not needed"
note: "If you import 'writeFileText' from Relude, it's already lifted"
rhs: writeFileText
- warn:
lhs: "(liftIO (appendFileText x y))"
name: "'liftIO' is not needed"
note: "If you import 'appendFileText' from Relude, it's already lifted"
rhs: appendFileText
- warn:
lhs: "(liftIO (readFileLText x))"
name: "'liftIO' is not needed"
note: "If you import 'readFileLText' from Relude, it's already lifted"
rhs: readFileLText
- warn:
lhs: "(liftIO (writeFileLText x y))"
name: "'liftIO' is not needed"
note: "If you import 'writeFileLText' from Relude, it's already lifted"
rhs: writeFileLText
- warn:
lhs: "(liftIO (appendFileLText x y))"
name: "'liftIO' is not needed"
note: "If you import 'appendFileLText' from Relude, it's already lifted"
rhs: appendFileLText
- warn:
lhs: "(liftIO (readFileBS x))"
name: "'liftIO' is not needed"
note: "If you import 'readFileBS' from Relude, it's already lifted"
rhs: readFileBS
- warn:
lhs: "(liftIO (writeFileBS x y))"
name: "'liftIO' is not needed"
note: "If you import 'writeFileBS' from Relude, it's already lifted"
rhs: writeFileBS
- warn:
lhs: "(liftIO (appendFileBS x y))"
name: "'liftIO' is not needed"
note: "If you import 'appendFileBS' from Relude, it's already lifted"
rhs: appendFileBS
- warn:
lhs: "(liftIO (readFileLBS x))"
name: "'liftIO' is not needed"
note: "If you import 'readFileLBS' from Relude, it's already lifted"
rhs: readFileLBS
- warn:
lhs: "(liftIO (writeFileLBS x y))"
name: "'liftIO' is not needed"
note: "If you import 'writeFileLBS' from Relude, it's already lifted"
rhs: writeFileLBS
- warn:
lhs: "(liftIO (appendFileLBS x y))"
name: "'liftIO' is not needed"
note: "If you import 'appendFileLBS' from Relude, it's already lifted"
rhs: appendFileLBS
- warn:
lhs: "(liftIO (newIORef x))"
name: "'liftIO' is not needed"
note: "If you import 'newIORef' from Relude, it's already lifted"
rhs: newIORef
- warn:
lhs: "(liftIO (readIORef x))"
name: "'liftIO' is not needed"
note: "If you import 'readIORef' from Relude, it's already lifted"
rhs: readIORef
- warn:
lhs: "(liftIO (writeIORef x y))"
name: "'liftIO' is not needed"
note: "If you import 'writeIORef' from Relude, it's already lifted"
rhs: writeIORef
- warn:
lhs: "(liftIO (modifyIORef x y))"
name: "'liftIO' is not needed"
note: "If you import 'modifyIORef' from Relude, it's already lifted"
rhs: modifyIORef
- warn:
lhs: "(liftIO (modifyIORef' x y))"
name: "'liftIO' is not needed"
note: "If you import 'modifyIORef'' from Relude, it's already lifted"
rhs: "modifyIORef'"
- warn:
lhs: "(liftIO (atomicModifyIORef x y))"
name: "'liftIO' is not needed"
note: "If you import 'atomicModifyIORef' from Relude, it's already lifted"
rhs: atomicModifyIORef
- warn:
lhs: "(liftIO (atomicModifyIORef' x y))"
name: "'liftIO' is not needed"
note: "If you import 'atomicModifyIORef'' from Relude, it's already lifted"
rhs: "atomicModifyIORef'"
- warn:
lhs: "(liftIO (atomicWriteIORef x y))"
name: "'liftIO' is not needed"
note: "If you import 'atomicWriteIORef' from Relude, it's already lifted"
rhs: atomicWriteIORef
- warn:
lhs: "(liftIO (getLine ))"
name: "'liftIO' is not needed"
note: "If you import 'getLine' from Relude, it's already lifted"
rhs: getLine
- warn:
lhs: "(liftIO (print x))"
name: "'liftIO' is not needed"
note: "If you import 'print' from Relude, it's already lifted"
rhs: print
- warn:
lhs: "(liftIO (putStr x))"
name: "'liftIO' is not needed"
note: "If you import 'putStr' from Relude, it's already lifted"
rhs: putStr
- warn:
lhs: "(liftIO (putStrLn x))"
name: "'liftIO' is not needed"
note: "If you import 'putStrLn' from Relude, it's already lifted"
rhs: putStrLn
- warn:
lhs: "(liftIO (putText x))"
name: "'liftIO' is not needed"
note: "If you import 'putText' from Relude, it's already lifted"
rhs: putText
- warn:
lhs: "(liftIO (putTextLn x))"
name: "'liftIO' is not needed"
note: "If you import 'putTextLn' from Relude, it's already lifted"
rhs: putTextLn
- warn:
lhs: "(liftIO (putLText x))"
name: "'liftIO' is not needed"
note: "If you import 'putLText' from Relude, it's already lifted"
rhs: putLText
- warn:
lhs: "(liftIO (putLTextLn x))"
name: "'liftIO' is not needed"
note: "If you import 'putLTextLn' from Relude, it's already lifted"
rhs: putLTextLn
- warn:
lhs: "(liftIO (putBS x))"
name: "'liftIO' is not needed"
note: "If you import 'putBS' from Relude, it's already lifted"
rhs: putBS
- warn:
lhs: "(liftIO (putBSLn x))"
name: "'liftIO' is not needed"
note: "If you import 'putBSLn' from Relude, it's already lifted"
rhs: putBSLn
- warn:
lhs: "(liftIO (putLBS x))"
name: "'liftIO' is not needed"
note: "If you import 'putLBS' from Relude, it's already lifted"
rhs: putLBS
- warn:
lhs: "(liftIO (putLBSLn x))"
name: "'liftIO' is not needed"
note: "If you import 'putLBSLn' from Relude, it's already lifted"
rhs: putLBSLn
- warn:
lhs: "(liftIO (hFlush x))"
name: "'liftIO' is not needed"
note: "If you import 'hFlush' from Relude, it's already lifted"
rhs: hFlush
- warn:
lhs: "(liftIO (hIsEOF x))"
name: "'liftIO' is not needed"
note: "If you import 'hIsEOF' from Relude, it's already lifted"
rhs: hIsEOF
- warn:
lhs: "(liftIO (hSetBuffering x y))"
name: "'liftIO' is not needed"
note: "If you import 'hSetBuffering' from Relude, it's already lifted"
rhs: hSetBuffering
- warn:
lhs: "(liftIO (hGetBuffering x))"
name: "'liftIO' is not needed"
note: "If you import 'hGetBuffering' from Relude, it's already lifted"
rhs: hGetBuffering
- warn:
lhs: "(liftIO (getArgs ))"
name: "'liftIO' is not needed"
note: "If you import 'getArgs' from Relude, it's already lifted"
rhs: getArgs
- warn:
lhs: "(liftIO (lookupEnv x))"
name: "'liftIO' is not needed"
note: "If you import 'lookupEnv' from Relude, it's already lifted"
rhs: lookupEnv
- hint:
lhs: "fmap (bimap f g)"
note: "Use `bimapF` from `Relude.Extra.Bifunctor`"
rhs: bimapF f g
- hint:
lhs: "bimap f g <$> x"
note: "Use `bimapF` from `Relude.Extra.Bifunctor`"
rhs: bimapF f g x
- hint:
lhs: "fmap (first f)"
note: "Use `firstF` from `Relude.Extra.Bifunctor`"
rhs: firstF f
- hint:
lhs: fmap . first
note: "Use `firstF` from `Relude.Extra.Bifunctor`"
rhs: firstF
- hint:
lhs: "fmap (second f)"
note: "Use `secondF` from `Relude.Extra.Bifunctor`"
rhs: secondF f
- hint:
lhs: fmap . second
note: "Use `secondF` from `Relude.Extra.Bifunctor`"
rhs: secondF
- hint:
lhs: "[minBound .. maxBound]"
note: "Use `universe` from `Relude.Extra.Enum`"
rhs: universe
- hint:
lhs: succ
note: "`succ` from `Prelude` is a pure function but it may throw exception. Consider using `next` from `Relude.Extra.Enum` instead."
rhs: next
- hint:
lhs: pred
note: "`pred` from `Prelude` is a pure function but it may throw exception. Consider using `prev` from `Relude.Extra.Enum` instead."
rhs: prev
- hint:
lhs: toEnum
note: "`toEnum` from `Prelude` is a pure function but it may throw exception. Consider using `safeToEnum` from `Relude.Extra.Enum` instead."
rhs: safeToEnum
- hint:
lhs: sum xs / length xs
note: "Use `average` from `Relude.Extra.Foldable`"
rhs: average xs
- hint:
lhs: "\\a -> (a, a)"
note: "Use `dup` from `Relude.Extra.Tuple`"
rhs: dup
- hint:
lhs: "\\a -> (f a, a)"
note: "Use `toFst` from `Relude.Extra.Tuple`"
rhs: toFst f
- hint:
lhs: "\\a -> (a, f a)"
note: "Use `toSnd` from `Relude.Extra.Tuple`"
rhs: toSnd f
- hint:
lhs: fmap . toFst
note: "Use `fmapToFst` from `Relude.Extra.Tuple`"
rhs: fmapToFst
- hint:
lhs: "fmap (toFst f)"
note: "Use `fmapToFst` from `Relude.Extra.Tuple`"
rhs: fmapToFst f
- hint:
lhs: fmap . toSnd
note: "Use `fmapToSnd` from `Relude.Extra.Tuple`"
rhs: fmapToSnd
- hint:
lhs: "fmap (toSnd f)"
note: "Use `fmapToSnd` from `Relude.Extra.Tuple`"
rhs: fmapToSnd f
- hint:
lhs: map . toFst
note: "Use `fmapToFst` from `Relude.Extra.Tuple`"
rhs: fmapToFst
- hint:
lhs: "map (toFst f)"
note: "Use `fmapToFst` from `Relude.Extra.Tuple`"
rhs: fmapToFst f
- hint:
lhs: map . toSnd
note: "Use `fmapToSnd` from `Relude.Extra.Tuple`"
rhs: fmapToSnd
- hint:
lhs: "map (toSnd f)"
note: "Use `fmapToSnd` from `Relude.Extra.Tuple`"
rhs: fmapToSnd f
- hint:
lhs: "fmap (,a) (f a)"
note: "Use `traverseToFst` from `Relude.Extra.Tuple`"
rhs: traverseToFst f a
- hint:
lhs: "fmap (flip (,) a) (f a)"
note: "Use `traverseToFst` from `Relude.Extra.Tuple`"
rhs: traverseToFst f a
- hint:
lhs: "(,a) <$> f a"
note: "Use `traverseToFst` from `Relude.Extra.Tuple`"
rhs: traverseToFst f a
- hint:
lhs: "flip (,) a <$> f a"
note: "Use `traverseToFst` from `Relude.Extra.Tuple`"
rhs: traverseToFst f a
- hint:
lhs: "fmap (a,) (f a)"
note: "Use `traverseToSnd` from `Relude.Extra.Tuple`"
rhs: traverseToSnd f a
- hint:
lhs: "fmap ((,) a) (f a)"
note: "Use `traverseToSnd` from `Relude.Extra.Tuple`"
rhs: traverseToSnd f a
- hint:
lhs: "(a,) <$> f a"
note: "Use `traverseToSnd` from `Relude.Extra.Tuple`"
rhs: traverseToSnd f a
- hint:
lhs: "(,) a <$> f a"
note: "Use `traverseToSnd` from `Relude.Extra.Tuple`"
rhs: traverseToSnd f a
================================================
FILE: CHANGELOG.md
================================================
# Changelog
All notable changes to this project (as seen by library users) will be documented in this file.
The CHANGELOG is available on [Github](https://github.com/luc-tielen/souffle-haskell.git/CHANGELOG.md).
## [0.2.0] - Unreleased
### Added
- Logical negation (of a single rule clause)
- Typed hole support
- Comparison operators
- Arithmetic operators (`+`, `-`, `*`, `/`)
- Possibility to link in external functions
- LSP support
- Document highlight
- Hover
- Diagnostics
- Improved dead code elimination
- Optimization passes:
- HoistConstraints (faster searches by narrowing search-space as early as possible)
- CLI: Allow emitting initial and transformed RA IR
- Support named fields in type definitions and extern definitions
- Support transpiling to Souffle
- Support running semantic analysis on multiple threads
### Changed
- Relations now can have additional qualifiers marking them as inputs or
outputs. Not providing any qualifier means it is now an internal fact.
### Fixed
- 0 is now parsed correctly as a number.
- Type holes now correctly show all possible results in a rule.
- BTree implementation is now better suited for large sets of facts
## [0.1.0] - 2022-11-20
### Added
- WebAssembly support
- Support for the `string` data type
- Wildcards are now supported in rule bodies
- Assignments are now supported in rule bodies
- Support for multiple occurences of the same variable in a single clause of
a rule body
- (UTF-8) strings in relations are now supported
- Optimizations on the AST level:
- Copy propagation
- Dead code elimination
### Changed
- Improved error reporting
- Parsing now continues after failure and reports multiple errors back to the
user at once.
### Fixed
- Rules with multiple equalities.
- Edgecase in index selection algorithm. The algorithm now does not take
`NoElem` variants into account.
## [0.0.1] - 2022-06-14
### Added
- First MVP of the compiler! The happy path should work as expected, unsupported
features or semantic errors should result in a (poorly formatted) error.
================================================
FILE: CODE_OF_CONDUCT.md
================================================
# Code of Conduct
Contact: luc.tielen@gmail.com
## Why have a Code of Conduct?
As contributors and maintainers of this project, we are committed to providing a
friendly, safe and welcoming environment for all, regardless of age, disability,
gender, nationality, race, religion, sexuality, or similar personal
characteristic.
The goal of the Code of Conduct is to specify a baseline standard of behavior so
that people with different social values and communication styles can talk about
Eclair effectively, productively, and respectfully, even in face of
disagreements. The Code of Conduct also provides a mechanism for resolving
conflicts in the community when they arise.
## Our Values
These are the values Eclair developers should aspire to:
- Be friendly and welcoming
- Be kind
- Remember that people have varying communication styles and that not
everyone is using their native language. (Meaning and tone can be lost in
translation.)
- Interpret the arguments of others in good faith, do not seek to disagree.
- When we do disagree, try to understand why.
- Be thoughtful
- Productive communication requires effort. Think about how your words will
be interpreted.
- Remember that sometimes it is best to refrain entirely from commenting.
- Be respectful
- In particular, respect differences of opinion. It is important that we
resolve disagreements and differing views constructively.
- Be constructive
- Avoid derailing: stay on topic; if you want to talk about something else,
start a new conversation.
- Avoid unconstructive criticism: don't merely decry the current state of
affairs; offer — or at least solicit — suggestions as to how things may be
improved.
- Avoid harsh words and stern tone: we are all aligned towards the
well-being of the community and the progress of the ecosystem. Harsh words
exclude, demotivate, and lead to unnecessary conflict.
- Avoid snarking (pithy, unproductive, sniping comments).
- Avoid microaggressions (brief and commonplace verbal, behavioral and
environmental indignities that communicate hostile, derogatory or negative
slights and insults towards a project, person or group).
- Be responsible
- What you say and do matters. Take responsibility for your words and
actions, including their consequences, whether intended or otherwise.
The following actions are explicitly forbidden:
- Insulting, demeaning, hateful, or threatening remarks.
- Discrimination based on age, disability, gender, nationality, race,
religion, sexuality, or similar personal characteristic.
- Bullying or systematic harassment.
- Unwelcome sexual advances.
- Incitement to any of these.
## Where does the Code of Conduct apply?
If you participate in or contribute to the Eclair ecosystem in any way, you are
encouraged to follow the Code of Conduct while doing so.
Explicit enforcement of the Code of Conduct applies to the official mediums
operated by the Eclair project:
- The [official GitHub project][1] and code reviews.
- The **[#Eclair][2]** Discord[2].
Other Eclair activities (such as conferences, meetups, and unofficial forums)
are encouraged to adopt this Code of Conduct. Such groups must provide their own
contact information.
Project maintainers may block, remove, edit, or reject comments, commits, code,
wiki edits, issues, and other contributions that are not aligned to this Code of
Conduct.
Instances of abusive, harassing, or otherwise unacceptable behavior may be
reported by emailing: luc.tielen@gmail.com. All complaints will
be reviewed and investigated and will result in a response that is deemed
necessary and appropriate to the circumstances. **All reports will be kept
confidential**.
**The goal of the Code of Conduct is to resolve conflicts in the most harmonious
way possible**. We hope that in most cases issues may be resolved through polite
discussion and mutual agreement. Bannings and other forceful measures are to be
employed only as a last resort. **Do not** post about the issue publicly or try
to rally sentiment against a particular individual or group.
## Acknowledgements
This document was based on the Code of Conduct from the Elixir project (dated
Jul/2023), which in turn was based on the Go project (dated Sep/2021) and the
Contributor Covenant (v1.4).
[1]: https://github.com/luc-tielen/eclair-lang
[2]: https://discord.gg/mC2arUrxKg
================================================
FILE: Dockerfile
================================================
FROM primordus/souffle-ubuntu:2.3
ARG LLVM_VERSION=17
SHELL [ "/bin/bash", "-c" ]
# install packages
RUN echo 'tzdata tzdata/Areas select Europe' | debconf-set-selections \
&& echo 'tzdata tzdata/Zones/Europe select Paris' | debconf-set-selections \
&& apt-get update \
&& DEBIAN_FRONTEND=noninteractive apt-get install -y \
wget software-properties-common gnupg curl libffi-dev make \
python3 python3-pip libgmp-dev \
&& curl -o - https://raw.githubusercontent.com/nvm-sh/nvm/v0.39.2/install.sh | bash \
&& source /root/.nvm/nvm.sh \
&& nvm install 18.1.0 \
&& echo "source /root/.ghcup/env" >> ~/.bashrc \
# install llvm 17
&& mkdir -p /tmp/llvm-dir \
&& cd /tmp/llvm-dir \
&& wget https://apt.llvm.org/llvm.sh \
&& chmod +x llvm.sh \
&& ./llvm.sh $LLVM_VERSION \
&& cd /tmp \
&& rm -rf /tmp/llvm-dir \
&& cd /usr/bin \
&& ln -s /usr/lib/llvm-$LLVM_VERSION/bin/split-file \
&& ln -s /usr/lib/llvm-$LLVM_VERSION/bin/FileCheck \
&& ln -s clang-$LLVM_VERSION clang \
&& ln -s wasm-ld-$LLVM_VERSION wasm-ld \
&& cd - \
&& pip install lit==14.0.6 \
# install ghcup, ghc-9.6.3 and cabal-3.10.1.0
&& curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | \
BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3 BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.1.0 \
BOOTSTRAP_HASKELL_INSTALL_STACK=1 BOOTSTRAP_HASKELL_INSTALL_HLS=1 BOOTSTRAP_HASKELL_ADJUST_BASHRC=P sh \
&& source /root/.ghcup/env \
&& cabal install cabal-fmt \
&& cabal install hspec-discover \
&& apt-get autoremove -y \
&& apt-get purge -y --auto-remove \
&& rm -rf /var/lib/apt/lists/*
VOLUME /code
WORKDIR /app/build
ENV DATALOG_DIR=/app/build/cbits
RUN echo -e '#!/bin/bash\nsource /root/.ghcup/env\nsource /root/.nvm/nvm.sh\nexec "$@"\n' > /app/build/entrypoint.sh \
&& chmod u+x /app/build/entrypoint.sh
# The entrypoint script sources ghcup setup script so we can easily call cabal etc.
ENTRYPOINT [ "/app/build/entrypoint.sh" ]
COPY . .
RUN source /root/.ghcup/env && make build \
&& echo -e '#!/bin/bash\nsource /root/.ghcup/env\n' > /usr/bin/eclair \
&& source /root/.ghcup/env \
&& echo -e "`cabal list-bin eclair` \"\$@\"" >> /usr/bin/eclair \
&& chmod u+x /usr/bin/eclair
# The default command to run, shows the help menu
CMD [ "eclair", "--help" ]
================================================
FILE: LICENSE
================================================
Copyright Luc Tielen (c) 2022
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* 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.
* Neither the name of Luc Tielen nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
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
OWNER 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.
================================================
FILE: Makefile
================================================
build: configure
@cabal build
configure:
@cabal configure -f eclair-debug --enable-tests
clean:
@cabal clean
test:
@DATALOG_DIR=cbits/ cabal run eclair-test
@lit tests/ -v
cabal-file:
@cabal-fmt --Werror -i eclair-lang.cabal
.PHONY: build configure clean test cabal-file
================================================
FILE: README.md
================================================
_An experimental and minimal Datalog implementation that compiles down to LLVM._
[](https://github.com/luc-tielen/eclair-lang/actions/workflows/build.yml)
## Features
Eclair is a minimal Datalog (for now). It supports the following features:
- Facts containing literals
- Rules consisting of one or more clauses.
- Rules can be non-recursive, recursive or mutually recursive.
Right now it compiles to LLVM but be aware there might still be bugs.
Some edge cases might not be handled yet.
## Motivating example
Let's say we want to find out which points are reachable in a graph. We can
determine which points are reachable using the following two logical rules:
1. One point is reachable from another point, iff there is a direct edge between
those two points.
2. One point is reachable from another point, iff there is a third point 'z' such
that there is a direct edge between 'x' and 'z', and between 'z' and 'y'.
The Eclair code below can be used to calculate the solution:
```eclair
@def edge(u32, u32).
@def reachable(u32, u32).
reachable(x, y) :-
edge(x, y).
reachable(x, z) :-
edge(x, y),
reachable(y, z).
```
The above code can be compiled to LLVM using the Docker image provided by this repo:
```bash
$ git clone git@github.com:luc-tielen/eclair-lang.git
$ cd eclair-lang
$ docker build . -t eclair
# The next line assumes the eclair code is saved as "example.dl" in the current directory
$ docker run -v $PWD:/code --rm -it eclair:latest compile /code/example.dl
# NOTE: output can be redirected to a file using standard shell functionality: docker run ... > example.ll
```
This will emit the generated LLVM IR to the stdout of the terminal. If we save
this generated LLVM IR to a file (e.g. `example.ll`), we can link it with the
following C code that calls into Eclair, using the following command:
`clang -o program main.c example.ll`.
```c
// Save this file as "main.c".
#include
#include
#include
#include
struct program;
extern struct program* eclair_program_init();
extern void eclair_program_destroy(struct program*);
extern void eclair_program_run(struct program*);
extern void eclair_add_facts(struct program*, uint16_t fact_type, uint32_t* data, size_t fact_count);
extern void eclair_add_fact(struct program*, uint16_t fact_type, uint32_t* data);
extern uint32_t* eclair_get_facts(struct program*, uint16_t fact_type);
extern void eclair_free_buffer(uint32_t* data);
int main(int argc, char** argv)
{
struct program* prog = eclair_program_init();
// edge(1,2), edge(2,3)
uint32_t data[] = {
1, 2,
2, 3
};
eclair_add_facts(prog, 0, data, 2);
eclair_program_run(prog);
// NOTE: normally you call btree_size here to figure out the size, but I know there are only 3 facts
uint32_t* data_out = eclair_get_facts(prog, 1);
printf("REACHABLE: (%d, %d)\n", data_out[0], data_out[1]); // (1,2)
printf("REACHABLE: (%d, %d)\n", data_out[2], data_out[3]); // (2,3)
printf("REACHABLE: (%d, %d)\n", data_out[4], data_out[5]); // (1,3)
eclair_free_buffer(data_out);
eclair_program_destroy(prog);
return 0;
}
```
If you run the resulting program, this should print the reachable node pairs
`(1,2)`, `(2,3)` and `(1,3)` to the screen!
## Roadmap
- [x] LSP support
- [x] Allow setting options on relations for performance finetuning
- [x] Comparison operators, != operator
- [x] Support arithmetic operators
- [x] Generic, extensible primops
- [x] Support logical negation
- [ ] Release 0.2.0
- [ ] Signed integer type (i32)
- [ ] Unary negation
- [ ] Optimizations on the AST / RA / LLVM level
- [ ] Support other underlying data structures than btree
- [ ] Syntactic sugar (disjunctions in rule bodies, multiple rule heads, ...)
- [ ] Support Datalog programs spanning multiple files
- [ ] ...
This roadmap is not set in stone, but it gives an idea on the direction of the
project. :smile:
## Contributing to Eclair
Contributions are welcome! Take a look at the
[getting started guide](./docs/getting_started.md) on how to set up your machine
to build, run and test the project. Once setup, the Makefile contains the most
commonly used commands needed during development.
You can also use the `Dockerfile` in this repository if you want to experiment
with Eclair without installing the toolchain yourself. You can do that as
follows:
```bash
$ docker build -f Dockerfile . -t eclair
$ touch test.eclair # Here you can put your Eclair code
$ docker run -v $PWD:/code --rm -it eclair eclair compile /code/test.eclair
```
## Documentation
Take a look at our [docs folder](./docs/) for more information about Eclair.
## Why the name?
Eclair is inspired by [Soufflé](https://souffle-lang.github.io/), a high
performance Datalog that compiles to C++. Because of the similarities, I chose a
different kind of food that I like. I mean, an eclair contains _both_ chocolate and
pudding, what's not to like!?
Logo art by [Bruno Monts](https://www.instagram.com/bruno_monts/),
with special thanks to the [Fission](https://fission.codes) team.
Please contact Luc Tielen before using the logo for anything.
================================================
FILE: cabal.project
================================================
packages: .
source-repository-package
type: git
location: https://github.com/luc-tielen/llvm-codegen.git
tag: 83b04cb576208ea74ddd62016e4fa03f0df138ac
source-repository-package
type: git
location: https://github.com/luc-tielen/souffle-haskell.git
tag: e441c84f1d64890e31c92fbb278c074ae8bcaff5
source-repository-package
type: git
location: https://github.com/luc-tielen/diagnose.git
tag: 24a1d7a2b716d74c1fe44d47941a76c9f5a90c23
================================================
FILE: cbits/semantic_analysis.dl
================================================
// Input facts
.decl lit_number(node_id: unsigned, value: unsigned)
.decl lit_string(node_id: unsigned, value: symbol)
.decl variable(node_id: unsigned, var_name: symbol)
.decl constraint(node_id: unsigned, op: symbol, lhs_node_id: unsigned, rhs_node_id: unsigned)
.decl binop(node_id: unsigned, op: symbol, lhs_node_id: unsigned, rhs_node_id: unsigned)
.decl atom(node_id: unsigned, name: symbol)
.decl atom_arg(atom_id: unsigned, atom_arg_pos: unsigned, atom_arg_id: unsigned)
.decl rule(rule_id: unsigned, name: symbol)
.decl rule_arg(rule_id: unsigned, rule_arg_pos: unsigned, rule_arg_id: unsigned)
.decl rule_clause(rule_id: unsigned, rule_clause_pos: unsigned, rule_clause_id: unsigned)
.decl negation(negation_node_id: unsigned, inner_node_id: unsigned)
.decl input_relation(relation_name: symbol)
.decl output_relation(relation_name: symbol)
.decl internal_relation(relation_name: symbol)
.decl extern_definition(node_id: unsigned, extern_name: symbol)
.decl declare_type(node_id: unsigned, name: symbol)
.decl module(node_id: unsigned)
.decl module_declaration(module_id: unsigned, declaration_id: unsigned)
.decl scoped_value(scope_id: unsigned, value_id: unsigned)
// Internal rules
.decl relation_atom(node_id: unsigned, name: symbol)
.decl extern_atom(node_id: unsigned, name: symbol)
.decl grounded_node(rule_node_id: unsigned, node_id: unsigned)
.decl assign(node_id: unsigned, lhs_node_id: unsigned, rhs_node_id: unsigned) inline
.decl inequality_op(op: symbol)
.decl has_output_relation(node_id: unsigned)
.decl literal_contradiction(lit_id1: unsigned, lit_id2: unsigned)
.decl wildcard(node_id: unsigned) inline
.decl rule_head_var(rule_id: unsigned, var_id: unsigned, var_name: symbol)
.decl alias(rule_id: unsigned, id1: unsigned, id2: unsigned)
.decl points_to(rule_id: unsigned, id1: unsigned, id2: unsigned)
.decl depends_on(r1: symbol, r2: symbol)
.decl transitive_depends_on(r1: symbol, r2: symbol)
.decl source(r: symbol)
.decl has_definitions(relation: symbol)
.decl live_rule(relation: symbol)
.decl dependency_cycle(relation: symbol)
.decl rule_scope(rule_id: unsigned, scope_id: unsigned)
.decl constrained_rule_var(rule_node_id: unsigned, var_node_id: unsigned, var_name: symbol)
// Output facts / rules
.decl grounded_variable(rule_id: unsigned, var_name: symbol)
.decl ungrounded_variable(rule_id: unsigned, var_id: unsigned, var_name: symbol)
.decl ungrounded_external_atom(rule_id: unsigned, atom_id: unsigned, atom_name: symbol)
.decl wildcard_in_fact(fact_node_id: unsigned, fact_arg_id: unsigned, pos: unsigned)
.decl wildcard_in_extern(atom_node_id: unsigned, atom_arg_id: unsigned, pos: unsigned)
.decl wildcard_in_rule_head(rule_node_id: unsigned, rule_arg_id: unsigned, pos: unsigned)
.decl wildcard_in_constraint(constraint_node_id: unsigned, wildcard_node_id: unsigned)
.decl wildcard_in_binop(binop_node_id: unsigned, wildcard_node_id: unsigned)
.decl unconstrained_rule_var(rule_node_id: unsigned, var_node_id: unsigned, var_name: symbol)
.decl rule_with_contradiction(rule_id: unsigned)
.decl dead_code(node_id: unsigned)
.decl no_output_relation(node_id: unsigned)
.decl dead_internal_relation(node_id: unsigned, relation_name: symbol)
.decl conflicting_definitions(node_id1: unsigned, node_id2: unsigned, name: symbol)
.decl extern_used_as_fact(node_id: unsigned, extern_node_id: unsigned, name: symbol)
.decl extern_used_as_rule(node_id: unsigned, extern_node_id: unsigned, name: symbol)
.decl cyclic_negation(negation_id: unsigned)
.input lit_number
.input lit_string
.input variable
.input constraint
.input binop
.input atom
.input atom_arg
.input rule
.input rule_arg
.input rule_clause
.input negation
.input input_relation
.input output_relation
.input internal_relation
.input extern_definition
.input declare_type
.input module
.input module_declaration
.input scoped_value
.output wildcard_in_fact
.output wildcard_in_extern
.output ungrounded_variable
.output ungrounded_external_atom
.output wildcard_in_rule_head
.output wildcard_in_constraint
.output wildcard_in_binop
.output unconstrained_rule_var
.output dead_code
.output no_output_relation
.output dead_internal_relation
.output conflicting_definitions
.output extern_used_as_fact
.output extern_used_as_rule
.output cyclic_negation
// An atom that is not defined externally. This is an important distinction
// since external atoms cannot ground variables!
relation_atom(node_id, name) :-
declare_type(_, name),
atom(node_id, name).
// An atom that is defined externally.
extern_atom(node_id, name) :-
extern_definition(_, name),
atom(node_id, name).
// r1 depends on r2 if rule r1 refers to r2 in the body
depends_on(r1, r2) :-
rule(rule_id, r1),
rule_clause(rule_id, _, clause_id),
atom(clause_id, r2).
// Variant for negated atoms.
depends_on(r1, r2) :-
rule(rule_id, r1),
rule_clause(rule_id, _, negation_id),
negation(negation_id, atom_id),
atom(atom_id, r2).
// Variant for extern functions.
depends_on(r1, r2) :-
rule(rule_id, r1),
rule_clause(rule_id, _, assign_id),
assign(assign_id, lhs_node_id, rhs_node_id),
(
extern_atom(lhs_node_id, r2);
extern_atom(rhs_node_id, r2)
).
transitive_depends_on(r1, r2) :-
depends_on(r1, r2).
transitive_depends_on(r1, r3) :-
depends_on(r1, r2),
transitive_depends_on(r2, r3).
// Rules have cyclic dependencies if a rule depends on itself (transitively)
dependency_cycle(r) :-
transitive_depends_on(r, r).
// Negations are not allowed inside a rule if the negated atom is part of a
// dependency cycle since this is not stratifiable.
cyclic_negation(negation_id) :-
dependency_cycle(r1),
transitive_depends_on(r1, r2),
rule(rule_id, r2),
rule_clause(rule_id, _, negation_id),
negation(negation_id, atom_id),
atom(atom_id, r3),
transitive_depends_on(r3, r1).
// An input can always be a source of data.
source(r) :-
input_relation(r).
// An internal or output relation can be a source of data if they define top level facts.
source(r) :-
module_declaration(_, atom_id),
atom(atom_id, r),
!input_relation(r). // internal or output relation
// An output rule is live if it is a direct source of data.
live_rule(r) :-
output_relation(r),
source(r).
// An output rule is live if there is a path from the source to this output.
live_rule(r1) :-
output_relation(r1),
transitive_depends_on(r1, r2),
source(r2).
// A rule is live if it is depended on by another live rule.
live_rule(r2) :-
depends_on(r1, r2),
live_rule(r1).
// Dead rules are the opposite set of all the live rules.
dead_code(node_id) :-
rule(node_id, r),
!live_rule(r).
// Type definitions also need to be marked as dead.
dead_code(node_id) :-
declare_type(node_id, r),
!live_rule(r).
// Extern definitions also need to be marked as dead.
dead_code(node_id) :-
extern_definition(node_id, r),
!live_rule(r).
// Atoms too.
dead_code(node_id) :-
atom(node_id, r),
!live_rule(r).
// Rules are dead if one of the clauses is statically known to produce no results.
dead_code(rule_id) :-
rule_with_contradiction(rule_id).
// A rule is dead if it depends on another dead rule.
// Note that this only looks at one specific rule that contains the dead code, not the entire relation.
dead_code(rule_id) :-
rule_clause(rule_id, _, rule_clause_id),
dead_code(rule_clause_id).
has_definitions(r) :-
module_declaration(_, node_id),
(
atom(node_id, r);
rule(node_id, r)
).
// We consider an internal relation to be dead if there are no top level atoms or rules.
dead_internal_relation(decl_id, r) :-
internal_relation(r),
declare_type(decl_id, r),
!has_definitions(r).
has_output_relation(node_id) :-
module_declaration(node_id, decl_id),
declare_type(decl_id, r),
output_relation(r).
no_output_relation(node_id) :-
module_declaration(node_id, _),
!has_output_relation(node_id).
// Top level facts: no variables allowed
ungrounded_variable(atom_id, var_id, var_name) :-
module_declaration(_, atom_id),
atom(atom_id, _),
scoped_value(atom_id, var_id),
variable(var_id, var_name),
var_name != "_".
// Rules: no variables allowed in rule head if not used in a rule clause
ungrounded_variable(rule_id, var_id, var_name) :-
rule_head_var(rule_id, var_id, var_name),
var_name != "_",
!grounded_variable(rule_id, var_name). // Only compare by variable name!
// Variables used in a constraint (comparison, equality or inequality) need to be grounded.
ungrounded_variable(rule_id, var_id, var_name) :-
rule_clause(rule_id, _, rule_clause_id),
constraint(rule_clause_id, op, var_id, _),
variable(var_id, var_name),
var_name != "_",
!grounded_variable(rule_id, var_name).
ungrounded_variable(rule_id, var_id, var_name) :-
rule_clause(rule_id, _, rule_clause_id),
constraint(rule_clause_id, op, _, var_id),
variable(var_id, var_name),
var_name != "_",
!grounded_variable(rule_id, var_name).
// Variables used in a binop need to be grounded.
ungrounded_variable(rule_id, var_id, var_name) :-
binop(_, _, var_id, _),
variable(var_id, var_name),
scoped_value(scope_id, var_id),
rule_scope(rule_id, scope_id),
!grounded_variable(rule_id, var_name).
ungrounded_variable(rule_id, var_id, var_name) :-
binop(_, _, _, var_id),
variable(var_id, var_name),
scoped_value(scope_id, var_id),
rule_scope(rule_id, scope_id),
!grounded_variable(rule_id, var_name).
// Variables used in a negation need to be grounded.
ungrounded_variable(rule_id, var_id, var_name) :-
negation(negation_id, _),
rule_clause(rule_id, _, negation_id),
scoped_value(negation_id, var_id),
variable(var_id, var_name),
!grounded_node(rule_id, var_id).
// External atoms used in a fact need to be grounded.
ungrounded_external_atom(fact_id, atom_id, atom_name) :-
module_declaration(_, fact_id),
atom_arg(fact_id, _, atom_id),
extern_atom(atom_id, atom_name),
!grounded_node(fact_id, atom_id).
// External atoms used in a rule head need to be grounded.
ungrounded_external_atom(rule_id, atom_id, atom_name) :-
rule_arg(rule_id, _, atom_id),
atom(atom_id, atom_name),
scoped_value(rule_id, atom_id),
!grounded_node(rule_id, atom_id).
// External atoms used in a comparison or inequality need to be grounded.
ungrounded_external_atom(rule_id, atom_id, atom_name) :-
rule_clause(rule_id, _, rule_clause_id),
constraint(rule_clause_id, op, _, atom_id),
inequality_op(op),
atom(atom_id, atom_name),
scoped_value(rule_id, atom_id),
!grounded_node(rule_id, atom_id).
ungrounded_external_atom(rule_id, atom_id, atom_name) :-
rule_clause(rule_id, _, rule_clause_id),
constraint(rule_clause_id, op, atom_id, _),
inequality_op(op),
atom(atom_id, atom_name),
scoped_value(rule_id, atom_id),
!grounded_node(rule_id, atom_id).
// External atoms used in a binop need to be grounded.
ungrounded_external_atom(rule_id, atom_id, atom_name) :-
binop(_, _, _, atom_id),
atom(atom_id, atom_name),
scoped_value(rule_id, atom_id),
!grounded_node(rule_id, atom_id).
ungrounded_external_atom(rule_id, atom_id, atom_name) :-
binop(_, _, atom_id, _),
atom(atom_id, atom_name),
scoped_value(rule_id, atom_id),
!grounded_node(rule_id, atom_id).
rule_scope(rule_id, rule_id) :-
rule(rule_id, _).
rule_scope(rule_id, negation_id) :-
rule_clause(rule_id, _, negation_id),
negation(negation_id, _).
inequality_op("!=").
inequality_op("<").
inequality_op("<=").
inequality_op(">").
inequality_op(">=").
wildcard(node_id) :-
variable(node_id, "_").
wildcard_in_rule_head(rule_id, rule_arg_id, pos) :-
rule_arg(rule_id, pos, rule_arg_id),
wildcard(rule_arg_id).
wildcard_in_fact(atom_id, atom_arg_id, pos) :-
module_declaration(_, atom_id),
atom_arg(atom_id, pos, atom_arg_id),
wildcard(atom_arg_id).
wildcard_in_extern(atom_id, atom_arg_id, pos) :-
rule(rule_id, _),
scoped_value(rule_id, atom_id),
extern_atom(atom_id, _),
atom_arg(atom_id, pos, atom_arg_id),
wildcard(atom_arg_id).
wildcard_in_constraint(constraint_node_id, lhs_node_id) :-
constraint(constraint_node_id, _, lhs_node_id, _),
wildcard(lhs_node_id).
wildcard_in_constraint(constraint_node_id, rhs_node_id) :-
constraint(constraint_node_id, _, _, rhs_node_id),
wildcard(rhs_node_id).
wildcard_in_binop(binop_node_id, lhs_node_id) :-
binop(binop_node_id, _, lhs_node_id, _),
wildcard(lhs_node_id).
wildcard_in_binop(binop_node_id, rhs_node_id) :-
binop(binop_node_id, _, _, rhs_node_id),
wildcard(rhs_node_id).
// A rule variable is unconstrained if there is no other occurrence of the variable in the rule.
// (This works because groundedness of a variable is also checked..
unconstrained_rule_var(rule_id, var_id, var_name) :-
rule_scope(rule_id, scope_id),
scoped_value(scope_id, var_id),
variable(var_id, var_name),
!constrained_rule_var(rule_id, var_id, var_name).
// This could be done much simpler using count aggregate but this is not implemented in Eclair yet.
constrained_rule_var(rule_id, var_id1, var_name) :-
rule_scope(rule_id, scope_id1),
rule_scope(rule_id, scope_id2),
scoped_value(scope_id1, var_id1),
scoped_value(scope_id2, var_id2),
variable(var_id1, var_name),
variable(var_id2, var_name),
var_id1 != var_id2.
assign(node_id, lhs_node_id, rhs_node_id) :-
constraint(node_id, "=", lhs_node_id, rhs_node_id).
// All variables with the same name in a rule are aliases of each other.
alias(rule_id, var_id1, var_id2) :-
scoped_value(rule_id, var_id1),
variable(var_id1, var_name),
scoped_value(rule_id, var_id2),
var_id1 != var_id2,
variable(var_id2, var_name).
// Two values are aliases if they are used inside an equality.
// NOTE: Datalog supports both x = 123 and 123 = x.
alias(rule_id, id1, id2),
alias(rule_id, id2, id1) :-
rule_clause(rule_id, _, rule_clause_id),
assign(rule_clause_id, id1, id2).
// Non-recursive case: what does a variable point to?
points_to(rule_id, id1, id2) :-
alias(rule_id, id1, id2),
variable(id1, _).
// Recursive case: a = b, b = c results in a = c
points_to(rule_id, id1, id4) :-
points_to(rule_id, id1, id2),
variable(id2, var_name),
variable(id3, var_name),
alias(rule_id, id3, id4).
// If we find two variables that point to different literal values,
// then there is a contradiction.
rule_with_contradiction(rule_id) :-
points_to(rule_id, start_id, id1),
points_to(rule_id, start_id, id2),
literal_contradiction(id1, id2).
// This is also true for simple cases like '123 = 456'.
rule_with_contradiction(rule_id) :-
rule_clause(rule_id, _, rule_clause_id),
assign(rule_clause_id, id1, id2),
literal_contradiction(id1, id2).
literal_contradiction(id1, id2) :-
lit_number(id1, value1),
lit_number(id2, value2),
value1 != value2.
literal_contradiction(id1, id2) :-
lit_string(id1, value1),
lit_string(id2, value2),
value1 != value2.
// Helper relation for getting all variables in head of a rule.
rule_head_var(rule_id, var_id, var_name) :-
rule_arg(rule_id, _, var_id),
variable(var_id, var_name).
// Helper relation for getting all grounded variables in body of a rule.
grounded_variable(rule_id, var_name) :-
grounded_node(rule_id, var_id),
variable(var_id, var_name).
// Variables are grounded if they are used in an atom (defined using '@def').
grounded_node(rule_id, var_id) :-
rule_clause(rule_id, _, rule_clause_id),
relation_atom(rule_clause_id, _),
atom_arg(rule_clause_id, _, var_id),
variable(var_id, _).
// All variables with same name are grounded at the same time
grounded_node(rule_id, var_id2) :-
scoped_value(rule_id, var_id1),
variable(var_id1, var_name),
grounded_node(rule_id, var_id1),
scoped_value(rule_id, var_id2),
variable(var_id2, var_name).
// Variables are grounded inside a negation if they are grounded in another clause.
grounded_node(rule_id, var_id2) :-
negation(negation_id, _),
rule_clause(rule_id, _, negation_id),
scoped_value(rule_id, var_id1),
variable(var_id1, var_name),
grounded_node(rule_id, var_id1),
scoped_value(negation_id, var_id2),
variable(var_id2, var_name).
// Literals are always grounded.
grounded_node(rule_id, node_id) :-
scoped_value(rule_id, node_id),
lit_number(node_id, _).
grounded_node(rule_id, node_id) :-
scoped_value(rule_id, node_id),
lit_string(node_id, _).
// A binop is grounded if both sides are grounded.
grounded_node(rule_id, node_id) :-
grounded_node(rule_id, lhs_node_id),
grounded_node(rule_id, rhs_node_id),
binop(node_id, _, lhs_node_id, rhs_node_id).
// Assignment grounds one var, if the other side is already grounded.
grounded_node(rule_id, rhs_node_id) :-
rule_clause(rule_id, _, rule_clause_id),
assign(rule_clause_id, lhs_node_id, rhs_node_id),
grounded_node(rule_id, lhs_node_id),
variable(rhs_node_id, _).
grounded_node(rule_id, lhs_node_id) :-
rule_clause(rule_id, _, rule_clause_id),
assign(rule_clause_id, lhs_node_id, rhs_node_id),
grounded_node(rule_id, rhs_node_id),
variable(lhs_node_id, _).
conflicting_definitions(node_id, node_id2, name) :-
declare_type(node_id, name),
declare_type(node_id2, name),
node_id < node_id2.
conflicting_definitions(node_id, node_id2, name) :-
extern_definition(node_id, name),
extern_definition(node_id2, name),
node_id < node_id2.
conflicting_definitions(node_id, node_id2, name) :-
declare_type(node_id, name),
extern_definition(node_id2, name),
node_id < node_id2.
conflicting_definitions(node_id, node_id2, name) :-
extern_definition(node_id, name),
declare_type(node_id2, name),
node_id < node_id2.
extern_used_as_fact(node_id, extern_node_id, name) :-
extern_definition(extern_node_id, name),
module_declaration(_, node_id),
atom(node_id, name).
extern_used_as_rule(node_id, extern_node_id, name) :-
extern_definition(extern_node_id, name),
rule(node_id, name).
================================================
FILE: docs/architecture_choices.md
================================================
# Architecture choices
This document contains all the high level choices that have been made with
regards to the architecture of the compiler. Besides this document, there are
also [several blogposts](https://luctielen.com/) with deep dives on specific
parts of the compiler.
## Inspired by Souffle
Eclair's approach to compiling high level Datalog syntax to assembly is heavily
inspired by Souffle Datalog (most notably: the compilation to relational algebra
and the minimum index selection algorithm). At the top of the corresponding
source code in Eclair, there is a comment pointing to the paper so contributors
can consult the theoretic background behind the code easily.
Eclair does have some notable differences though. First and foremost: it is
written in Haskell. This choice was made because Haskell makes it easy to
express high level ideas and algorithms that you commonly run into when building
a compiler. As an additional benefit, Haskell already has a great ecosystem of
libraries for building a compiler.
The second big change compared to Souffle is that Eclair compiles down directly
to LLVM instead of C++. This gives greater control of the generated assembly
(assembly is generated using a monad / "builder pattern" instead of
concatenating strings to form a C++ program) and also makes it easily portable
to other platforms (including WebAssembly). On top of that we can leverage
existing LLVM tools to analyze / transform the generated LLVM IR.
## IR Design
Eclair makes use of four different intermediate representations (IRs). Each of
the IRs has a different focus / view of the program. By using multiple IRs, we
can also gradually lower the Datalog syntax to the assembly level.
The four different IRs are:
1. AST
2. RA
3. EIR
4. LLVM IR
Each of these IRs is discussed in the subsections below. Every IR can be pretty
printed for inspection (when debugging a compiler issue or when writing Eclair
code).
Each of the IRs are designed in a similar way: they all consist of a single data
type each. This might be a bit controversial for most Haskellers that value type
safety, but this ends up working out because:
1. The parser, semantic analysis and typesystem steps halt when they determine
the program is invalid;
2. Often we are only interested in a really small part of the IR anyway;
3. Most Haskell libraries support one simple type best.
The singly-typed IR is a conciously made trade-off, but it gives us great
benefits. Transformations (a large part of the compiler!) can be written down
succinctly thanks to the
[recursion-schemes library](https://hackage.haskell.org/package/recursion-schemes).
The transforms are guaranteed to terminate when written this way, and are
automatically composable. Besides that, all algorithms can be written down as a
pattern-match that focuses on only one node of the IR.
Besides having singly-typed IRs, each data constructor in the IR type has a
unique node ID attached to it. This makes it possible to link data from outside
the IR to it, without having to keep modifying the IR over and over. This is
especially useful for the semantic analysis and typesystem parts of the
compiler, since they can refer to parts of the program via a node ID.
### AST
The first IR is the `AST` type. AST stands for "Abstract Syntax Tree" and is a
tree representation of the original source code.
Semantic analysis and typechecking happens on this IR before any transformations
are performed, so we can report back exact locations to users of Eclair.
The AST is the most "high level" / starting IR. AST compiles down to RA, which
is described in the next section.
### RA
`RA` stands for "Relational Algebra". It represents a Eclair Datalog program as
a set of relational algebra operations. The data type is pretty much copied
directly from the Souffle paper, with some minor modifications. By first
transforming the AST to RA, we can subsequently lower the code even further down
to the assembly level (via EIR and LLVM IR).
### EIR
`EIR` is an abbreviation for "Eclair IR". It is a IR designed to be very close
to LLVM IR, but with the focus that it is also easy to debug and inspect. It was
mainly created to make the final lowering to LLVM IR as trivial as possible, but
it ended up being also useful for stitching the various Eclair functions in the
runtime together.
### LLVM IR
The LLVM IR is the final IR this compiler makes use of and bears the closest
resemblance to assembly. The
[llvm-codegen library](https://github.com/luc-tielen/llvm-codegen) is used to
generate LLVM instructions. From this point onwards, we can make use of the LLVM
compiler framework to get many optimizations and other tools all for free.
## Query-based compiler
Eclair is a so-called "query-based compiler". What this means is:
1. Each stage of the compiler builds on top of previous stages,
2. You can query the results of each of these "sub-computations".
This kind of architecture ends up being very useful for a compiler since a
compiler often is not a "pipeline" as it is usually presented, but instead has
a graph structure where later stages can depend on earlier stages. On top of
that, it makes it simple to access information at each stage of the compiler,
making it easy to write tools that can query the compiler as a database. (Useful
for developer tools such as LSP!)
The [rock library](https://hackage.haskell.org/package/rock) builds on top of
this idea and provides an API for describing your compiler in terms of build
system rules.
## The parser
The parser is written using parser combinators (from the `megaparsec` library).
This approach was chosen because now this parser is fully written in Haskell,
making it trivial to integrate with the rest of the compiler. On top of that, it
gives you full control over how the parsing happens. In the Eclair compiler the
parser adds a unique node id to each parsed AST node (see section about IR
design).
## Semantic analysis
Eclair makes use of Souffle Datalog during semantic analysis. Using Datalog for
semantic analysis is great, because you can write all your logic really
succinctly by writing down the "patterns" you are looking for in the AST and let
Datalog deduce all results.
The fact that each AST node has a unique ID (see section about IR design) makes
it easy to refer to certain parts of a program and also to make it easy to
serialize data back and forth between Haskell and Datalog.
Eventually, Eclair will be a bootstrapped compiler, meaning all the parts where
Souffle Datalog is currently used will be swapped out with an Eclair Datalog
counterpart. This will make it much easier to distribute and run the compiler
(since there is one big dependency less required).
## Typesystem
The typesystem is a bidirectional typesystem. This means that the typesystem
either checks a term against an expected type, or it tries to infer a type.
Bidirectional typecheckers are great because they are "straight-forward" to
implement (you pretty much need to write two functions that pattern match on the
syntax and handle each node type correspondingly), and produce better error
messages than typesystems that make heavy use of constraint solving.
On top of this, the typesystem tries to report as many type errors as possible
at once and with additional context how it came to these conclusions. This is
done to make the developer experience better.
## Error rendering
An effort is made to make Eclair errors as clear as possible for developers
(using Rust and Elm for inspiration). Right now we use the
[diagnose library](https://github.com/Mesabloo/diagnose) for reporting the
errors since it allows us to focus on other parts of the compiler, but later
this error rendering system will be implemented in the Eclair codebase itself to
allow for more customization.
## Tranformations
Eclair has a general
[Transform](https://github.com/luc-tielen/eclair-lang/blob/main/lib/Eclair/Transform.hs)
type that can be used for transforming the various IRs. Transformations can have
two goals: they either simplify the IR, or they try to optimize it (or both).
Eclair is a nano-pass compiler. Transformations should be small, focused and
composable; so that you can reason about them. It's better to have a few extra
passes in the compiler instead of a lot of extra complexity. The `Transform`
type provides helper functions and typeclass instances to compose them into
bigger transforms anyway.
Transformations can have local state, but the way it is setup it is impossible
for this state to "leak out" to the outside world. This is again done to make it
easier to reason about, while not limiting what's possible inside a transform.
Finally, transforms always run in a `TransformM` monad. This monad offers a way
of generating new unique node IDs in case extra IR nodes are generated.
## Tests
Currently the Eclair test suite is divided into two parts:
1. Unit tests written directly in Haskell
2. "Integration" tests that are executed by the `lit` executable provided by LLVM.
Over time, most of the tests will be integration tests, since they are more
rigorous and test larger parts of the compiler. On top of that, these style of
tests allow you to write an example directly in Eclair and compare the result
against actual output of the compiler.
================================================
FILE: docs/getting_started.md
================================================
# Getting started
Eclair requires a Haskell toolchain, Souffle 2.3 and LLVM 14 to be installed on
your system.
If you notice that the installation instructions below are incomplete or
outdated, please open a [Github issue](https://github.com/luc-tielen/eclair-lang/issues).
## Pre-requisites
### Ubuntu
NOTE: These commands were tested with Ubuntu 20.04, they may not work with older
versions.
#### Installing the Haskell toolchain
Run the following commands to install `ghcup`, `ghc` and `cabal`. `cabal-fmt`,
`hspec-discover` and `hlint` are also installed but they are only needed when working on the
compiler.
```bash
$ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
$ ghcup tui
# In the terminal UI, select GHC 9.2.4, Haskell language server 1.8 and Cabal 3.6.
# Important: both install + set them!
$ cabal install cabal-fmt
$ cabal install hspec-discover
$ cabal install hlint
```
Verify you installed the correct versions by running the commands below, and
comparing them against the versions mentioned in the previous command:
```bash
$ ghc --version
$ haskell-language-server-wrapper --version
$ cabal --version
```
#### Installing Souffle
Run the following commands to download and build Souffle from source:
```bash
$ sudo apt install bison build-essential cmake doxygen flex g++ git \
libffi-dev libncurses5-dev libsqlite3-dev make mcpp python sqlite zlib1g-dev
$ git clone git@github.com:souffle-lang/souffle.git
$ cd souffle
$ git checkout 2.3
$ cmake -S . -B build -DCMAKE_BUILD_TYPE=Release
$ cmake --build build -j
$ sudo cmake --build build --target install
```
If this went correctly, Souffle should now be globally installed on your system.
Check this by executing the following command; it should print out the version
of Souffle (2.3).
```bash
$ souffle --version
```
#### Installing LLVM
Next we need to install LLVM 14. Run the steps below to install it on your
system.
```bash
# If these packages are not available on your system, try installing using this
# link: https://apt.llvm.org/.
$ sudo apt install llvm-14
$ sudo apt install lld-14
$ sudo apt install clang-14 # Optional, if you want to use clang instead of llc
# to compile the LLVM IR
# The following is only needed for development / testing
$ cd ~/.local/bin # Or any other directory that is on your $PATH
$ ln -s /usr/lib/llvm-14/bin/split-file
$ ln -s /usr/bin/FileCheck-14 FileCheck
$ pip install lit==14.0.6
```
### Windows
Assuming you have Windows subsytem for Linux, the commands above should also
work for Windows? (If somebody could verify this, that would be great!)
### OSX
NOTE: These commands were tested with Intel MacOS 13.0, they may or may not not work
with older versions or on an ARM-based machine.
#### Installing the Haskell toolchain
Run the following commands (see https://www.haskell.org/ghcup/) to install `ghcup`, `ghc` and `cabal`.
```bash
$ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
$ ghcup tui
# In the terminal UI, select GHC 9.2.4, Haskell language server 1.8 and Cabal 3.6.
# Important: both install + set them!
```
The following commands are only needed when working on the compiler.
Run the commands to install `cabal-fmt`, `hspec-discover`, and `hlint`.
```bash
$ cabal install cabal-fmt
$ cabal install hspec-discover
$ cabal install hlint
```
Verify you installed the correct versions by running the commands below, and
compare them against the versions mentioned in the previous command:
```bash
$ ghc --version
$ haskell-language-server-wrapper --version
$ cabal --version
```
#### Installing Souffle
Run the following commands to download and build Souffle from source
(instructions taken from [here](https://souffle-lang.github.io/build#mac-os-x-build)):
```bash
$ brew update
$ brew install cmake bison libffi mcpp pkg-config
$ brew reinstall gcc
$ brew link bison --force
$ brew link libffi --force
$ brew install souffle-lang/souffle/souffle
```
If this went correctly, Souffle should now be globally installed on your system.
Check this by executing the following command; it should print out the version
of Souffle (2.3).
```bash
$ souffle --version
```
#### Installing LLVM
Next we need to install LLVM 14. Run the steps below to install it on your
system.
```bash
$ brew install llvm@14
# The following is only needed for development / testing
$ cd ~/.local/bin # Or any other directory that is on your $PATH
$ ln -s /usr/local/opt/llvm@14/bin/split-file
$ ln -s /usr/local/opt/llvm@14/bin/FileCheck
$ pip install lit==14.0.6
$ brew install node
```
## Building Eclair
Now that all the pre-requisites are built, you can build Eclair.
```bash
$ cabal build
$ cabal run eclair-test # Unit tests
$ lit tests -v # Integration tests
$ cabal list-bin eclair # <= returns path to the Eclair compiler executable
```
================================================
FILE: eclair-lang.cabal
================================================
cabal-version: 2.2
name: eclair-lang
version: 0.2.0
synopsis:
Eclair: an experimental and minimal Datalog that compiles to LLVM.
description:
Eclair: an experimental and minimal Datalog that compiles to LLVM.
category: Compiler
homepage: https://github.com/luc-tielen/eclair-lang
author: Luc Tielen
maintainer: luc.tielen@gmail.com
copyright: Luc Tielen, 2023
license: BSD-3-Clause
license-file: LICENSE
build-type: Simple
extra-source-files:
cbits/semantic_analysis.dl
CHANGELOG.md
LICENSE
README.md
flag debug
description: Enables stack traces.
manual: True
default: False
library
-- cabal-fmt: expand lib
exposed-modules:
Eclair
Eclair.ArgParser
Eclair.AST.Analysis
Eclair.AST.Codegen
Eclair.AST.IR
Eclair.AST.Lower
Eclair.AST.Transforms
Eclair.AST.Transforms.ConstantFolding
Eclair.AST.Transforms.DeadCodeElimination
Eclair.AST.Transforms.NormalizeRules
Eclair.AST.Transforms.RemoveAliases
Eclair.AST.Transforms.ReplaceStrings
Eclair.Common.Config
Eclair.Common.Extern
Eclair.Common.Id
Eclair.Common.Literal
Eclair.Common.Location
Eclair.Common.Operator
Eclair.Common.Pretty
Eclair.Comonads
Eclair.EIR.IR
Eclair.EIR.Lower
Eclair.EIR.Lower.API
Eclair.EIR.Lower.Codegen
Eclair.EIR.Lower.Externals
Eclair.Error
Eclair.JSON
Eclair.LLVM.Allocator.Arena
Eclair.LLVM.Allocator.Common
Eclair.LLVM.Allocator.Malloc
Eclair.LLVM.Allocator.Page
Eclair.LLVM.BTree
Eclair.LLVM.BTree.Bounds
Eclair.LLVM.BTree.Compare
Eclair.LLVM.BTree.Create
Eclair.LLVM.BTree.Destroy
Eclair.LLVM.BTree.Find
Eclair.LLVM.BTree.Insert
Eclair.LLVM.BTree.Iterator
Eclair.LLVM.BTree.Size
Eclair.LLVM.BTree.Types
Eclair.LLVM.Codegen
Eclair.LLVM.Config
Eclair.LLVM.Externals
Eclair.LLVM.Hash
Eclair.LLVM.HashMap
Eclair.LLVM.Metadata
Eclair.LLVM.Symbol
Eclair.LLVM.SymbolTable
Eclair.LLVM.Table
Eclair.LLVM.Template
Eclair.LLVM.Vector
Eclair.LSP
Eclair.LSP.Handlers
Eclair.LSP.Handlers.Diagnostics
Eclair.LSP.Handlers.DocumentHighlight
Eclair.LSP.Handlers.Hover
Eclair.LSP.JSON
Eclair.LSP.Monad
Eclair.LSP.Types
Eclair.LSP.VFS
Eclair.Parser
Eclair.RA.Codegen
Eclair.RA.IndexSelection
Eclair.RA.IR
Eclair.RA.Lower
Eclair.RA.Transforms
Eclair.RA.Transforms.HoistConstraints
Eclair.Souffle.IR
Eclair.Transform
Eclair.TypeSystem
Prelude
hs-source-dirs: lib
default-extensions:
DataKinds
DeriveAnyClass
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
DerivingStrategies
DerivingVia
FlexibleContexts
FlexibleInstances
KindSignatures
LambdaCase
OverloadedStrings
PatternSynonyms
RankNTypes
RecursiveDo
ScopedTypeVariables
TupleSections
TypeFamilies
ViewPatterns
ghc-options:
-Wall -Wincomplete-patterns -fhide-source-paths
-fno-show-valid-hole-fits -fno-sort-valid-hole-fits
cxx-options: -std=c++17 -D__EMBEDDED_SOUFFLE__ -Wall
build-depends:
, algebraic-graphs <1
, base >=4.7 && <5
, bytestring >=0.11 && <0.12
, comonad >=5 && <6
, containers <1
, dependent-sum >=0.6 && <1
, diagnose >=2.3 && <2.4
, directory >=1 && <2
, dlist >=1 && <2
, exceptions >=0.10 && <0.11
, extra >=1 && <2
, ghc-prim <1
, hermes-json <1
, llvm-codegen
, megaparsec >=9 && <10
, mmorph >=1 && <2
, mtl >=2 && <3
, optparse-applicative >=0.16 && <0.17
, parser-combinators >=1.3 && <1.4
, prettyprinter >=1.7 && <1.8
, prettyprinter-ansi-terminal >=1 && <2
, recursion-schemes >=5 && <6
, relude >=1.2 && <1.3
, rock >=0.3 && <0.4
, souffle-haskell ==4.0.0
, text >=2 && <3
, text-builder-linear <1
, transformers <1
, vector >=0.12 && <0.13
mixins: base hiding (Prelude)
default-language: Haskell2010
if os(osx)
extra-libraries: c++
if flag(debug)
ghc-options: -fplugin=StackTrace.Plugin
build-depends: haskell-stack-trace-plugin ==0.1.3.0
if os(linux)
extra-libraries: stdc++
executable eclair
main-is: Main.hs
other-modules: Paths_eclair_lang
autogen-modules: Paths_eclair_lang
hs-source-dirs: src/eclair
default-extensions:
DataKinds
DeriveAnyClass
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
DerivingStrategies
DerivingVia
FlexibleContexts
FlexibleInstances
KindSignatures
LambdaCase
OverloadedStrings
PatternSynonyms
RankNTypes
RecursiveDo
ScopedTypeVariables
TupleSections
TypeFamilies
ViewPatterns
ghc-options:
-Wall -Wincomplete-patterns -fhide-source-paths
-fno-show-valid-hole-fits -fno-sort-valid-hole-fits -threaded
-rtsopts -with-rtsopts=-N
cxx-options: -std=c++17 -D__EMBEDDED_SOUFFLE__
build-depends:
, algebraic-graphs <1
, base >=4.7 && <5
, bytestring >=0.11 && <0.12
, comonad >=5 && <6
, containers <1
, dependent-sum >=0.6 && <1
, diagnose >=2.3 && <2.4
, directory >=1 && <2
, dlist >=1 && <2
, eclair-lang
, exceptions >=0.10 && <0.11
, extra >=1 && <2
, llvm-codegen
, megaparsec >=9 && <10
, mmorph >=1 && <2
, mtl >=2 && <3
, optparse-applicative >=0.16 && <0.17
, parser-combinators >=1.3 && <1.4
, prettyprinter >=1.7 && <1.8
, prettyprinter-ansi-terminal >=1 && <2
, process >=1.6 && <1.7
, recursion-schemes >=5 && <6
, relude >=1.2 && <1.3
, rock >=0.3 && <0.4
, souffle-haskell ==4.0.0
, text >=2 && <3
, transformers <1
, vector >=0.12 && <0.13
mixins: base hiding (Prelude)
default-language: Haskell2010
if os(osx)
extra-libraries: c++
if flag(debug)
ghc-options: -fplugin=StackTrace.Plugin
build-depends: haskell-stack-trace-plugin ==0.1.3.0
test-suite eclair-test
type: exitcode-stdio-1.0
main-is: test.hs
-- cabal-fmt: expand tests/eclair
other-modules:
Paths_eclair_lang
Test.Eclair.ArgParserSpec
Test.Eclair.JSONSpec
Test.Eclair.LLVM.Allocator.MallocSpec
Test.Eclair.LLVM.Allocator.PageSpec
Test.Eclair.LLVM.Allocator.Utils
Test.Eclair.LLVM.BTreeSpec
Test.Eclair.LLVM.HashMapSpec
Test.Eclair.LLVM.HashSpec
Test.Eclair.LLVM.SymbolSpec
Test.Eclair.LLVM.SymbolTableSpec
Test.Eclair.LLVM.SymbolUtils
Test.Eclair.LLVM.VectorSpec
Test.Eclair.LSP.HandlersSpec
Test.Eclair.LSP.JSONSpec
Test.Eclair.RA.IndexSelectionSpec
autogen-modules: Paths_eclair_lang
hs-source-dirs: tests/eclair
default-extensions:
DataKinds
DeriveAnyClass
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
DerivingStrategies
DerivingVia
FlexibleContexts
FlexibleInstances
KindSignatures
LambdaCase
OverloadedStrings
PatternSynonyms
RankNTypes
RecursiveDo
ScopedTypeVariables
TupleSections
TypeFamilies
ViewPatterns
ghc-options:
-Wall -Wincomplete-patterns -fhide-source-paths
-fno-show-valid-hole-fits -fno-sort-valid-hole-fits
cxx-options: -std=c++17 -D__EMBEDDED_SOUFFLE__
build-depends:
, algebraic-graphs <1
, array >=0.5 && <1
, base >=4.7 && <5
, bytestring >=0.11 && <0.12
, comonad >=5 && <6
, containers <1
, dependent-sum >=0.6 && <1
, diagnose >=2.3 && <2.4
, dlist >=1 && <2
, eclair-lang
, exceptions >=0.10 && <0.11
, extra >=1 && <2
, filepath >=1 && <2
, hedgehog >=1 && <2
, hermes-json <1
, hspec >=2.6.1 && <3.0.0
, hspec-hedgehog <1
, libffi >=0.2 && <1
, llvm-codegen
, megaparsec >=9 && <10
, mmorph >=1 && <2
, mtl >=2 && <3
, neat-interpolation <1
, optparse-applicative >=0.16 && <0.17
, parser-combinators >=1.3 && <1.4
, prettyprinter >=1.7 && <1.8
, prettyprinter-ansi-terminal >=1 && <2
, random >=1.2 && <2
, recursion-schemes >=5 && <6
, relude >=1.2 && <1.3
, rock >=0.3 && <0.4
, silently >=1.2 && <1.3
, souffle-haskell ==4.0.0
, text >=2 && <3
, transformers <1
, unix >=2.8 && <3
, vector >=0.12 && <0.13
mixins: base hiding (Prelude)
default-language: Haskell2010
if os(osx)
extra-libraries: c++
if flag(debug)
ghc-options: -fplugin=StackTrace.Plugin
build-depends: haskell-stack-trace-plugin ==0.1.3.0
================================================
FILE: hie.yaml
================================================
cradle:
cabal:
- path: "lib"
component: "lib:eclair-lang"
- path: "src/eclair/Main.hs"
component: "eclair-lang:exe:eclair"
- path: "src/eclair/Paths_eclair_lang.hs"
component: "eclair-lang:exe:eclair"
- path: "src/lsp"
component: "eclair-lang:exe:eclair-lsp-server"
- path: "tests/eclair"
component: "eclair-lang:test:eclair-test"
- path: "tests/lsp/Main.hs"
component: "eclair-lang:test:eclair-lsp-test"
================================================
FILE: lib/Eclair/AST/Analysis.hs
================================================
{-# LANGUAGE UndecidableInstances #-}
module Eclair.AST.Analysis
( Result(..)
, SemanticInfo(..)
, SemanticErrors(..)
, hasSemanticErrors
, runAnalysis
, UngroundedVar(..)
, WildcardInFact(..)
, WildcardInRuleHead(..)
, WildcardInConstraint(..)
, WildcardInBinOp(..)
, WildcardInExtern(..)
, UnconstrainedRuleVar(..)
, DeadCode(..)
, DeadInternalRelation(..)
, NoOutputRelation(..)
, ConflictingDefinitionGroup(..)
, ExternUsedAsFact(..)
, ExternUsedAsRule(..)
, CyclicNegation(..)
, NodeId(..)
, Container
, computeUsageMapping
) where
import qualified Data.List.NonEmpty as NE
import Data.List.Extra (nubOrdOn)
import qualified Language.Souffle.Interpreted as S
import qualified Language.Souffle.Analysis as S
import qualified Eclair.AST.IR as IR
import qualified Data.Map as Map
import Eclair.Common.Id
import Eclair.Common.Location (NodeId(..))
type Position = Word32
-- The facts submitted to Datalog closely follow the AST structure,
-- but are denormalized so that Datalog can easily process it.
data LitNumber
= LitNumber NodeId Word32
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions LitNumber "lit_number" 'S.Input
data LitString
= LitString NodeId Text
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions LitString "lit_string" 'S.Input
data Var
= Var NodeId Id
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions Var "variable" 'S.Input
newtype Hole
= Hole NodeId
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions Hole "hole" 'S.Input
data Constraint
= Constraint
{ constraintId :: NodeId
, constraintOperator :: Text
, constraintLhsId :: NodeId
, constraintRhsId :: NodeId
}
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions Constraint "constraint" 'S.Input
data BinOp
= BinOp
{ binOpId :: NodeId
, op :: Text
, binOpLhsId :: NodeId
, binOpRhsId :: NodeId
}
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions BinOp "binop" 'S.Input
data Atom
= Atom NodeId Id
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions Atom "atom" 'S.Input
data AtomArg
= AtomArg { atomId :: NodeId, atomArgPos :: Word32, atomArgId :: NodeId }
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions AtomArg "atom_arg" 'S.Input
data Rule
= Rule NodeId Id
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions Rule "rule" 'S.Input
data RuleArg
= RuleArg { raRuleId :: NodeId, raArgPos :: Word32, raArgId :: NodeId }
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions RuleArg "rule_arg" 'S.Input
data RuleClause
= RuleClause { rcRuleId :: NodeId, rcClausePos :: Word32, rcClauseId :: NodeId }
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions RuleClause "rule_clause" 'S.Input
data Negation
= Negation
{ negationNodeId :: NodeId
, negationInnerNodeId :: NodeId
}
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions Negation "negation" 'S.Input
-- NOTE: not storing types right now, but might be useful later?
data DeclareType
= DeclareType NodeId Id
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions DeclareType "declare_type" 'S.Input
data ExternDefinition
= ExternDefinition NodeId Id
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions ExternDefinition "extern_definition" 'S.Input
newtype InputRelation
= InputRelation Id
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions InputRelation "input_relation" 'S.Input
newtype OutputRelation
= OutputRelation Id
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions OutputRelation "output_relation" 'S.Input
newtype InternalRelation
= InternalRelation Id
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions InternalRelation "internal_relation" 'S.Input
newtype Module
= Module NodeId
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions Module "module" 'S.Input
data ModuleDecl
= ModuleDecl { moduleId :: NodeId, declId :: NodeId }
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions ModuleDecl "module_declaration" 'S.Input
data ScopedValue
= ScopedValue { svScopeId :: NodeId, svNodeId :: NodeId }
deriving stock Generic
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions ScopedValue "scoped_value" 'S.Input
data UngroundedVar loc
= UngroundedVar
{ ungroundedRuleLoc :: loc
, ungroundedVarLoc :: loc
, ungroundedVarName :: Id
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (UngroundedVar loc) "ungrounded_variable" 'S.Output
data WildcardInFact loc
= WildcardInFact
{ factLoc :: loc
, factArgLoc :: loc
, wildcardFactPos :: Position
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (WildcardInFact loc) "wildcard_in_fact" 'S.Output
data WildcardInRuleHead loc
= WildcardInRuleHead
{ wildcardRuleLoc :: loc
, wildcardRuleArgLoc :: loc
, wildcardRuleHeadPos :: Position
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (WildcardInRuleHead loc) "wildcard_in_rule_head" 'S.Output
data WildcardInConstraint loc
= WildcardInConstraint
{ wildcardConstraintLoc :: loc
, wildcardConstraintPos :: loc
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (WildcardInConstraint loc) "wildcard_in_constraint" 'S.Output
data WildcardInBinOp loc
= WildcardInBinOp
{ wildcardBinOpLoc :: loc
, wildcardBinOpPos :: loc
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (WildcardInBinOp loc) "wildcard_in_binop" 'S.Output
data WildcardInExtern loc
= WildcardInExtern
{ wildcardExternAtomLoc :: loc
, wildcardExternAtomArgLoc :: loc
, wildcardExternArgPos :: Position
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (WildcardInExtern loc) "wildcard_in_extern" 'S.Output
data UnconstrainedRuleVar loc
= UnconstrainedRuleVar
{ urvRuleLoc :: loc
, urvVarLoc :: loc
, urvVarName :: Id
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (UnconstrainedRuleVar loc) "unconstrained_rule_var" 'S.Output
newtype DeadCode
= DeadCode { unDeadCode :: NodeId }
deriving stock (Generic, Eq)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions DeadCode "dead_code" 'S.Output
newtype NoOutputRelation loc
= NoOutputRelation loc
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (NoOutputRelation loc) "no_output_relation" 'S.Output
data DeadInternalRelation loc
= DeadInternalRelation loc Id
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (DeadInternalRelation loc) "dead_internal_relation" 'S.Output
data ConflictingDefinitions loc
= ConflictingDefinitions
{ cdFirstLoc :: loc
, cdSecondLoc :: loc
, cdName :: Id
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (ConflictingDefinitions loc) "conflicting_definitions" 'S.Output
data ConflictingDefinitionGroup loc
= ConflictingDefinitionGroup
{ cdgName :: Id
, cdgLocs :: NonEmpty loc
} deriving stock (Eq, Functor)
data ExternUsedAsFact loc
= ExternUsedAsFact
{ externAsFactLoc :: loc
, externAsFactExternLoc :: loc
, externAsFactName :: Id
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (ExternUsedAsFact loc) "extern_used_as_fact" 'S.Output
data ExternUsedAsRule loc
= ExternUsedAsRule
{ externAsRuleLoc :: loc
, externAsRuleExternLoc :: loc
, externAsRuleName :: Id
}
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (ExternUsedAsRule loc) "extern_used_as_rule" 'S.Output
newtype CyclicNegation loc
= CyclicNegation loc
deriving stock (Generic, Eq, Functor)
deriving anyclass S.Marshal
deriving S.Fact via S.FactOptions (CyclicNegation loc) "cyclic_negation" 'S.Output
data SemanticAnalysis
= SemanticAnalysis
deriving S.Program
via S.ProgramOptions SemanticAnalysis "semantic_analysis"
'[ LitNumber
, LitString
, Var
, Hole
, Constraint
, BinOp
, Atom
, AtomArg
, Rule
, RuleArg
, RuleClause
, Negation
, DeclareType
, ExternDefinition
, InputRelation
, OutputRelation
, InternalRelation
, Module
, ModuleDecl
, ScopedValue
, UngroundedVar NodeId
, WildcardInRuleHead NodeId
, WildcardInFact NodeId
, WildcardInConstraint NodeId
, WildcardInBinOp NodeId
, WildcardInExtern NodeId
, UnconstrainedRuleVar NodeId
, DeadCode
, NoOutputRelation NodeId
, DeadInternalRelation NodeId
, ConflictingDefinitions NodeId
, ExternUsedAsFact NodeId
, ExternUsedAsRule NodeId
, CyclicNegation NodeId
]
-- TODO: change to Vector when finished for performance
type Container = []
newtype SemanticInfo
= SemanticInfo
{ deadCodeIds :: Container DeadCode
} deriving Eq
data Result
= Result
{ semanticInfo :: SemanticInfo
, semanticErrors :: SemanticErrors NodeId
}
deriving Eq
data SemanticErrors loc
= SemanticErrors
{ ungroundedVars :: Container (UngroundedVar loc)
, wildcardsInFacts :: Container (WildcardInFact loc)
, wildcardsInRuleHeads :: Container (WildcardInRuleHead loc)
, wildcardsInConstraints :: Container (WildcardInConstraint loc)
, wildcardsInBinOps :: Container (WildcardInBinOp loc)
, wildcardsInExternAtoms :: Container (WildcardInExtern loc)
, unconstrainedVars :: Container (UnconstrainedRuleVar loc)
, deadInternalRelations :: Container (DeadInternalRelation loc)
, noOutputRelations :: Container (NoOutputRelation loc)
, conflictingDefinitions :: Container (ConflictingDefinitionGroup loc)
, externsUsedAsFact :: Container (ExternUsedAsFact loc)
, externsUsedAsRule :: Container (ExternUsedAsRule loc)
, cyclicNegations :: Container (CyclicNegation loc)
}
deriving (Eq, Functor)
hasSemanticErrors :: Result -> Bool
hasSemanticErrors result =
isNotNull ungroundedVars ||
isNotNull wildcardsInFacts ||
isNotNull wildcardsInRuleHeads ||
isNotNull wildcardsInConstraints ||
isNotNull wildcardsInBinOps ||
isNotNull wildcardsInExternAtoms ||
isNotNull unconstrainedVars ||
isNotNull deadInternalRelations ||
isNotNull noOutputRelations ||
isNotNull conflictingDefinitions ||
isNotNull externsUsedAsFact ||
isNotNull cyclicNegations
where
errs = semanticErrors result
isNotNull :: (SemanticErrors NodeId -> [a]) -> Bool
isNotNull f = not . null $ f errs
analysis :: Word -> S.Handle SemanticAnalysis -> S.Analysis S.SouffleM IR.AST Result
analysis numCores prog = S.mkAnalysis addFacts run getFacts
where
addFacts :: IR.AST -> S.SouffleM ()
addFacts ast = usingReaderT Nothing $ flip (zygo IR.getNodeIdF) ast $ \case
IR.LitF nodeId lit -> do
mScopeId <- ask
for_ mScopeId $ \scopeId ->
S.addFact prog $ ScopedValue scopeId nodeId
case lit of
IR.LNumber x ->
S.addFact prog $ LitNumber nodeId x
IR.LString x ->
S.addFact prog $ LitString nodeId x
IR.PWildcardF nodeId ->
S.addFact prog $ Var nodeId (Id "_")
IR.VarF nodeId var -> do
S.addFact prog $ Var nodeId var
mScopeId <- ask
for_ mScopeId $ \scopeId ->
S.addFact prog $ ScopedValue scopeId nodeId
IR.HoleF nodeId ->
S.addFact prog $ Hole nodeId
IR.BinOpF nodeId arithOp (lhsId', lhsAction) (rhsId', rhsAction) -> do
let textualOp = case arithOp of
IR.Plus -> "+"
IR.Minus -> "-"
IR.Multiply -> "*"
IR.Divide -> "/"
mScopeId <- ask
for_ mScopeId $ \scopeId ->
S.addFact prog $ ScopedValue scopeId nodeId
S.addFact prog $ BinOp nodeId textualOp lhsId' rhsId'
lhsAction
rhsAction
IR.ConstraintF nodeId constraintOp (lhsId', lhsAction) (rhsId', rhsAction) -> do
let textualOp = case constraintOp of
IR.Equals -> "="
IR.NotEquals -> "!="
IR.LessThan -> "<"
IR.LessOrEqual -> "<="
IR.GreaterThan -> "<"
IR.GreaterOrEqual -> "<="
S.addFact prog $ Constraint nodeId textualOp lhsId' rhsId'
lhsAction
rhsAction
IR.NotF nodeId (innerNodeId, action) -> do
S.addFact prog $ Negation nodeId innerNodeId
local (const $ Just nodeId) action
IR.AtomF nodeId atom (unzip -> (argNodeIds, actions)) -> do
S.addFact prog $ Atom nodeId atom
mScopeId <- ask
S.addFacts prog $ mapWithPos (AtomArg nodeId) argNodeIds
for_ mScopeId $ \scopeId ->
S.addFact prog $ ScopedValue scopeId nodeId
let maybeAddScope =
if isJust mScopeId
then id
else local (const $ Just nodeId)
maybeAddScope $ sequence_ actions
IR.RuleF nodeId rule ruleArgs ruleClauses -> do
let (argNodeIds, argActions) = unzip ruleArgs
(clauseNodeIds, clauseActions) = unzip ruleClauses
S.addFact prog $ Rule nodeId rule
S.addFacts prog $ mapWithPos (RuleArg nodeId) argNodeIds
S.addFacts prog $ mapWithPos (RuleClause nodeId) clauseNodeIds
local (const $ Just nodeId) $ do
sequence_ argActions
sequence_ clauseActions
IR.ExternDefinitionF nodeId name _ _ -> do
S.addFact prog $ ExternDefinition nodeId name
IR.DeclareTypeF nodeId name _ usageMode -> do
S.addFact prog $ DeclareType nodeId name
case usageMode of
IR.Input ->
S.addFact prog $ InputRelation name
IR.Output ->
S.addFact prog $ OutputRelation name
IR.InputOutput -> do
S.addFact prog $ InputRelation name
S.addFact prog $ OutputRelation name
IR.Internal ->
S.addFact prog $ InternalRelation name
IR.ModuleF nodeId (unzip -> (declNodeIds, actions)) -> do
S.addFact prog $ Module nodeId
S.addFacts prog $ map (ModuleDecl nodeId) declNodeIds
sequence_ actions
run :: S.SouffleM ()
run = do
S.setNumThreads prog (fromIntegral numCores)
S.run prog
getFacts :: S.SouffleM Result
getFacts = do
info <- SemanticInfo <$> S.getFacts prog
errs <- SemanticErrors <$> S.getFacts prog
<*> S.getFacts prog
<*> S.getFacts prog
<*> S.getFacts prog
<*> S.getFacts prog
<*> S.getFacts prog
<*> S.getFacts prog
<*> S.getFacts prog
<*> S.getFacts prog
<*> (groupConflicts <$> S.getFacts prog)
<*> S.getFacts prog
<*> S.getFacts prog
<*> S.getFacts prog
pure $ Result info errs
mapWithPos :: (Word32 -> a -> b) -> [a] -> [b]
mapWithPos g = zipWith g [0..]
groupConflicts :: Container (ConflictingDefinitions NodeId) -> Container (ConflictingDefinitionGroup NodeId)
groupConflicts conflicts =
conflicts
& sortWith sameConflict
& groupBy ((==) `on` sameConflict)
& map (\cg ->
let firstConflict = head cg
declName = cdName firstConflict
locs = NE.cons (cdFirstLoc firstConflict) (map cdSecondLoc cg)
in ConflictingDefinitionGroup declName locs
)
& nubOrdOn cdgName
where
sameConflict = cdName &&& cdFirstLoc
runAnalysis :: Word -> IR.AST -> IO Result
runAnalysis numCores ast = S.runSouffle SemanticAnalysis $ \case
Nothing -> panic "Failed to load Souffle during semantic analysis!"
Just prog -> S.execAnalysis (analysis numCores prog) ast
computeUsageMapping :: IR.AST -> Map Id IR.UsageMode
computeUsageMapping ast =
Map.fromList pairs
where
pairs = flip cata ast $ \case
IR.DeclareTypeF _ name _ mode ->
one (name, mode)
astf ->
fold astf
================================================
FILE: lib/Eclair/AST/Codegen.hs
================================================
{-# LANGUAGE DerivingVia #-}
module Eclair.AST.Codegen
( CodegenM
, Env(..)
, runCodegen
, toTerm
, project
, search
, loop
, parallel
, merge
, swap
, purge
, exit
, noElemOf
, if'
) where
import Prelude hiding (swap, project)
import Data.DList (DList)
import qualified Data.DList as DList
import qualified Eclair.RA.IR as RA
import qualified Eclair.AST.IR as AST
import Eclair.Common.Location
import Eclair.Common.Literal
import Eclair.Common.Operator
import Eclair.Common.Id
import Eclair.Common.Extern
type AST = AST.AST
type RA = RA.RA
type Relation = RA.Relation
type Alias = RA.Alias
type Variable = Id
type Column = Int
newtype Row = Row { unRow :: Int }
deriving (Eq, Ord)
data InLoop
= InLoop
deriving Eq
data Env
= Env
{ envRow :: Row
, envExterns :: [Extern]
, envLoopContext :: Maybe InLoop
}
data LowerState
= LowerState
{ nextNodeId :: Word32 -- NOTE: Unrelated to NodeIDs used in AST!
-- Constraints that can be resolved directly, but need to be emitted later.
, directConstraints :: CodegenM RA -> CodegenM RA
-- We keep track of which alias + column maps to which variables for later
-- generation of constraints.
, varMapping :: DList (Alias, Column, Variable)
}
newtype CodegenM a
= CodegenM (RWS Env () LowerState a)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadState LowerState)
via RWS Env () LowerState
runCodegen :: [Extern] -> CodegenM a -> a
runCodegen externs (CodegenM m) =
-- NOTE: NodeId starts at 1, since module is manually created, and has NodeId 0
let beginState = LowerState 1 id mempty
in fst $ evalRWS m (Env (Row 0) externs Nothing) beginState
freshNodeId :: CodegenM NodeId
freshNodeId = do
next <- gets nextNodeId
modify $ \s -> s { nextNodeId = next + 1 }
pure $ NodeId next
project :: Relation -> [CodegenM RA] -> CodegenM RA
project r terms = do
nodeId <- freshNodeId
(addDirectConstraints, mapping) <- gets (directConstraints &&& varMapping)
let grouped =
mapping
& toList
& sortOn varNameOf
& groupBy ((==) `on` varNameOf)
eqs = map toIndirectConstraint grouped
addIndirectConstraints = foldl' (.) id eqs
noElemConstraint <- lookupNoElemConstraint
addDirectConstraints . addIndirectConstraints . noElemConstraint $
RA.Project nodeId r <$> sequence terms
where
varNameOf (_, _, v) = v
resolveAliasValue (a, col, _) = do
nodeId <- freshNodeId
pure $ RA.ColumnIndex nodeId a col
toIndirectConstraint bindingGroup m = case bindingGroup of
initial :| rest -> do
aliasValue <- resolveAliasValue initial
aliasValues <- traverse resolveAliasValue rest
let constraints = map (if' Equals aliasValue) aliasValues
wrapConstraints = foldl' (.) id constraints
wrapConstraints m
lookupNoElemConstraint = do
loopCtx <- asks envLoopContext
if loopCtx == Just InLoop
then pure $ noElemOf (stripIdPrefixes r) terms
else pure id
search :: Relation -> [AST] -> CodegenM RA -> CodegenM RA
search r terms inner = do
nodeId <- freshNodeId
-- Potentially reset var mapping when we reach the first search,
-- this makes it possible to easily support multiple project statements.
maybeResetSearchState
a <- relationToAlias r
zipWithM_ (\col t -> emitSearchTerm t a col) [0..] terms
action <- local nextRow inner
pure $ RA.Search nodeId r a [] action
where
nextRow s = s { envRow = Row . (+1) . unRow $ envRow s }
maybeResetSearchState = do
Row row <- asks envRow
when (row == 0) $ do
modify $ \s -> s { varMapping = mempty }
emitSearchTerm :: AST -> Alias -> Column -> CodegenM ()
emitSearchTerm ast a col = do
-- Based on what the term resolved to, we might need to create additional
-- constraints. Literals can directly be converted to a constraint, variables
-- are solved at the end (in the project statement).
case ast of
AST.Lit {} ->
addDirectConstraint ast a col
AST.BinOp {} ->
addDirectConstraint ast a col
AST.PWildcard _ ->
pass
AST.Var _ v ->
-- We append new constraints at the end.
-- This will cause indices to always trigger as soon as possible,
-- which narrows down the search space and speeds up the query.
modify $ \s -> s { varMapping = DList.snoc (varMapping s) (a, col, v) }
_ ->
pass
addDirectConstraint ast a col = do
ra <- toTerm ast
nodeId <- freshNodeId
let aliasValue = RA.ColumnIndex nodeId a col
constraint = if' Equals aliasValue ra
modify $ \s -> s { directConstraints = directConstraints s . constraint }
loop :: [CodegenM RA] -> CodegenM RA
loop ms = local (\env -> env { envLoopContext = Just InLoop}) $ do
nodeId <- freshNodeId
RA.Loop nodeId <$> sequence ms
parallel :: [CodegenM RA] -> CodegenM RA
parallel = \case
[m] -> m
ms -> do
nodeId <- freshNodeId
RA.Par nodeId <$> sequence ms
merge :: Relation -> Relation -> CodegenM RA
merge from' to' = do
nodeId <- freshNodeId
pure $ RA.Merge nodeId from' to'
swap :: Relation -> Relation -> CodegenM RA
swap r1 r2 = do
nodeId <- freshNodeId
pure $ RA.Swap nodeId r1 r2
purge :: Relation -> CodegenM RA
purge r = do
nodeId <- freshNodeId
pure $ RA.Purge nodeId r
exit :: [Relation] -> CodegenM RA
exit rs = do
nodeId <- freshNodeId
pure $ RA.Exit nodeId rs
noElemOf :: Relation -> [CodegenM RA] -> CodegenM RA -> CodegenM RA
noElemOf r ts inner = do
notElemNodeId <- freshNodeId
ifNodeId <- freshNodeId
cond <- RA.NotElem notElemNodeId r <$> sequence ts
RA.If ifNodeId cond <$> inner
if' :: LogicalOp -> RA -> RA -> CodegenM RA -> CodegenM RA
if' op lhs rhs body = do
cmpNodeId <- freshNodeId
ifNodeId <- freshNodeId
let cond = RA.CompareOp cmpNodeId op lhs rhs
RA.If ifNodeId cond <$> body
toTerm :: AST -> CodegenM RA
toTerm ast = do
nodeId <- freshNodeId
case ast of
AST.Lit _ (LNumber lit) ->
pure $ RA.Lit nodeId lit
AST.PWildcard _ ->
pure $ RA.Undef nodeId
AST.Var _ v -> do
gets (find (\(_, _, v') -> v == v') . varMapping) >>= \case
Just (alias, col, _) -> do
pure $ RA.ColumnIndex nodeId alias col
Nothing ->
panic $ "Found ungrounded variable '" <> unId v <> "' in 'toTerm'!"
AST.BinOp _ op lhs rhs -> do
lhsTerm <- toTerm lhs
rhsTerm <- toTerm rhs
pure $ RA.PrimOp nodeId (RA.BuiltinOp op) [lhsTerm, rhsTerm]
AST.Atom _ name args -> do
RA.PrimOp nodeId (RA.ExternOp name) <$> traverse toTerm args
_ ->
panic "Unexpected case in 'toTerm'!"
relationToAlias :: Relation -> CodegenM Alias
relationToAlias r =
asks (appendToId r . show . unRow . envRow)
================================================
FILE: lib/Eclair/AST/IR.hs
================================================
{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
module Eclair.AST.IR
( AST(.., PWildcard)
, ASTF(.., PWildcardF)
, Value
, Clause
, Decl
, Literal(..)
, Type(..)
, ArithmeticOp(..)
, LogicalOp(..)
, isEqualityOp
, getNodeId
, getNodeIdF
, getExternDefs
, UsageMode(..)
, Attributes
) where
import Prettyprinter
import Eclair.Common.Id
import Eclair.Common.Operator
import Eclair.Common.Extern
import Eclair.Common.Literal
import Eclair.Common.Pretty
import Eclair.Common.Location
type Value = AST
type Clause = AST
type Decl = AST
data Type
= U32
| Str
| TUnknown Int -- NOTE: unification variable, only used internally!
deriving (Eq, Ord, Show)
data UsageMode
= Input
| Output
| InputOutput
| Internal -- This variant is only used internally (pun intended).
deriving (Eq, Show)
-- Later this will also contain (Maybe StorageType), ...
type Attributes = UsageMode
-- NOTE: There is no explicit "AND" node, conjunctions are inlined into other
-- nodes (as lists of clauses).
data AST
-- Expressions
= Lit NodeId Literal
| Var NodeId Id
| Hole NodeId
| BinOp NodeId ArithmeticOp AST AST
-- Statements
| Constraint NodeId LogicalOp AST AST
| Rule NodeId Id [Value] [Clause]
| Not NodeId Clause
| Atom NodeId Id [Value] -- Can be both a Datalog relation, or a externally defined function / constraint
| ExternDefinition NodeId Id [(Maybe Id, Type)] (Maybe Type)
| DeclareType NodeId Id [(Maybe Id, Type)] Attributes
| Module NodeId [Decl]
deriving (Eq, Show)
pattern PWildcard :: NodeId -> AST
pattern PWildcard nodeId
= Var nodeId (Id "_")
makeBaseFunctor ''AST
pattern PWildcardF :: NodeId -> ASTF r
pattern PWildcardF nodeId
= VarF nodeId (Id "_")
getNodeId :: AST -> NodeId
getNodeId = \case
Module nodeId _ -> nodeId
DeclareType nodeId _ _ _ -> nodeId
ExternDefinition nodeId _ _ _ -> nodeId
Rule nodeId _ _ _ -> nodeId
Not nodeId _ -> nodeId
Atom nodeId _ _ -> nodeId
BinOp nodeId _ _ _ -> nodeId
Constraint nodeId _ _ _ -> nodeId
Lit nodeId _ -> nodeId
Var nodeId _ -> nodeId
Hole nodeId -> nodeId
getNodeIdF :: ASTF a -> NodeId
getNodeIdF = \case
ModuleF nodeId _ -> nodeId
DeclareTypeF nodeId _ _ _ -> nodeId
ExternDefinitionF nodeId _ _ _ -> nodeId
RuleF nodeId _ _ _ -> nodeId
NotF nodeId _ -> nodeId
AtomF nodeId _ _ -> nodeId
BinOpF nodeId _ _ _ -> nodeId
ConstraintF nodeId _ _ _ -> nodeId
LitF nodeId _ -> nodeId
VarF nodeId _ -> nodeId
HoleF nodeId -> nodeId
getExternDefs :: AST -> [Extern]
getExternDefs = cata $ \case
ExternDefinitionF _ name argTys mRetTy ->
let extKind = if isJust mRetTy then ExternFunction else ExternConstraint
in one $ Extern name (length argTys) extKind
astf ->
fold astf
instance Pretty Type where
pretty = \case
U32 -> "u32"
Str -> "string"
TUnknown x -> "ty" <> show x
data RenderPosition = TopLevel | Nested
instance Pretty AST where
pretty ast = runReader (pretty' ast) TopLevel
where
pretty' = \case
Lit _ x ->
pure $ pretty x
Var _ v ->
pure $ pretty v
Hole _ ->
pure "?"
BinOp _ op lhs rhs -> do
lhs' <- pretty' lhs
rhs' <- pretty' rhs
pure $ parens $ lhs' <+> pretty op <+> rhs'
Constraint _ op lhs rhs -> do
lhs' <- pretty' lhs
rhs' <- pretty' rhs
pure $ lhs' <+> pretty op <+> rhs'
Not _ clause ->
("!" <>) <$> pretty' clause
Atom _ name values -> do
end <- ask <&> \case
TopLevel -> "."
Nested -> mempty
values' <- traverse pretty' values
pure $ pretty name <> parens (withCommas values') <> end
Rule _ name values clauses -> do
(values', clauses') <- local (const Nested) $ do
(,) <$> traverse pretty' values <*> traverse pretty' clauses
let separators = replicate (length clauses - 1) "," ++ ["."]
pure $ pretty name <> parens (withCommas values') <+> ":-" <> hardline <>
indent 2 (vsep (zipWith (<>) clauses' separators))
ExternDefinition _ name args mRetTy -> do
let prettyRetTy = case mRetTy of
Just retTy -> " " <> pretty retTy
Nothing -> mempty
pure $ "@extern" <+> pretty name <> parens (withCommas $ map prettyArg args)
<> prettyRetTy <> "."
DeclareType _ name tys attrs ->
pure $ "@def"
<+> pretty name
<> parens (withCommas $ map prettyArg tys)
<> prettyAttrs
<> "."
where
prettyAttrs = case attrs of
Internal -> ""
Input -> " input"
Output -> " output"
InputOutput -> " input output"
Module _ decls -> do
decls' <- traverse pretty' decls
pure $ vsep $ intersperse mempty decls'
prettyArg (mName, ty) =
maybe (pretty ty) (\fieldName -> pretty fieldName <> ":" <+> pretty ty) mName
================================================
FILE: lib/Eclair/AST/Lower.hs
================================================
module Eclair.AST.Lower
( compileToRA
) where
import Prelude hiding (swap, project)
import qualified Data.Graph as G
import qualified Data.Map as M
import Eclair.AST.Codegen
import Eclair.AST.IR hiding (Clause)
import Eclair.Common.Id
import Eclair.Common.Location (NodeId(..))
import qualified Eclair.RA.IR as RA
import Eclair.Common.Extern
type RA = RA.RA
type Relation = RA.Relation
compileToRA :: [Extern] -> AST -> RA
compileToRA externs ast =
RA.Module (NodeId 0) $ concatMap processDecls sortedDecls
where
sortedDecls = scc ast
processDecls :: [AST] -> [RA]
processDecls = \case
[Atom _ name values] -> runCodegen externs $
let literals = map toTerm values
in one <$> project name literals
[Rule _ name args clauses] ->
let terms = map toTerm args
in runCodegen externs $ processSingleRule [name] name terms clauses
rules -> -- case for multiple mutually recursive rules
let sccNames = rules & mapMaybe (\case
Rule _ name _ _ -> Just name
_ -> Nothing)
in runCodegen externs $ processMultipleRules sccNames rules
scc :: AST -> [[AST]]
scc = \case
Module _ decls -> map G.flattenSCC sortedDecls'
where
relevantDecls = filter isRelevant decls
sortedDecls' = G.stronglyConnComp $ zipWith (\i d -> (d, i, refersTo d)) [0..] relevantDecls
declLineMapping = M.fromListWith (<>) $ zipWith (\i d -> (nameFor d, [i])) [0..] relevantDecls
isRelevant = \case
Atom {} -> True
Rule {} -> True
Not {} -> True
_ -> False
nameFor = \case
Atom _ name _ -> name
Rule _ name _ _ -> name
_ -> unreachable -- Because of "isRelevant"
refersTo :: AST -> [Int]
refersTo = \case
Rule _ _ _ clauses ->
-- If no top level facts are defined, no entry exists in declLine mapping -> default to -1
concatMap (fromMaybe [-1] . flip M.lookup declLineMapping . dependsOn) $ filter isRelevant clauses
_ -> []
dependsOn = \case
Atom _ name _ -> name
Rule _ name _ _ -> name
Not _ (Atom _ name _) -> name
_ -> unreachable -- Because of "isRelevant"
_ -> unreachable -- Because rejected by parser
where unreachable = panic "Unreachable code in 'scc'"
-- NOTE: These rules can all be evaluated in parallel inside the fixpoint loop
processMultipleRules :: [Relation] -> [AST] -> CodegenM [RA]
processMultipleRules sccNames rules = sequence stmts where
stmts = mergeStmts <> [loop (purgeStmts <> ruleStmts <> [exitStmt] <> endLoopStmts)]
mergeStmts = map (\r -> merge r (deltaRelationOf r)) uniqRelations
purgeStmts = map (purge . newRelationOf) uniqRelations
ruleStmts = [parallel $ map lowerRule rulesInfo]
exitStmt = exit $ map newRelationOf uniqRelations
endLoopStmts = concatMap toMergeAndSwapStmts uniqRelations
toMergeAndSwapStmts r =
let newRelation = newRelationOf r
deltaRelation = deltaRelationOf r
in [merge newRelation r, swap newRelation deltaRelation]
rulesInfo = mapMaybe extractRuleData rules
relations = map (\(r, _, _) -> r) rulesInfo
uniqRelations = uniqOrderPreserving relations
-- TODO: better func name
lowerRule (r, map toTerm -> ts, clauses) =
recursiveRuleToStmts sccNames r ts clauses
processSingleRule :: [Relation] -> Relation -> [CodegenM RA] -> [AST] -> CodegenM [RA]
processSingleRule sccNames relation terms clauses
| isRecursive sccNames clauses =
let deltaRelation = deltaRelationOf relation
newRelation = newRelationOf relation
stmts =
[ merge relation deltaRelation
, loop
[ purge newRelation
, ruleToStmt sccNames relation terms clauses
, exit [newRelation]
, merge newRelation relation
, swap newRelation deltaRelation
]
]
in sequence stmts
| otherwise = one <$> ruleToStmt sccNames relation terms clauses
ruleToStmt :: [Relation] -> Relation -> [CodegenM RA] -> [AST] -> CodegenM RA
ruleToStmt sccNames relation terms clauses
| isRecursive sccNames clauses =
recursiveRuleToStmts sccNames relation terms clauses
| otherwise = nestedSearchAndProject relation terms clauses mempty
recursiveRuleToStmts :: [Relation] -> Relation -> [CodegenM RA] -> [AST] -> CodegenM RA
recursiveRuleToStmts sccNames relation terms clauses =
parallel $
[ stmt
| i <- [0..sccClauseCount - 1]
, let sccAtom = maybeAt i sccAtoms
clauses' = map (maybeToDeltaClause sccAtom) clauses
sccAtoms' = drop (i + 1) sccAtoms
stmt = nestedSearchAndProject newRelation terms clauses' sccAtoms'
]
where
newRelation = newRelationOf relation
sccAtoms = clauses & filter isPartOfScc & mapMaybe (\case
Atom _ name args -> Just (name, args)
_ -> Nothing)
sccClauseCount = length sccAtoms
isPartOfScc = \case
Atom _ name _ -> name `elem` sccNames
_ -> False
maybeToDeltaClause sccAtom = \case
Atom nodeId clauseName args | sccAtom == Just (clauseName, args) ->
Atom nodeId (deltaRelationOf clauseName) args
clause -> clause
nestedSearchAndProject
:: Relation
-> [CodegenM RA]
-> [AST]
-> [(Relation, [AST])]
-> CodegenM RA
nestedSearchAndProject intoRelation terms clauses sccAtoms =
flip (foldr processRuleClause) clauses $
addNegatedDeltaAtoms sccAtoms $
project intoRelation terms
where
processRuleClause :: AST -> CodegenM RA -> CodegenM RA
processRuleClause clause inner = case clause of
Not _ (Atom _ clauseName args) -> do
-- No starts with check here, since cyclic negation is not allowed.
let terms' = map toTerm args
noElemOf clauseName terms' inner
Constraint _ op lhs rhs -> do
lhsTerm <- toTerm lhs
rhsTerm <- toTerm rhs
if' op lhsTerm rhsTerm inner
Atom _ clauseName args -> do
externs <- asks envExterns
let isExtern = isJust $ find (\(Extern name _ _) -> clauseName == name) externs
if isExtern
then do
clause' <- toTerm clause
zero <- toTerm (Lit (NodeId 0) $ LNumber 0)
if' NotEquals clause' zero inner
else search clauseName args inner
_ ->
panic "Unexpected rule clause in 'nestedSearchAndProject'!"
addNegatedDeltaAtoms =
foldr (\(clauseName, args) wrapper -> wrapper . addNegatedDeltaAtom clauseName args) id
addNegatedDeltaAtom :: Relation -> [AST] -> CodegenM RA -> CodegenM RA
addNegatedDeltaAtom clauseName args =
noElemOf (deltaRelationOf clauseName) (map toTerm args)
isRecursive :: [Relation] -> [AST] -> Bool
isRecursive sccNames clauses =
let atomNames = flip mapMaybe clauses $ \case
Atom _ name _ -> Just name
_ -> Nothing
in any (`elem` atomNames) sccNames
extractRuleData :: AST -> Maybe (Relation, [AST], [AST])
extractRuleData = \case
Rule _ name args clauses -> Just (name, args, clauses)
_ -> Nothing
newRelationOf, deltaRelationOf :: Relation -> Relation
deltaRelationOf = prependToId deltaPrefix
newRelationOf = prependToId newPrefix
================================================
FILE: lib/Eclair/AST/Transforms/ConstantFolding.hs
================================================
module Eclair.AST.Transforms.ConstantFolding
( transform
) where
import Eclair.AST.IR
import Eclair.Transform
transform :: Transform AST AST
transform = pureTransform $ cata $ \case
BinOpF nodeId op (Lit _ (LNumber lhs)) (Lit _ (LNumber rhs)) ->
let opFn = case op of
Plus -> (+)
Minus -> (-)
Multiply -> (*)
Divide -> div
in Lit nodeId $ LNumber $ opFn lhs rhs
ast ->
embed ast
================================================
FILE: lib/Eclair/AST/Transforms/DeadCodeElimination.hs
================================================
module Eclair.AST.Transforms.DeadCodeElimination
( transform
) where
import Eclair.Transform
import Eclair.AST.Analysis
import Eclair.AST.IR
transform :: Container DeadCode -> Transform AST AST
transform analysis =
pureTransform $ cata $ \case
ModuleF nodeId decls ->
Module nodeId $ filter (not . isDead) decls
RuleF nodeId name args clauses ->
Rule nodeId name args $
filter (\c -> not (isDead c || isRedundantAssign c)) clauses
astf ->
embed astf
where
deadCodeNodeIds =
map unDeadCode analysis
isDead ast =
getNodeId ast `elem` deadCodeNodeIds
isRedundantAssign = \case
Constraint _ Equals lhs rhs -> lhs == rhs
_ -> False
================================================
FILE: lib/Eclair/AST/Transforms/NormalizeRules.hs
================================================
module Eclair.AST.Transforms.NormalizeRules
( transform
) where
import Data.List (partition)
import Eclair.Transform
import Eclair.AST.IR
-- This transform prepares the AST for lowering to RA by:
-- 1. Shifting all constraints and negations to the end.
transform :: Transform AST AST
transform =
pureTransform $ cata rewriteVars
where
rewriteVars = \case
RuleF nodeId name values clauses -> do
let (matching, rest) = partition isConstraintOrNegation clauses
(constraints, negations) = partition isConstraint matching
Rule nodeId name values $ rest <> constraints <> negations
astf ->
embed astf
isConstraintOrNegation :: AST -> Bool
isConstraintOrNegation = \case
Constraint {} -> True
Not {} -> True
_ -> False
isConstraint :: AST -> Bool
isConstraint = \case
Constraint {} -> True
_ -> False
================================================
FILE: lib/Eclair/AST/Transforms/RemoveAliases.hs
================================================
module Eclair.AST.Transforms.RemoveAliases
( transform
) where
import qualified Data.Map as M
import Eclair.Transform
import Eclair.AST.IR
import Eclair.Comonads
import Eclair.Common.Extern
-- This transform reduces the amount of helper variables used in assignments.
transform :: [Extern] -> Transform AST AST
transform externs =
Transform $ usingReaderT Nothing . gcata (distribute directlyGroundedVars equatedVars) rewrite
where
distribute :: Corecursive t
=> (Base t (t, a) -> a)
-> (Base t (t, b) -> b)
-> Base t (Quad t a b c) -> Quad t a b (Base t c)
distribute f g m =
let base_t_t = map qFirst m
base_t_ta = map (qFirst &&& qSecond) m
base_t_tb = map (qFirst &&& qThird) m
base_t_c = map qFourth m
in Quad (embed base_t_t) (f base_t_ta) (g base_t_tb) base_t_c
externNames = map (\(Extern name _ _) -> name) externs
-- Finds all vars directly inside a relation atom (not in a negation).
directlyGroundedVars = \case
AtomF _ name args | name `notElem` externNames ->
flip mapMaybe args $ \case
(Var _ v, _) -> Just v
_ -> Nothing
NotF {} -> mempty
astf ->
foldMap snd astf
-- Find all vars used in equalities
equatedVars = \case
ConstraintF _ Equals lhs rhs -> case (fst lhs, fst rhs) of
(lhs'@(Var _ v1), rhs'@(Var _ v2)) ->
[(v1, rhs'), (v2, lhs')]
(Var _ v, rhs') ->
one (v, rhs')
(lhs', Var _ v) ->
one (v, lhs')
_ ->
mempty
astf ->
foldMap snd astf
-- Aliases = equated vars - directly grounded vars
findAliases dgVars = filter ((`notElem` dgVars) . fst)
rewrite = \case
RuleF nodeId name args clauses -> do
let dgVars = concatMap qSecond clauses
eqs = concatMap qThird clauses
subst = M.fromList $ filter (not . occursCheck) $ findAliases dgVars eqs
local (const $ Just subst) $
Rule nodeId name
<$> traverse extract args
<*> traverse extract clauses
VarF nodeId v -> do
let var = Var nodeId v
-- Because of how the substitution is constructed,
-- it's always safe to try and replace variables.
maybe var (`resolveAliases` var) <$> ask
astf ->
embed <$> traverse extract astf
resolveAliases subst =
ana $ \case
Var nodeId v ->
maybe (VarF nodeId v) project $ M.lookup v subst
ast -> project ast
-- Occurs check is needed to prevent aliases from growing larger and larger.
occursCheck (v, ast) =
let vars = flip cata ast $ \case
VarF _ var -> [var]
astf -> fold astf
in v `elem` vars
================================================
FILE: lib/Eclair/AST/Transforms/ReplaceStrings.hs
================================================
module Eclair.AST.Transforms.ReplaceStrings
( StringMap
, transform
) where
import qualified Data.Map as Map
import Eclair.AST.IR
import Eclair.Common.Id
import Eclair.Transform
-- NOTE: "String" here means an eclair string!
type StringMap = Map Text Word32
transform :: Transform AST (AST, StringMap)
transform =
Transform $ usingStateT mempty . cata rewrite
where
rewrite :: RewriteRuleT (StateT StringMap) AST
rewrite = \case
DeclareTypeF nodeId name tys attrs -> do
-- By putting the relation names in the symbol table, we can easily
-- create a unique integer constant for the fact type mapping.
_ <- replaceString (unId name)
pure $ DeclareType nodeId name tys attrs
LitF nodeId (LString s) ->
Lit nodeId . LNumber <$> replaceString s
astf ->
embed <$> sequence astf
replaceString :: Monad m => Text -> StateT StringMap m Word32
replaceString str = do
value <- gets $ \strMap ->
let count = fromIntegral $ length strMap
in Map.findWithDefault count str strMap
modify $ Map.insert str value
pure value
================================================
FILE: lib/Eclair/AST/Transforms.hs
================================================
module Eclair.AST.Transforms
( simplify
, ReplaceStrings.StringMap
) where
import Eclair.AST.IR
import Eclair.AST.Analysis
import Eclair.Transform
import qualified Eclair.AST.Transforms.ConstantFolding as ConstantFolding
import qualified Eclair.AST.Transforms.RemoveAliases as RemoveAliases
import qualified Eclair.AST.Transforms.DeadCodeElimination as DCE
import qualified Eclair.AST.Transforms.ReplaceStrings as ReplaceStrings
import qualified Eclair.AST.Transforms.NormalizeRules as NormalizeRules
import Eclair.Common.Extern
-- Transforms can be grouped into 3 parts:
--
-- 1. transforms that need to run a single time, before optimizations
-- 2. main optimization pipeline (runs until fixpoint is reached)
-- 3. transforms that need to run a single time, after optimizations
simplify :: NodeId -> [Extern] -> SemanticInfo -> AST -> (AST, ReplaceStrings.StringMap)
simplify nodeId externs analysis =
runTransform nodeId
-- Transforms before optimizations:
$ ConstantFolding.transform
-- Optimizations that run until fixpoint is reached:
>>> RemoveAliases.transform externs
>>> ConstantFolding.transform
>>> DCE.transform (deadCodeIds analysis)
-- Transforms after optimizations:
>>> NormalizeRules.transform
>>> ReplaceStrings.transform
================================================
FILE: lib/Eclair/ArgParser.hs
================================================
module Eclair.ArgParser
( parseArgs
, parser
, Config(..)
, CompileConfig(..)
, EmitKind(..)
, Target(..)
) where
import Eclair.Common.Config
import Options.Applicative
import qualified Data.List.Extra as L
parseArgs :: [String] -> IO Config
parseArgs = handleParseResult . execParserPure parserPrefs parserInfo
where
desc = fullDesc <> progDesc "The Eclair Datalog compiler."
parserPrefs = prefs $ showHelpOnError <> showHelpOnEmpty
parserInfo = info (parser <**> helper) desc
parser :: Parser Config
parser = hsubparser (longCompileCommand <> shortCompileCommand)
<|> hsubparser lspCommand
where
longCompileCommand = command "compile" compileCommand
shortCompileCommand = command "c" compileCommand
compileCommand = info compileParser compileDesc
compileDesc = fullDesc <> header "eclair compile" <> progDesc "Compiles Datalog files."
lspCommand = command "lsp" $ info (pure LSP) lspDesc
lspDesc = fullDesc <> header "eclair lsp" <> progDesc "Runs the Eclair LSP server."
compileParser :: Parser Config
compileParser = Compile <$> compileParser'
where
compileParser' =
CompileConfig <$> argument str (metavar "FILE" <> help "The main Datalog file to compile.")
<*> emitKindParser
<*> optional targetParser
<*> numCoresParser
targetParser :: Parser Target
targetParser =
option (maybeReader parseTarget) $ metavar "TARGET" <> long "target" <> short 't' <> help desc
where
desc = "Select the target CPU architecture. Default is to use the host architecture. Supported options: 'wasm32'."
parseTarget = \case
"wasm32" -> Just Wasm32
_ -> Nothing
emitKindParser :: Parser EmitKind
emitKindParser =
option (maybeReader readEmitKind) (long "emit" <> value EmitLLVM <> help desc)
where
readEmitKind opt = case L.lower opt of
"ast-transformed" -> Just EmitTransformedAST
"ra" -> Just EmitRA
"ra-transformed" -> Just EmitTransformedRA
"eir" -> Just EmitEIR
"llvm" -> Just EmitLLVM
"souffle" -> Just EmitSouffle
_ -> Nothing
desc = "Compile to a specific format. Defaults to LLVM IR. Supported options: 'ast-transformed, 'ra', 'ra-transformed', 'eir', 'llvm' and 'souffle'."
numCoresParser :: Parser Word
numCoresParser = option auto $
long "jobs"
<> metavar "JOBS"
<> short 'j'
<> value 1
<> help "Number of threads used for compilation."
================================================
FILE: lib/Eclair/Common/Config.hs
================================================
module Eclair.Common.Config
( EmitKind(..)
, CompileConfig(..)
, Target(..)
, Config(..)
) where
data EmitKind
= EmitTransformedAST
| EmitRA
| EmitTransformedRA
| EmitEIR
| EmitLLVM
| EmitSouffle
-- TODO: object file, WASM, ...
deriving (Eq, Show)
-- TODO: optimization levels (-Ox), include dirs (-I), logging level (-q, -v), timing, ...
data CompileConfig
= CompileConfig
{ mainFile :: FilePath
, emitKind :: EmitKind
, cpuTarget :: Maybe Target -- Nothing = compile to host architecture
, numCores :: Word -- Maximum number of cores Eclair is allowed to use
} deriving (Eq, Show)
data Target
= Wasm32
deriving (Eq, Show)
data Config
= Compile CompileConfig
| LSP
deriving (Eq, Show)
================================================
FILE: lib/Eclair/Common/Extern.hs
================================================
module Eclair.Common.Extern
( Extern(..)
, ExternKind(..)
) where
import Eclair.Common.Id
data Extern = Extern Id Int ExternKind
deriving (Eq, Show)
data ExternKind
= ExternConstraint
| ExternFunction
deriving (Eq, Show)
================================================
FILE: lib/Eclair/Common/Id.hs
================================================
module Eclair.Common.Id
( Id(..)
, prependToId
, appendToId
, startsWithId
, stripIdPrefixes
, startsWithIdPrefix
, deltaPrefix
, newPrefix
) where
import qualified Data.Text as T
import qualified Language.Souffle.Marshal as S
import Prettyprinter
newtype Id = Id { unId :: Text }
deriving (Eq, Ord, Show, Generic)
deriving anyclass S.Marshal
instance Pretty Id where
pretty = pretty . unId
appendToId :: Id -> Text -> Id
appendToId (Id x) y = Id (x <> y)
prependToId :: Text -> Id -> Id
prependToId x (Id y) = Id (x <> y)
startsWithId :: Id -> Id -> Bool
startsWithId (Id x) (Id start) =
start `T.isPrefixOf` x
stripIdPrefixes :: Id -> Id
stripIdPrefixes (Id x) = Id $ stripPrefixes x where
stripPrefixes t = foldl' stripPrefix t [deltaPrefix, newPrefix]
stripPrefix acc prefix = fromMaybe acc (T.stripPrefix prefix acc)
-- TODO: make all prefixes starts with special symbol, invalid in syntax
deltaPrefix, newPrefix :: Text
deltaPrefix = "delta_"
newPrefix = "new_"
startsWithIdPrefix :: Id -> Bool
startsWithIdPrefix (Id x) =
any (`T.isPrefixOf` x) [deltaPrefix, newPrefix]
================================================
FILE: lib/Eclair/Common/Literal.hs
================================================
module Eclair.Common.Literal
( Literal(..)
) where
import Prettyprinter (Pretty (pretty), dquotes)
data Literal
= LNumber Word32
| LString Text
deriving (Eq, Show)
instance Pretty Literal where
pretty = \case
LNumber x -> pretty x
LString x -> dquotes $ pretty x
================================================
FILE: lib/Eclair/Common/Location.hs
================================================
module Eclair.Common.Location
( NodeId(..)
, Span(..)
, SpanMap(..)
, SourcePos(..)
, SourceSpan(..)
, insertSpan
, lookupSpan
, lookupNodeId
, spanToSourceSpan
) where
import qualified Text.Megaparsec as P
import qualified Data.Map as M
import qualified Language.Souffle.Marshal as S
import Data.Maybe (fromJust)
newtype NodeId
= NodeId
{ unNodeId :: Word32
} deriving (Eq, Ord, Show, Generic)
deriving S.Marshal
-- A source span (begin and end position)
data Span
= Span
{ beginPos :: {-# UNPACK #-} !Int
, endPos :: {-# UNPACK #-} !Int
} deriving Show
data SpanMap =
SpanMap
{ spanMapPath :: !FilePath
, spanMapSpans :: !(Map Word32 Span)
}
deriving Show
insertSpan :: NodeId -> Span -> SpanMap -> SpanMap
insertSpan nodeId span' (SpanMap path m) =
SpanMap path (M.insert (unNodeId nodeId) span' m)
-- NOTE: this assumes the node ID is generated by parsing the same file that resulted in the SpanMap.
lookupSpan :: SpanMap -> NodeId -> Span
lookupSpan (SpanMap _path m) nodeId =
fromJust $ M.lookup (unNodeId nodeId) m
-- Finds the most specific NodeId (that corresponds with the smallest span)
lookupNodeId :: SpanMap -> Int -> Maybe NodeId
lookupNodeId (SpanMap _ m) offset =
m & M.toList
& filter (containsOffset . snd)
-- Just sorting by span size is not enough, sometimes we have two spans
-- with identical widths (e.g. with parentheses). The last one will always
-- be the node ID that belongs to the smallest (most specific) node.
& sortWith (spanSize . snd &&& negate . fst)
& viaNonEmpty head
& map (NodeId . fst)
where
containsOffset span' =
offset >= beginPos span' && offset < endPos span'
spanSize span' =
endPos span' - beginPos span'
-- Helpers for producing error messages:
-- Line and column information. 0-based!
data SourcePos
= SourcePos
{ sourcePosLine :: {-# UNPACK #-} !Int
, sourcePosColumn :: {-# UNPACK #-} !Int
} deriving (Eq, Ord, Show)
data SourceSpan
= SourceSpan
{ sourceSpanFile :: FilePath
, sourceSpanBegin :: {-# UNPACK #-} !SourcePos
, sourceSpanEnd :: {-# UNPACK #-} !SourcePos
} deriving (Eq, Show)
spanToSourceSpan :: FilePath -> Text -> Span -> SourceSpan
spanToSourceSpan path text span'@(Span begin end) =
either raiseError id parseResult
where
parseResult = P.runParser parser path text
parser :: P.Parsec Void Text SourceSpan
parser = do
_ <- P.takeP Nothing begin
beginPos' <- P.getSourcePos
_ <- P.takeP Nothing diff
endPos' <- P.getSourcePos
let beginSourcePos = SourcePos (line beginPos' - 1) (column beginPos' - 1)
endSourcePos = SourcePos (line endPos' - 1) (column endPos' - 1)
pure $ SourceSpan path beginSourcePos endSourcePos
where
diff = end - begin
line = P.unPos . P.sourceLine
column = P.unPos . P.sourceColumn
raiseError =
const $ panic $ "Failed to get source location for file '" <> toText path <> "' and span " <> show span'
================================================
FILE: lib/Eclair/Common/Operator.hs
================================================
module Eclair.Common.Operator
( ArithmeticOp(..)
, LogicalOp(..)
, isEqualityOp
, invertLogicalOp
) where
import Eclair.Common.Pretty
data ArithmeticOp
= Plus
| Minus
| Multiply
| Divide -- NOTE: integer division
deriving (Eq, Show)
data LogicalOp
= Equals -- =
| NotEquals -- !=
| LessThan -- <
| LessOrEqual -- <=
| GreaterThan -- >
| GreaterOrEqual -- >=
deriving (Eq, Show)
invertLogicalOp :: LogicalOp -> LogicalOp
invertLogicalOp = \case
Equals -> NotEquals
NotEquals -> Equals
LessThan -> GreaterOrEqual
GreaterThan -> LessOrEqual
LessOrEqual -> GreaterThan
GreaterOrEqual -> LessThan
isEqualityOp :: LogicalOp -> Bool
isEqualityOp = \case
Equals -> True
NotEquals -> True
_ -> False
instance Pretty ArithmeticOp where
pretty = \case
Plus -> "+"
Minus -> "-"
Multiply -> "*"
Divide -> "/"
instance Pretty LogicalOp where
pretty = \case
Equals -> "="
NotEquals -> "!="
LessThan -> "<"
LessOrEqual -> "<="
GreaterThan -> ">"
GreaterOrEqual -> ">="
================================================
FILE: lib/Eclair/Common/Pretty.hs
================================================
module Eclair.Common.Pretty
( module Eclair.Common.Pretty
, module Prettyprinter
, module Prettyprinter.Render.Text
) where
import Prettyprinter
import Prettyprinter.Render.Text
printDoc :: Pretty a => a -> Text
printDoc = renderStrict . layoutSmart defaultLayoutOptions . pretty
indentation :: Int
indentation = 2
interleaveWith :: Doc ann -> [Doc ann] -> Doc ann
interleaveWith d = hsep . punctuate d
withCommas :: [Doc ann] -> Doc ann
withCommas = interleaveWith comma
withAnds :: [Doc ann] -> Doc ann
withAnds = interleaveWith (space <> "and")
between :: Doc ann -> Doc ann -> Doc ann -> Doc ann
between begin end doc =
begin <> doc <> end
================================================
FILE: lib/Eclair/Comonads.hs
================================================
module Eclair.Comonads
( module Eclair.Comonads
) where
data Triple a b c
= Triple
{ tFst :: a
, tSnd :: b
, tThd :: c
} deriving Functor
instance Comonad (Triple a b) where
extract (Triple _ _ c) = c
duplicate (Triple a b c) =
Triple a b (Triple a b c)
data Quad a b c d
= Quad
{ qFirst :: a
, qSecond :: b
, qThird :: c
, qFourth :: d
} deriving Functor
instance Comonad (Quad a b c) where
extract (Quad _ _ _ d) = d
duplicate (Quad a b c d) =
Quad a b c (Quad a b c d)
================================================
FILE: lib/Eclair/EIR/IR.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module Eclair.EIR.IR
( EIR(..)
, EIRF(..)
, Relation
, Op(..)
, LogicalOp(..)
, ArithmeticOp(..)
, Type(..)
, Function(..)
, LabelId(..)
, Visibility(..)
) where
import Eclair.Common.Id
import Eclair.Common.Operator
import Eclair.Common.Literal
import Eclair.Common.Pretty
import Eclair.RA.IndexSelection (Index)
import Eclair.LLVM.Metadata
type Relation = Id
data Type
= Program
| Value
| Iter
| Pointer Type
| Void
deriving (Eq, Show)
data Function
= InitializeEmpty
| Destroy
| Purge
| Swap
| InsertRange Relation Index -- InsertRange specialized for this relation and index
| IsEmpty
| Size
| Contains
| Insert
| IterCurrent
| IterNext
| IterIsEqual
| IterLowerBound
| IterUpperBound
| IterBegin
| IterEnd
deriving (Eq, Show)
newtype LabelId
= LabelId Text
deriving (Eq, Show)
instance IsString LabelId where
fromString = LabelId . fromString
data Op
= RelationOp Relation Index Function -- a primop for operations on relations
| SymbolTableInit
| SymbolTableDestroy
| SymbolTableInsert
| ComparisonOp LogicalOp
| ArithOp ArithmeticOp
| ExternOp Id
deriving (Eq, Show)
data Visibility
= Public
| Private
deriving (Eq, Show)
data EIR
= Module [EIR] -- A module is the same as a block, but is rendered in a different way.
| Block [EIR]
| Function Visibility Text [Type] Type EIR
| FunctionArg Int
| DeclareProgram [(Relation, Metadata)]
| FieldAccess EIR Int
| Var Text
| Assign EIR EIR
| PrimOp Op [EIR] -- A primitive operation, these tend to be simple function calls or operators
| HeapAllocateProgram
| FreeProgram EIR
| StackAllocate Relation Index Type
| Par [EIR]
| Loop [EIR]
| If EIR EIR
| Not EIR
| And EIR EIR
| Jump LabelId
| Label LabelId
| Return EIR
| Lit Literal
deriving (Eq, Show)
makeBaseFunctor ''EIR
indentBlock :: Doc ann -> Doc ann -> Doc ann -> Doc ann
indentBlock begin end blk =
nest indentation (begin <> hardline <> blk) <> hardline <> end
braceBlock :: Doc ann -> Doc ann
braceBlock = indentBlock "{" "}"
statementBlock :: Pretty a => [a] -> Doc ann
statementBlock = braceBlock . vsep . map pretty
instance Pretty Type where
pretty = \case
Program -> "Program"
Value -> "Value"
Iter -> "Iter"
Pointer ty -> "*" <> pretty ty
Void -> "Void"
instance Pretty Function where
pretty = \case
InitializeEmpty -> "init_empty"
Destroy -> "destroy"
Purge -> "purge"
Swap -> "swap"
InsertRange r idx -> "insert_range" <> angles (pretty r <> pretty idx)
IsEmpty -> "is_empty"
Contains -> "contains"
Insert -> "insert"
IterCurrent -> "iter_current"
IterNext -> "iter_next"
IterIsEqual -> "iter_is_equal"
IterLowerBound -> "iter_lower_bound"
IterUpperBound -> "iter_upper_bound"
IterBegin -> "iter_begin"
IterEnd -> "iter_end"
Size -> "size"
instance Pretty LabelId where
pretty (LabelId label) = pretty label
instance Pretty Op where
pretty = \case
SymbolTableInit ->
"symbol_table.init"
SymbolTableDestroy ->
"symbol_table.destroy"
SymbolTableInsert ->
"symbol_table.insert"
RelationOp r _idx fn ->
pretty r <> "." <> pretty fn
ComparisonOp op ->
-- Since `=` is already used for assignment in EIR, we use `==` for comparison.
if op == Equals then "==" else pretty op
ArithOp op ->
pretty op
ExternOp op ->
pretty op
instance Pretty EIR where
pretty = \case
Module stmts ->
-- This adds newlines in between top level EIR statements
vsep $ intersperse mempty $ map pretty stmts
Block stmts ->
statementBlock stmts
Function visibility name tys retTy body ->
let fn = if visibility == Public
then "export fn"
else "fn"
in vsep [ fn <+> pretty name <> parens (withCommas $ map pretty tys) <+> "->" <+> pretty retTy
, pretty body -- Note: This is already a Block
]
FunctionArg pos -> "FN_ARG" <> brackets (pretty pos)
DeclareProgram metadatas ->
vsep [ "declare_type" <+> "Program"
, braceBlock . vsep $
"symbol_table" : map (\(r, meta) -> pretty r <+> pretty meta) metadatas
]
FieldAccess ptr pos ->
pretty ptr <> "." <> pretty pos
Var v -> pretty v
Assign var value ->
pretty var <+> "=" <+> pretty value
PrimOp op [arg1, arg2] | isInfixPrimOp op ->
parens $ pretty arg1 <+> pretty op <+> pretty arg2
PrimOp op args ->
pretty op <> parens (withCommas $ map pretty args)
HeapAllocateProgram ->
"heap_allocate_program"
FreeProgram ptr ->
"free_program" <> parens (pretty ptr)
StackAllocate r _idx ty ->
pretty r <> "." <> "stack_allocate" <+> pretty ty
Par stmts ->
vsep ["parallel", statementBlock stmts]
Loop stmts ->
vsep ["loop", statementBlock stmts]
If cond body ->
let wrap = case body of
Block _ -> identity
_ -> braceBlock
in vsep ["if" <+> parens (pretty cond), wrap (pretty body)]
Not bool' ->
"not" <+> pretty bool'
And bool1 bool2 ->
pretty bool1 <+> "&&" <+> pretty bool2
Jump label ->
"goto" <+> pretty label
Label label ->
pretty label <> colon
Return value ->
"return" <+> pretty value
Lit x -> pretty x
isInfixPrimOp :: Op -> Bool
isInfixPrimOp = \case
ComparisonOp {} -> True
ArithOp {} -> True
_ -> False
================================================
FILE: lib/Eclair/EIR/Lower/API.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.EIR.Lower.API
( CodegenInOutT
, mkInOutState
, codegenAPI
, apiFunction
) where
import Prelude hiding (void)
import Control.Monad.Morph
import Data.Traversable (for)
import Data.Maybe (fromJust)
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.List as L
import qualified Eclair.EIR.IR as EIR
import qualified Eclair.LLVM.Symbol as Symbol
import qualified Eclair.LLVM.SymbolTable as SymbolTable
import Eclair.LLVM.Codegen as LLVM
import Eclair.LLVM.Metadata
import Eclair.EIR.Lower.Codegen
import Eclair.AST.IR (UsageMode(..))
import Eclair.RA.IndexSelection
import Eclair.Common.Id
type Relation = EIR.Relation
-- Helper data type that pre-computes most of the important data.
data InOutState
= InOutState
{ relationMapping :: Map Relation Word32
, relationNumColumns :: Map Relation Int
, relations :: Set Relation
, indicesByRelation :: Map Relation [Index]
, offsetsByRelationAndIndex :: Map (Relation, Index) Int
, inOutLowerState :: LowerState
}
type CodegenInOutT = ReaderT InOutState
codegenAPI :: Map Id Word32 -> Map Relation UsageMode -> [(Relation, Metadata)] -> LowerState -> ModuleBuilderT IO ()
codegenAPI relMapping usageMapping metas lowerState = do
usingReaderT (mkInOutState relMapping metas lowerState) $ do
addFactsFn <- generateAddFactsFn usageMapping
_ <- generateAddFact addFactsFn
_ <- generateGetFactsFn usageMapping
_ <- generateFreeBufferFn
_ <- generateFactCountFn usageMapping
_ <- generateEncodeStringFn
_ <- generateDecodeStringFn
pass
generateAddFact :: MonadFix m => Operand -> CodegenInOutT (ModuleBuilderT m) Operand
generateAddFact addFactsFn = do
lowerState <- asks inOutLowerState
let args = [ (ptr (programType lowerState), ParameterName "eclair_program")
, (i32, ParameterName "fact_type")
, (ptr i32, ParameterName "memory")
]
returnType = void
apiFunction "eclair_add_fact" args returnType $ \[program, factType, memory] -> do
_ <- call addFactsFn [program, factType, memory, int32 1]
retVoid
generateAddFactsFn :: MonadFix m => Map Id UsageMode -> CodegenInOutT (ModuleBuilderT m) Operand
generateAddFactsFn usageMapping = do
inOutState <- ask
let lowerState = inOutLowerState inOutState
rels = S.filter (isInputRelation usageMapping) $ relations inOutState
args = [ (ptr (programType lowerState), ParameterName "eclair_program")
, (i32, ParameterName "fact_type")
, (ptr i32, ParameterName "memory")
, (i32, ParameterName "fact_count")
]
returnType = void
apiFunction "eclair_add_facts" args returnType $ \[program, factType, memory, factCount] -> mdo
switchOnFactType rels (relationMapping inOutState) retVoid factType $ \r -> do
indexes <- indicesForRelation r
for_ indexes $ \idx -> do
numCols <- fromIntegral <$> numColsForRelation r
treeOffset <- int32 . toInteger <$> offsetForRelationAndIndex r idx
relationPtr <- gep program [int32 0, treeOffset]
-- TODO: don't re-calculate this type, do this based on value datatype created in each runtime data structure
let arrayPtr = ptrcast (ArrayType numCols i32) memory
loopFor (int32 0) (`ult` factCount) (add (int32 1)) $ \i -> do
valuePtr <- gep arrayPtr [i]
fn <- toCodegenInOut lowerState $ lookupFunction r idx EIR.Insert
call fn [relationPtr, valuePtr]
br end -- early return
end <- blockNamed "end"
retVoid
generateGetFactsFn :: MonadFix m => Map Relation UsageMode -> CodegenInOutT (ModuleBuilderT m) Operand
generateGetFactsFn usageMapping = do
inOutState <- ask
let lowerState = inOutLowerState inOutState
rels = S.filter (isOutputRelation usageMapping) $ relations inOutState
args = [ (ptr (programType lowerState), ParameterName "eclair_program")
, (i32, ParameterName "fact_type")
]
returnType = ptr i32
mallocFn = extMalloc $ externals lowerState
apiFunction "eclair_get_facts" args returnType $ \[program, factType] -> do
switchOnFactType rels (relationMapping inOutState) (ret $ nullPtr i32) factType $ \r -> do
indexes <- indicesForRelation r
let idx = fromJust $ findLongestIndex indexes
doCall op args' = do
fn <- toCodegenInOut lowerState $ lookupFunction r idx op
call fn args'
numCols <- numColsForRelation r
let valueSize = 4 * numCols -- TODO: should use LLVM "valueSize" instead of re-calculating here
treeOffset <- int32 . toInteger <$> offsetForRelationAndIndex r idx
relationPtr <- gep program [int32 0, treeOffset]
relationSize <- doCall EIR.Size [relationPtr] >>= (`trunc` i32)
memorySize <- mul relationSize (int32 $ toInteger valueSize)
memory <- call mallocFn [memorySize]
let arrayPtr = ptrcast (ArrayType (fromIntegral numCols) i32) memory
iPtr <- alloca i32 (Just (int32 1)) 0
store iPtr 0 (int32 0)
let iterTy = evalState (toLLVMType r idx EIR.Iter) lowerState
currIter <- alloca iterTy (Just (int32 1)) 0
endIter <- alloca iterTy (Just (int32 1)) 0
_ <- doCall EIR.IterBegin [relationPtr, currIter]
_ <- doCall EIR.IterEnd [relationPtr, endIter]
let loopCondition = do
isEqual <- doCall EIR.IterIsEqual [currIter, endIter]
not' isEqual
loopWhile loopCondition $ do
i <- load iPtr 0
valuePtr <- gep arrayPtr [i]
currentVal <- doCall EIR.IterCurrent [currIter]
copy (mkPath []) currentVal valuePtr
i' <- add i (int32 1)
store iPtr 0 i'
doCall EIR.IterNext [currIter]
ret $ ptrcast i32 memory
generateFreeBufferFn :: Monad m => CodegenInOutT (ModuleBuilderT m) Operand
generateFreeBufferFn = do
lowerState <- asks inOutLowerState
let freeFn = extFree $ externals lowerState
args = [(ptr i32, ParameterName "buffer")]
returnType = void
apiFunction "eclair_free_buffer" args returnType $ \[buf] -> mdo
let memory = ptrcast i8 buf
_ <- call freeFn [memory]
retVoid
generateFactCountFn :: MonadFix m => Map Id UsageMode -> CodegenInOutT (ModuleBuilderT m) Operand
generateFactCountFn usageMapping = do
inOutState <- ask
let lowerState = inOutLowerState inOutState
rels = S.filter (isOutputRelation usageMapping) $ relations inOutState
args = [ (ptr (programType lowerState), ParameterName "eclair_program")
, (i32, ParameterName "fact_type")
]
returnType = i32
apiFunction "eclair_fact_count" args returnType $ \[program, factType] -> do
switchOnFactType rels (relationMapping inOutState) (ret $ int32 0) factType $ \r -> do
indexes <- indicesForRelation r
let idx = fromJust $ findLongestIndex indexes
doCall op args' = do
fn <- toCodegenInOut lowerState $ lookupFunction r idx op
call fn args'
treeOffset <- int32 . toInteger <$> offsetForRelationAndIndex r idx
relationPtr <- gep program [int32 0, treeOffset]
relationSize <- doCall EIR.Size [relationPtr]
ret =<< trunc relationSize i32
-- NOTE: string does not need to be 0-terminated, length field is used to determine length (in bytes).
-- Eclair makes an internal copy of the string, for simpler memory management.
generateEncodeStringFn :: MonadFix m => CodegenInOutT (ModuleBuilderT m) Operand
generateEncodeStringFn = do
lowerState <- asks inOutLowerState
let args = [ (ptr (programType lowerState), "eclair_program")
, (i32, "string_length")
, (ptr i8, "string_data")
]
(symbolTable, symbol) = (symbolTableFns &&& symbolFns) lowerState
exts = externals lowerState
apiFunction "eclair_encode_string" args i32 $ \[program, len, stringData] -> do
stringDataCopy <- call (extMalloc exts) [len]
lenBytes <- zext len i64
_ <- call (extMemcpy exts) [stringDataCopy, stringData, lenBytes, bit 0]
symbolPtr <- alloca (Symbol.tySymbol symbol) (Just (int32 1)) 0
_ <- call (Symbol.symbolInit symbol) [symbolPtr, len, stringDataCopy]
symbolTablePtr <- getSymbolTablePtr program
index <- call (SymbolTable.symbolTableLookupIndex symbolTable) [symbolTablePtr, symbolPtr]
alreadyContainsSymbol <- index `ne` int32 0xFFFFFFFF
if' alreadyContainsSymbol $ do
-- Since the string was not added to the table, the memory pointed to by
-- the symbol is not managed by the symbol table, so we need to manually free the data.
_ <- call (extFree exts) [stringDataCopy]
ret index
-- No free needed here, automatically called when symbol table is cleaned up.
ret =<< call (SymbolTable.symbolTableFindOrInsert symbolTable) [symbolTablePtr, symbolPtr]
-- NOTE: do not free the returned string/byte array,
-- this happens automatically when eclair_destroy is called
generateDecodeStringFn :: MonadFix m => CodegenInOutT (ModuleBuilderT m) Operand
generateDecodeStringFn = do
lowerState <- asks inOutLowerState
let args = [ (ptr (programType lowerState), "eclair_program")
, (i32, "string_index")
]
symbolTable = symbolTableFns lowerState
apiFunction "eclair_decode_string" args (ptr i8) $ \[program, idx] -> do
symbolTablePtr <- getSymbolTablePtr program
containsIndex <- call (SymbolTable.symbolTableContainsIndex symbolTable) [symbolTablePtr, idx]
if' containsIndex $ do
symbolPtr <- call (SymbolTable.symbolTableLookupSymbol symbolTable) [symbolTablePtr, idx]
ret $ ptrcast i8 symbolPtr
ret $ nullPtr i8
toCodegenInOut :: Monad m => LowerState -> CodegenT m Operand -> IRBuilderT (CodegenInOutT (ModuleBuilderT m)) Operand
toCodegenInOut lowerState m =
hoist lift $ runCodegenM m lowerState
mkInOutState :: Map Relation Word32 -> [(Relation, Metadata)] -> LowerState -> InOutState
mkInOutState relMapping metas ls =
InOutState relMapping relNumCols rels indicesByRel offsetsByRelAndIndex ls
where
rs = map fst metas
-- NOTE: disregards all "special" relations, since they should not be visible to the end user!
rels = S.fromList $ filter (not . startsWithIdPrefix) rs
relNumCols =
M.fromList [ (r, numCols)
| r <- rs
, let numCols = getNumColumns (snd $ fromJust $ L.find ((== r) . fst) metas)
]
relInfos = M.keys $ fnsMap ls
indicesByRel =
M.fromAscListWith (<>) $ map (second one) $ sortWith fst relInfos
offsetsByRelAndIndex =
M.fromDistinctAscList
[ (ri, offset)
| ri <- sortNub relInfos
-- + 1 due to symbol table at position 0 in program struct
, let offset = 1 + fromJust (L.elemIndex ri relInfos)
]
indicesForRelation :: MonadReader InOutState m => Relation -> m [Index]
indicesForRelation r = do
inOutState <- ask
pure . fromJust . M.lookup r $ indicesByRelation inOutState
offsetForRelationAndIndex :: MonadReader InOutState m => Relation -> Index -> m Int
offsetForRelationAndIndex r idx = do
inOutState <- ask
pure . fromJust . M.lookup (r, idx) $ offsetsByRelationAndIndex inOutState
numColsForRelation :: MonadReader InOutState m => Relation -> m Int
numColsForRelation r =
fromJust . M.lookup r . relationNumColumns <$> ask
switchOnFactType :: MonadFix m
=> Set Relation
-> Map Relation Word32
-> IRBuilderT m ()
-> Operand
-> (Relation -> IRBuilderT m ())
-> IRBuilderT m ()
switchOnFactType rels stringMap defaultCase factType generateCase = mdo
switch factType end caseBlocks
caseBlocks <- for (M.toList relMapping) $ \(r, factNum) -> do
caseBlock <- blockNamed (unId r)
generateCase r
pure (int32 $ toInteger factNum, caseBlock)
end <- blockNamed "switch.default"
defaultCase
where
relMapping =
M.restrictKeys stringMap rels
-- A helper function for easily finding the "longest" index.
-- This is important for when you need to retrieve facts, since this index will
-- contain the most facts.
findLongestIndex :: [Index] -> Maybe Index
findLongestIndex =
-- TODO use NonEmpty
viaNonEmpty head . sortOn (Dual . length . unIndex)
isOutputRelation :: Map Relation UsageMode -> Relation -> Bool
isOutputRelation usageMapping r =
case M.lookup r usageMapping of
Just Output -> True
Just InputOutput -> True
_ -> False
isInputRelation :: Map Relation UsageMode -> Relation -> Bool
isInputRelation usageMapping r =
case M.lookup r usageMapping of
Just Input -> True
Just InputOutput -> True
_ -> False
getSymbolTablePtr :: (MonadModuleBuilder m, MonadIRBuilder m)
=> Operand -> m Operand
getSymbolTablePtr program =
gep program [int32 0, int32 0]
apiFunction :: (MonadModuleBuilder m, HasSuffix m)
=> Name
-> [(LLVM.Type, ParameterName)]
-> LLVM.Type
-> ([Operand] -> IRBuilderT m a)
-> m Operand
apiFunction fnName args retTy body =
withFunctionAttributes (WasmExportName (unName fnName):) $
function fnName args retTy body
================================================
FILE: lib/Eclair/EIR/Lower/Codegen.hs
================================================
module Eclair.EIR.Lower.Codegen
( CodegenT
, runCodegenM
, LowerState(..)
, Table(..)
, Externals(..)
, labelToName
, lookupFunction
, lookupPrimOp
, toLLVMType
, lookupVar
, addVarBinding
, newGlobalVarName
, loadIfNeeded
) where
import Prelude hiding (void)
import Control.Monad.Morph
import Data.Maybe (fromJust)
import qualified Data.Map as M
import Eclair.LLVM.Codegen
import Eclair.LLVM.Table
import Eclair.LLVM.Externals
import qualified Eclair.LLVM.Symbol as Symbol
import qualified Eclair.LLVM.SymbolTable as SymbolTable
import qualified Eclair.EIR.IR as EIR
import Eclair.RA.IndexSelection
import Eclair.Common.Id
type Relation = EIR.Relation
type EIR = EIR.EIR
type VarMap = Map Text Operand
type TableMap = Map (Relation, Index) Table
data LowerState
= LowerState
{ programType :: Type
, programSizeBytes :: Word64
, symbolTableFns :: SymbolTable.SymbolTable
, symbolFns :: Symbol.Symbol
, fnsMap :: TableMap
, varMap :: VarMap
, globalVarCounter :: Int
, externals :: Externals
, externFns :: Map Id Operand
}
type CodegenT m = StateT LowerState (IRBuilderT (ModuleBuilderT m))
runCodegenM :: Monad m => CodegenT m a -> LowerState -> IRBuilderT (ModuleBuilderT m) a
runCodegenM = evalStateT
labelToName :: EIR.LabelId -> Name
labelToName (EIR.LabelId lbl) =
Name lbl
-- This is a function mostly used by `lookupPrimOp`, but also for calling functions during fact IO
lookupFunction :: Monad m => Relation -> Index -> EIR.Function -> CodegenT m Operand
lookupFunction r idx fn = do
tableMap <- gets fnsMap
let table = unsafeLookup r idx tableMap
extractFn tableMap table
where
extractFn tableMap table = case fn of
EIR.InitializeEmpty -> pure $ fnInitEmpty table
EIR.Destroy -> pure $ fnDestroy table
EIR.Purge -> pure $ fnPurge table
EIR.Swap -> pure $ fnSwap table
EIR.InsertRange r2 idx2 -> do
let templatedFn = fnInsertRangeTemplate table
suffix = unId r <> "_" <> unId r2
table2 = unsafeLookup r2 idx2 tableMap
iterParams = IteratorParams
{ ipIterCurrent = fnIterCurrent table2
, ipIterNext = fnIterNext table2
, ipIterIsEqual = fnIterIsEqual table2
, ipTypeIter = typeIter table2
}
-- I think we don't need to cache instantiations here (to avoid duplicate functions)
lift . lift $ hoist generalize $ instantiate suffix iterParams templatedFn
EIR.IsEmpty -> pure $ fnIsEmpty table
EIR.Size -> pure $ fnSize table
EIR.Contains -> pure $ fnContains table
EIR.Insert -> pure $ fnInsert table
EIR.IterCurrent -> pure $ fnIterCurrent table
EIR.IterNext -> pure $ fnIterNext table
EIR.IterIsEqual -> pure $ fnIterIsEqual table
EIR.IterLowerBound -> pure $ fnLowerBound table
EIR.IterUpperBound -> pure $ fnUpperBound table
EIR.IterBegin -> pure $ fnBegin table
EIR.IterEnd -> pure $ fnEnd table
unsafeLookup r' idx' = fromJust . M.lookup (r', idx')
type PrimOp m = Either Operand (Operand -> Operand -> CodegenT m Operand)
lookupPrimOp :: Monad m => EIR.Op -> CodegenT m (PrimOp m)
lookupPrimOp = \case
EIR.SymbolTableInit ->
toSymbolTableOp SymbolTable.symbolTableInit
EIR.SymbolTableDestroy ->
toSymbolTableOp SymbolTable.symbolTableDestroy
EIR.SymbolTableInsert ->
toSymbolTableOp SymbolTable.symbolTableFindOrInsert
EIR.RelationOp r idx fn ->
Left <$> lookupFunction r idx fn
EIR.ComparisonOp op ->
pure $ Right $ case op of
EIR.Equals -> eq
EIR.NotEquals -> ne
-- NOTE: this will result in issues for signed integers in the future, but ignoring that for now..
-- We can pass along the type then?
EIR.LessThan -> ult
EIR.LessOrEqual -> ule
EIR.GreaterThan -> ugt
EIR.GreaterOrEqual -> uge
EIR.ArithOp op ->
-- NOTE: this will result in issues for signed integers in the future, but ignoring that for now..
-- We can pass along the type then?
pure $ Right $ case op of
EIR.Plus -> add
EIR.Minus -> sub
EIR.Multiply -> mul
EIR.Divide -> udiv
EIR.ExternOp opName -> do
Left <$> gets (fromJust . M.lookup opName . externFns)
where
toSymbolTableOp llvmOp = Left <$> do
symbolTable <- gets symbolTableFns
pure $ llvmOp symbolTable
toLLVMType :: MonadState LowerState m => Relation -> Index -> EIR.Type -> m Type
toLLVMType r idx = go
where
go = \case
EIR.Program ->
programType <$> get
EIR.Iter ->
typeIter . fromJust . M.lookup (r, idx) <$> gets fnsMap
EIR.Value ->
typeValue . fromJust . M.lookup (r, idx) <$> gets fnsMap
EIR.Void ->
pure void
EIR.Pointer ty ->
ptr <$> go ty
-- Only called internally, should always be called on a var that exists.
lookupVar :: MonadState LowerState m => Text -> m Operand
lookupVar v = gets (fromJust . M.lookup v . varMap)
addVarBinding :: MonadState LowerState m => Text -> Operand -> m ()
addVarBinding var value =
modify $ \s -> s { varMap = M.insert var value (varMap s) }
newGlobalVarName :: MonadState LowerState m => Text -> m Name
newGlobalVarName name = do
count <- gets globalVarCounter
modify $ \s -> s { globalVarCounter = count + 1 }
pure $ Name $ name <> "_" <> show count
-- NOTE: this is for the case when we are assigning 1 field of a struct/array
-- to another of the same kind, where the right side needs to be loaded before
-- storing it to the left side of the equation.
loadIfNeeded :: MonadIRBuilder m => m Operand -> EIR -> m Operand
loadIfNeeded operand = \case
EIR.FieldAccess _ _ -> flip load 0 =<< operand
_ -> operand
================================================
FILE: lib/Eclair/EIR/Lower/Externals.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.EIR.Lower.Externals
( createExternals
) where
import Prelude hiding (void)
import Eclair.EIR.Lower.Codegen
import Eclair.LLVM.Codegen as LLVM
import Eclair.Common.Config
createExternals :: ConfigT (ModuleBuilderT IO) Externals
createExternals = do
target <- cfgTargetTriple <$> getConfig
mallocFn <- lift $ generateMallocFn target
freeFn <- lift $ generateFreeFn target
memsetFn <- extern "llvm.memset.p0i8.i64" [ptr i8, i8, i64, i1] void
memcpyFn <- extern "llvm.memcpy.p0i8.p0i8.i64" [ptr i8, ptr i8, i64, i1] void
memcmpFn <- if target == Just Wasm32
then lift generateMemCmpFn
else extern "memcmp" [ptr i8, ptr i8, i64] i32
-- TODO write alternatives for WASM
mmapFn <- extern "mmap" [ptr void, i64, i32, i32, i32, i32] (ptr void)
munmapFn <- extern "munmap" [ptr void, i64] i32
pure $ Externals mallocFn freeFn memsetFn memcpyFn memcmpFn mmapFn munmapFn
generateMallocFn :: Monad m => Maybe Target -> ModuleBuilderT m Operand
generateMallocFn target = do
mallocFn <- extern "malloc" [i32] (ptr i8)
when (target == Just Wasm32) $ do
_ <- withFunctionAttributes (const [WasmExportName "eclair_malloc"]) $
function "eclair_malloc" [(i32, "byte_count")] (ptr i8) $ \[byteCount] ->
ret =<< call mallocFn [byteCount]
pass
pure mallocFn
generateFreeFn :: Monad m => Maybe Target -> ModuleBuilderT m Operand
generateFreeFn target = do
freeFn <- extern "free" [ptr i8] void
when (target == Just Wasm32) $ do
_ <- withFunctionAttributes (const [WasmExportName "eclair_free"]) $
function "eclair_free" [(ptr i8, "memory")] void $ \[memoryPtr] ->
call freeFn [memoryPtr]
pass
pure freeFn
-- NOTE: we only care about 0 if they are equal!
generateMemCmpFn :: MonadFix m => ModuleBuilderT m Operand
generateMemCmpFn = do
let args = [(ptr i8, "array1"), (ptr i8, "array2"), (i64, "byte_count")]
function "memcmp_wasm32" args i32 $ \[array1, array2, byteCount] -> do
i64Count <- byteCount `udiv` int64 8
restCount <- byteCount `and` int64 7 -- modulo 8
let i64Array1 = ptrcast i64 array1
let i64Array2 = ptrcast i64 array2
loopFor (int64 0) (`ult` i64Count) (add (int64 1)) $ \i -> do
valuePtr1 <- gep i64Array1 [i]
valuePtr2 <- gep i64Array2 [i]
value1 <- load valuePtr1 0
value2 <- load valuePtr2 0
isNotEqual <- value1 `ne` value2
if' isNotEqual $
ret $ int32 1
startIdx <- mul i64Count (int64 8)
loopFor (int64 0) (`ult` restCount) (add (int64 1)) $ \i -> do
idx <- add i startIdx
valuePtr1 <- gep array1 [idx]
valuePtr2 <- gep array2 [idx]
value1 <- load valuePtr1 0
value2 <- load valuePtr2 0
isNotEqual <- value1 `ne` value2
if' isNotEqual $
ret $ int32 1
ret $ int32 0
================================================
FILE: lib/Eclair/EIR/Lower.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.EIR.Lower
( compileToLLVM
) where
import Prelude hiding (void)
import qualified Prelude
import qualified Relude (swap)
import Control.Monad.Morph hiding (embed)
import qualified Data.ByteString as BS
import qualified Data.Map as M
import Data.List ((!!))
import Foreign.ForeignPtr
import qualified Eclair.EIR.IR as EIR
import qualified Eclair.LLVM.BTree as BTree
import qualified Eclair.LLVM.Symbol as Symbol
import qualified Eclair.LLVM.Vector as Vector
import qualified Eclair.LLVM.HashMap as HashMap
import qualified Eclair.LLVM.SymbolTable as SymbolTable
import Eclair.EIR.Lower.Codegen
import Eclair.EIR.Lower.Externals
import Eclair.EIR.Lower.API
import Eclair.LLVM.Codegen as LLVM
import qualified LLVM.C.API as LibLLVM
import Eclair.LLVM.Metadata
import Eclair.LLVM.Hash
import Eclair.RA.IndexSelection
import Eclair.Common.Config
import Eclair.Comonads
import Eclair.AST.IR
import Eclair.AST.Transforms.ReplaceStrings (StringMap)
import Eclair.Common.Id
import Eclair.Common.Extern
type EIR = EIR.EIR
type EIRF = EIR.EIRF
type Relation = EIR.Relation
compileToLLVM :: Maybe Target -> StringMap -> Map Relation UsageMode -> [Extern] -> EIR -> IO Module
compileToLLVM target stringMapping usageMapping externDefs eir = do
ctx <- LibLLVM.mkContext
llvmMod <- LibLLVM.mkModule ctx "eclair"
if target == Just Wasm32
then do
-- layout string found in Rust compiler (wasm32_unknown_unknown.rs)
let wasmDataLayout = "e-m:e-p:32:32-p10:8:8-p20:8:8-i64:64-n32:64-S128-ni:1:10:20"
td <- LibLLVM.mkTargetData wasmDataLayout
LibLLVM.setTargetData llvmMod td
withForeignPtr td $ \tdPtr -> do
compile (Config target ctx tdPtr) eir
else do
-- use host layout
td <- LibLLVM.getTargetData llvmMod
compile (Config target ctx td) eir
where
compile cfg = \case
EIR.Module (EIR.DeclareProgram metas : decls) -> runModuleBuilderT $ runConfigT cfg $ do
let ctx = cfgLLVMContext cfg
td = cfgTargetData cfg
exts <- createExternals
(metaMapping, fnss) <- runCacheT $ traverse (codegenRuntime exts . snd) metas
codegenDebugInfos metaMapping
(symbolTable, symbol) <- codegenSymbolTable exts
let symbolTableTy = SymbolTable.tySymbolTable symbolTable
fnsInfo = zip (map (map getIndexFromMeta) metas) fnss
fnsMap' = M.fromList fnsInfo
-- TODO: add hash based on filepath of the file we're compiling?
programTy <- typedef "program" Off (symbolTableTy : map typeObj fnss)
programSize <- withLLVMTypeInfo ctx $ llvmSizeOf ctx td programTy
lift $ do
externs <- traverse (processExtern symbolTableTy) externDefs
let externMap = M.fromList externs
lowerState = LowerState programTy programSize symbolTable symbol fnsMap' mempty 0 exts externMap
traverse_ (processDecl lowerState) decls
codegenAPI relMapping usageMapping metas lowerState
_ ->
panic "Unexpected top level EIR declarations when compiling to LLVM!"
relMapping =
M.mapKeys Id stringMapping
processExtern symbolTableTy (Extern fnName argCount extKind) = do
let argTys = ptr symbolTableTy : replicate argCount i32
retTy = if extKind == ExternConstraint then i1 else i32 -- i1, or i8 for bool?
fn <- extern (Name $ unId fnName) argTys retTy
pure (fnName, fn)
processDecl lowerState = \case
EIR.Function visibility name tys retTy body -> do
let unusedRelation = panic "Unexpected use of relation for function type when lowering EIR to LLVM."
unusedIndex = panic "Unexpected use of index for function type when lowering EIR to LLVM."
getType ty = evalStateT (toLLVMType unusedRelation unusedIndex ty) lowerState
argTypes <- liftIO $ traverse getType tys
returnType <- liftIO $ getType retTy
let args = map (, ParameterName "arg") argTypes
fn = if visibility == EIR.Public then apiFunction else function
-- Only public functions are exposed, rest is only used internally
fn (Name name) args returnType $ \args' -> do
runCodegenM (fnBodyToLLVM args' body) lowerState
_ ->
panic "Unexpected top level EIR declaration when compiling to LLVM!"
fnBodyToLLVM :: MonadFix m => [Operand] -> EIR -> CodegenT m ()
fnBodyToLLVM args = lowerM instrToOperand instrToUnit
where
instrToOperand :: Monad m => EIRF (EIR, CodegenT m Operand) -> CodegenT m Operand
instrToOperand = \case
EIR.FunctionArgF pos ->
pure $ args !! pos
EIR.FieldAccessF (snd -> structOrVar) pos -> do
-- NOTE: structOrVar is always a pointer to a heap-/stack-allocated
-- value so we need to first deref the pointer, and then index into the
-- fields of the value ('addr' does this for us). On top of that, we
-- can only compute the address here and not do a load as well, since
-- sometimes this pointer is used in a "store" instruction.
addr (mkPath [int32 $ toInteger pos]) =<< structOrVar
EIR.VarF v ->
lookupVar v
EIR.NotF (snd -> bool') ->
not' =<< bool'
EIR.AndF (snd -> bool1) (snd -> bool2) -> do
b1 <- bool1
b2 <- bool2
and b1 b2
EIR.PrimOpF op args' ->
invokePrimOp op args'
EIR.HeapAllocateProgramF -> do
(malloc, (programTy, programSize)) <- gets (extMalloc . externals &&& programType &&& programSizeBytes)
let memorySize = int32 $ fromIntegral programSize
pointer <- call malloc [memorySize]
pure $ ptrcast programTy pointer
EIR.StackAllocateF r idx ty -> do
theType <- toLLVMType r idx ty
alloca theType (Just (int32 1)) 0
EIR.LitF (LNumber value) ->
pure $ int32 (fromIntegral value)
EIR.LitF (LString value) -> do
-- We create a global variable to statically store the string,
-- but we malloc and copy the string over since the symbol table
-- frees all symbols at the end.
varName <- newGlobalVarName "string_literal"
globalStringPtr <- globalUtf8StringPtr value varName
let utf8Length = int32 $ toInteger $ BS.length $ encodeUtf8 value
numBytes <- utf8Length `zext` i64
exts <- gets externals
stringPtr <- call (extMalloc exts) [utf8Length]
_ <- call (extMemcpy exts) [stringPtr, globalStringPtr, numBytes, bit 0]
symFns <- gets symbolFns
let tySymbol = Symbol.tySymbol symFns
symbolPtr <- alloca tySymbol (Just (int32 1)) 0
_ <- call (Symbol.symbolInit symFns) [symbolPtr, utf8Length, stringPtr]
pure symbolPtr
_ ->
panic "Unhandled pattern match case in 'instrToOperand' while lowering EIR to LLVM!"
instrToUnit :: MonadFix m => (EIRF (Triple EIR (CodegenT m Operand) (CodegenT m ())) -> CodegenT m ())
instrToUnit = \case
EIR.BlockF stmts -> do
traverse_ toInstrs stmts
EIR.ParF stmts ->
-- NOTE: this is just sequential evaluation for now
traverse_ toInstrs stmts
EIR.AssignF (toOperandWithContext -> (operand, eirLHS))
(toOperandWithContext -> (val, eirRHS)) -> do
case eirLHS of
EIR.Var varName -> do
-- Assigning to a variable: evaluate the value, and add to the varMap.
-- This allows for future lookups of a variable.
value <- val
addVarBinding varName value
_ -> do
-- NOTE: here we assume we are assigning to an operand (of a struct field)
-- "operand" will contain a pointer, "val" will contain the actual value
-- We need to store the result to the address the pointer is pointing to.
address <- operand
value <- loadIfNeeded val eirRHS
store address 0 value
EIR.FreeProgramF (toOperand -> programVar) -> do
freeFn <- gets (extFree . externals)
program <- programVar
let memory = ptrcast i8 program
Prelude.void $ call freeFn [memory]
EIR.PrimOpF op (map (Relude.swap . toOperandWithContext) -> args') ->
Prelude.void $ invokePrimOp op args'
EIR.LoopF stmts ->
loop $ traverse_ toInstrs stmts
EIR.IfF (toOperand -> cond) (toInstrs -> body) -> do
condition <- cond
if' condition body
EIR.JumpF lbl ->
br (labelToName lbl)
EIR.LabelF lbl ->
-- NOTE: the label should be globally unique thanks to the RA -> EIR lowering pass
emitBlockStart $ labelToName lbl
EIR.ReturnF (toOperand -> value) ->
ret =<< value
_ ->
panic "Unhandled pattern match case in 'instrToUnit' while lowering EIR to LLVM!"
toOperand (Triple _ operand _) = operand
toOperandWithContext (Triple eir operand _) =
(operand, eir)
toInstrs (Triple _ _ instrs) = instrs
invokePrimOp :: Monad m => EIR.Op -> [(EIR, CodegenT m Operand)] -> CodegenT m Operand
invokePrimOp op args' = do
lookupPrimOp op >>= \case
Left fn ->
call fn =<< traverse snd args'
Right compareInstr -> case args' of
[(a, lhs), (b, rhs)] -> do
valueA <- loadIfNeeded lhs a
valueB <- loadIfNeeded rhs b
compareInstr valueA valueB
_ ->
panic "Unexpected amount of arguments in 'invokePrimOp'!"
-- lowerM is a recursion-scheme that behaves like a zygomorphism, but it is
-- enhanced in the sense that both functions passed to the zygomorphism have
-- access to the original subtree.
--
-- NOTE: zygo effect is kind of abused here, since due to lazyness we can choose what
-- we need to compile to LLVM: instructions either return "()" or an "Operand".
-- para effect is needed since we need access to the original subtree in the
-- assignment case to check if we are assigning to a variable or not, allowing
-- us to easily transform an "expression-oriented" EIR to statement based LLVM IR.
lowerM :: (EIRF (EIR, CodegenT m Operand) -> CodegenT m Operand)
-> (EIRF (Triple EIR (CodegenT m Operand) (CodegenT m ())) -> CodegenT m ())
-> EIR
-> CodegenT m ()
lowerM f = gcata (distribute f)
where
distribute
:: Corecursive t
=> (Base t (t, b) -> b)
-> (Base t (Triple t b a) -> Triple t b (Base t a))
distribute g m =
let base_t_t = map tFst m
base_t_tb = map (tFst &&& tSnd) m
base_t_a = map tThd m
in Triple (embed base_t_t) (g base_t_tb) base_t_a
-- We need an Int somewhere later on during codegen.
-- So we don't convert to a 'Suffix' at this point yet.
type IntSuffix = Int
type CacheT = StateT (Map Metadata (IntSuffix, Table))
runCacheT :: Monad m => CacheT m a -> m (Map Metadata IntSuffix, a)
runCacheT m = do
(a, s) <- runStateT m mempty
pure (map fst s, a)
codegenRuntime :: Externals -> Metadata -> CacheT (ConfigT (ModuleBuilderT IO)) Table
codegenRuntime exts meta = gets (M.lookup meta) >>= \case
Nothing -> do
suffix <- gets length
fns <- cgRuntime suffix
modify $ M.insert meta (suffix, fns)
pure fns
Just (_, cachedFns) -> pure cachedFns
where
cgRuntime suffix = lift $ case meta of
BTree meta' -> hoist (instantiate (show suffix) meta') $ BTree.codegen exts
codegenDebugInfos :: MonadModuleBuilder m => Map Metadata Int -> m ()
codegenDebugInfos metaMapping =
traverse_ (uncurry codegenDebugInfo) $ M.toList metaMapping
where
codegenDebugInfo meta i =
let hash = getHash meta
name = Name $ ("specialize_debug_info." <>) $ unHash hash
in global name i32 (Int 32 $ toInteger i)
codegenSymbolTable :: Externals -> ConfigT (ModuleBuilderT IO) (SymbolTable.SymbolTable, Symbol.Symbol)
codegenSymbolTable exts = do
symbol <- lift $ hoist intoIO $ Symbol.codegen exts
let tySymbol = Symbol.tySymbol symbol
symbolDestructor iterPtr = do
_ <- call (Symbol.symbolDestroy symbol) [iterPtr]
pass
-- Only this vector does the cleanup of all the symbols, to prevent double frees
vec <- hoist (instantiate "symbol" tySymbol) $ Vector.codegen exts (Just symbolDestructor)
hashMap <- HashMap.codegen symbol exts
symbolTable <- lift $ hoist intoIO $ SymbolTable.codegen tySymbol vec hashMap
pure (symbolTable, symbol)
where
intoIO = pure . runIdentity
getIndexFromMeta :: Metadata -> Index
getIndexFromMeta = \case
BTree meta -> Index $ BTree.index meta
================================================
FILE: lib/Eclair/Error.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Eclair.Error
( EclairError(..)
, Issue(..)
, Location(..)
, Pos(..)
, posToSourcePos
, locationToSourceSpan
, handleErrorsCLI
, errorToIssues
, renderIssueMessage
) where
import qualified Data.Map as M
import qualified Text.Megaparsec as P
import Data.List (partition)
import Eclair.AST.Analysis
import Eclair.TypeSystem
import Eclair.Parser
import Eclair.Common.Id
import Eclair.Common.Location
import Eclair.Souffle.IR
import Prettyprinter
import Prettyprinter.Render.Terminal
import Error.Diagnose hiding (stderr)
data EclairError
= ParseErr FilePath ParsingError
| TypeErr FilePath SpanMap [TypeError NodeId]
| SemanticErr FilePath SpanMap (SemanticErrors NodeId)
| ConversionErr FilePath SpanMap (ConversionError NodeId)
-- TODO refactor using an error reporting monad?
-- Handle errors when running in the CLI.
handleErrorsCLI :: EclairError -> IO ()
handleErrorsCLI e = do
useColorEnvVar <- fromMaybe "1" <$> lookupEnv "ECLAIR_USE_COLOR"
let useColors = if useColorEnvVar /= "0"
then Just UseColor
else Nothing
hPutDoc stderr =<< errToDoc useColors e
where
errToDoc useColor = \case
ParseErr file' err' -> do
case err' of
FileNotFound {} ->
pure $ "File not found: " <> pretty file' <> ".\n"
ParsingError parseError -> do
content <- decodeUtf8 <$> readFileBS file'
let reports = map fst $ errReportsWithLocationsFromBundle "Failed to parse file" parseError
diagnostic = foldl' addReport def reports
diagnostic' = addFile diagnostic file' content
in pure $ prettyError useColor diagnostic'
TypeErr file' spanMap errs -> do
content <- decodeUtf8 <$> readFileBS file'
let errsWithPositions = getSourcePosCLI file' content spanMap <<$>> errs
reports = map typeErrorToReport errsWithPositions
diagnostic = foldl' addReport def reports
diagnostic' = addFile diagnostic file' (toString content)
in pure $ prettyError useColor diagnostic'
SemanticErr file' spanMap semanticErr -> do
content <- decodeUtf8 <$> readFileBS file'
let semanticErrsWithPositions = map (getSourcePosCLI file' content spanMap) semanticErr
reports = map fst $ semanticErrorsToReportsWithLocations semanticErrsWithPositions
diagnostic = foldl' addReport def reports
diagnostic' = addFile diagnostic file' (toString content)
in pure $ prettyError useColor diagnostic'
ConversionErr file' spanMap conversionErr -> do
content <- decodeUtf8 <$> readFileBS file'
let errWithPosition = map (getSourcePosCLI file' content spanMap) conversionErr
report = conversionErrorToReport errWithPosition
diagnostic = addReport def report
diagnostic' = addFile diagnostic file' (toString content)
pure $ prettyError useColor diagnostic'
-- A single position in the code. 0-based!
data Pos
= Pos
{ posLine :: {-# UNPACK #-} !Word32
, posColumn :: {-# UNPACK #-} !Word32
}
posToSourcePos :: Pos -> SourcePos
posToSourcePos (Pos l c) =
SourcePos (fromIntegral l) (fromIntegral c)
-- Actual location in the code (a range).
-- Contains the file, start and end of the position.
data Location
= Location
{ locationFile :: FilePath
, locationStart :: {-# UNPACK #-} !Pos
, locationEnd :: {-# UNPACK #-} !Pos
}
locationToSourceSpan :: Location -> SourceSpan
locationToSourceSpan loc =
SourceSpan (locationFile loc) posBegin posEnd
where
posBegin = posToSourcePos $ locationStart loc
posEnd = posToSourcePos $ locationEnd loc
-- A helper type for referring to an issue at a location.
data Issue
= Issue
{ issueMessage :: Report Text
, issueLocation :: Location
}
renderIssueMessage :: Issue -> Text
renderIssueMessage issue =
-- TODO generate a diagnostic per line of the report (like in Rust).
let report = issueMessage issue
in getReportTitle report
getReportTitle :: Report Text -> Text
getReportTitle = \case
Err _ summary _ _ -> summary
Warn _ summary _ _ -> summary
-- A helper function that can be used from the LSP. Splits all errors into
-- separate issues for most flexibility and fine-grained reporting.
errorToIssues :: (FilePath -> IO Text) -> EclairError -> IO [Issue]
errorToIssues readTextFile = \case
ParseErr file' err' -> do
case err' of
FileNotFound {} -> do
let errMessage = "File not found: " <> toText file'
report = Err Nothing errMessage [] []
noLocationInfo = Location file' (Pos 0 0) (Pos 0 0)
pure $ one $ Issue report noLocationInfo
ParsingError parseError -> do
let reportsWithLocs = errReportsWithLocationsFromBundle "Failed to parse file" parseError
pure $ map (uncurry Issue) reportsWithLocs
TypeErr file' spanMap errs -> do
content <- readTextFile file'
let errsWithPositions = getSourcePos file' content spanMap <<$>> errs
toLocation = positionToLocation . mainErrorPosition
pure $ map (uncurry Issue . (typeErrorToReport &&& toLocation)) errsWithPositions
SemanticErr file' spanMap semanticErrs -> do
content <- readTextFile file'
let semanticErrsWithPositions = map (getSourcePos file' content spanMap) semanticErrs
reportsWithLocs = semanticErrorsToReportsWithLocations semanticErrsWithPositions
pure $ map (uncurry Issue) reportsWithLocs
ConversionErr file' spanMap conversionErr -> do
content <- readTextFile file'
let errWithPosition = map (getSourcePos file' content spanMap) conversionErr
report = conversionErrorToReport errWithPosition
loc = positionToLocation $ mainErrorPosition errWithPosition
pure $ one $ Issue report loc
typeErrorToReport :: TypeError Position -> Report Text
typeErrorToReport e = case e of
UnknownConstraint _ factName ->
let title = "Missing type definition"
markers = [(mainErrorPosition e, This $ "Could not find a type definition for '" <> unId factName <> "'.")]
hints =
[ Hint $ "Add a type definition for '" <> unId factName <> "'."
, Hint $ "Add an extern definition for '" <> unId factName <> "'."
]
in Err Nothing title markers hints
UnknownFunction _ factName ->
let title = "Missing type definition"
markers = [(mainErrorPosition e, This $ "Could not find a type definition for '" <> unId factName <> "'.")]
hints =
[ Hint $ "Add an extern definition for '" <> unId factName <> "'." ]
in Err Nothing title markers hints
ArgCountMismatch factName (expectedSrcLoc, expectedCount) (actualSrcLoc, actualCount) ->
let title = "Found an unexpected amount of arguments for '" <> unId factName <> "'"
markers = [ (actualSrcLoc, This $ show actualCount <> pluralize actualCount " argument is" " arguments are" <> " provided here.")
, (expectedSrcLoc, Where $ "'" <> unId factName <> "' is defined with " <> show expectedCount <> " " <>
pluralize expectedCount "argument" "arguments" <> ".")
]
hints = [Hint $ "You can solve this by passing exactly " <> show expectedCount <> " "
<> pluralize expectedCount "argument" "arguments" <> " to '" <> unId factName <> "'."]
in Err Nothing title markers hints
TypeMismatch _ actualTy expectedTy ctx ->
Err Nothing title markers hints
where
title = "Type mismatch"
lastMarker = (mainErrorPosition e, This $ show (length ctx + 1) <> ") Expected this to be of type " <> renderType expectedTy <> ","
<> " but it actually has type " <> renderType actualTy <> ".")
markers = zipWith renderDeduction markerTypes (toList ctx) ++ [lastMarker]
markerTypes = map (, Where) [1..]
hints = [] -- Can we even give a meaningful error here? Look in type env? (if a var is used)
UnificationFailure _ _ ctx ->
Err Nothing title markers hints
where
title = "Type unification failure"
markerTypes = markersForTypeError ctx
markers = zipWith renderDeduction markerTypes (toList ctx)
hints = [] -- What can we even give as a hint here? That it is a logical error?
HoleFound _ ctx holeTy typeEnv ->
Err Nothing title markers hints
where
title = "Found hole"
markerTypes = map (, Where) [1..]
deductions = zipWith renderDeduction markerTypes (toList ctx)
markers = deductions <>
[(mainErrorPosition e, This $ show (length deductions + 1) <> ") Found hole with type " <> renderType holeTy <> ".")]
typeEntries =
typeEnv
& M.mapWithKey (\var ty -> (ty, renderBinding var ty))
& toList
(candidates, others) = partition (\(entryTy, _) -> entryTy == holeTy) typeEntries
hints =
map (Hint . (("Possible candidate: " <>) . snd)) candidates <>
if null others
then []
else [Hint "Other variables include:"] <> map (Hint . snd) others
renderBinding var ty =
unId var <> " :: " <> renderType ty
UnexpectedFunctionType _ defPos ->
let title = "Invalid use of function"
markers =
[ (mainErrorPosition e, This "Expected a constraint here.")
, (defPos, Where "Previously defined as a function here.")
]
hints =
[ Hint "Maybe you meant to declare this an external constraint instead?"
, Hint "Remove the invalid function."
]
in Err Nothing title markers hints
UnexpectedConstraintType _ defPos ->
let title = "Invalid use of constraint"
markers =
[ (mainErrorPosition e, This "Expected a function.")
, (defPos, Where "Previously defined as a constraint here.")
]
hints =
[ Hint "Maybe you meant to declare this as a function instead?"
, Hint "Remove the invalid constraint."
]
in Err Nothing title markers hints
where
markersForTypeError ctx =
zip [1..] $ replicate (length ctx - 1) Where ++ [This]
renderDeduction :: (Int, Text -> Marker a) -> Context Position -> (Position, Marker a)
renderDeduction (i, mkMarker) = \case
WhileChecking srcLoc ->
(srcLoc, mkMarker $ show i <> ") While checking the type of this..")
WhileInferring srcLoc ->
(srcLoc, mkMarker $ show i <> ") While inferring the type of this..")
WhileUnifying srcLoc ->
(srcLoc, mkMarker $ show i <> ") While unifying these types..")
conversionErrorToReport :: ConversionError Position -> Report Text
conversionErrorToReport e = case e of
HoleNotSupported _ ->
let title = "Unsupported feature in Souffle"
markers = [(mainErrorPosition e, This "Souffle has no support for holes.")]
hints = [Hint "Replace the hole with a variable or literal."]
in Err Nothing title markers hints
UnsupportedCase _ ->
let title = "Unsupported feature in Souffle"
markers = [(mainErrorPosition e, This "Eclair can't transpile extern definitions yet.")]
hints = [Hint "Please open a github issue asking for this feature."]
in Err Nothing title markers hints
UnsupportedType _ ty ->
let title = "Unsupported type in Souffle"
markers = [(mainErrorPosition e, This $ "Souffle has no support for the " <> renderType ty <> " type.")]
hints = []
in Err Nothing title markers hints
ungroundedVarToReport :: UngroundedVar Position -> Report Text
ungroundedVarToReport e@(UngroundedVar srcLocRule _ var) =
let title = "Ungrounded variable"
srcLocVar = mainErrorPosition e
markers = [ (srcLocVar, This $ "The variable '" <> unId var <> "' is ungrounded, meaning it is not directly bound as an argument to a relation.")
, (srcLocRule, Where $ "This contains no clauses that refer to '" <> unId var <> "'.")
]
hints = [Hint $ "Use the variable '" <> unId var <> "' as an argument in a relation."]
in Err Nothing title markers hints
wildcardInFactToReport :: WildcardInFact Position -> Report Text
wildcardInFactToReport e@(WildcardInFact srcLocFact _ _pos) =
let title = "Wildcard in top level fact"
markers = [ (mainErrorPosition e, This "Wildcard found.")
, (srcLocFact, Where "A top level fact only supports constants.\nVariables or wildcards are not allowed.")
]
hints = [Hint "Replace the wildcard with a constant."]
in Err Nothing title markers hints
wildcardInExternToReport :: WildcardInExtern Position -> Report Text
wildcardInExternToReport e@(WildcardInExtern atomLoc _ _) =
Err Nothing title markers hints
where
title = "Wildcard in externally defined atom"
markers = [ (mainErrorPosition e, This "Wildcard found.")
, (atomLoc, Where "An external atom only supports constants or grounded variables.")
]
hints = [Hint "Replace the wildcard with a constant or grounded variable."]
unconstrainedVarToReport :: UnconstrainedRuleVar Position -> Report Text
unconstrainedVarToReport e@(UnconstrainedRuleVar ruleLoc _ varName) =
Err Nothing title markers hints
where
title = "Found unconstrained variable"
markers = [ (mainErrorPosition e, This $ "The variable '" <> unId varName <> "' only occurs once.")
, (ruleLoc, Where $ "This rule contains no other references to '" <> unId varName <> "'.")
]
hints = [ Hint "Replace the variable with a wildcard ('_')."
, Hint "Use the variable in another rule clause."
]
wildcardInRuleHeadToReport :: WildcardInRuleHead Position -> Report Text
wildcardInRuleHeadToReport e@(WildcardInRuleHead srcLocRule _ _pos) =
let title = "Wildcard in 'head' of rule"
markers = [ (mainErrorPosition e, This "Wildcard found.")
, (srcLocRule, Where "Only constants and variables are allowed in the head of a rule.\nWildcards are not allowed.")
]
hints = [Hint "Replace the wildcard with a constant or a variable."]
in Err Nothing title markers hints
wildcardInConstraintToReport :: WildcardInConstraint Position -> Report Text
wildcardInConstraintToReport e@(WildcardInConstraint srcLocConstraint _) =
let title = "Found wildcard in constraint"
markers = [ (mainErrorPosition e, This "Wildcard found.")
, (srcLocConstraint, Where "Only constants and variables are allowed in a constraint.")
]
hints = [ Hint "This statement can be removed since it has no effect."
, Hint "Replace the wildcard with a variable."
]
in Err Nothing title markers hints
wildcardInBinOpToReport :: WildcardInBinOp Position -> Report Text
wildcardInBinOpToReport e@(WildcardInBinOp srcLocBinOp _) =
let title = "Found wildcard in binary operation"
markers = [ (mainErrorPosition e, This "Wildcard found.")
, (srcLocBinOp, Where "Only constants and variables are allowed in a binary operation.")
]
hints = [Hint "Replace the wildcard with a variable or literal."]
in Err Nothing title markers hints
deadInternalRelationToReport :: DeadInternalRelation Position -> Report Text
deadInternalRelationToReport e@(DeadInternalRelation _ r) =
let title = "Dead internal relation"
markers = [(mainErrorPosition e, This $ "The internal rule '" <> unId r <> "' has no facts or rules defined and will never produce results.")]
hints = [ Hint "This might indicate a logic error in your code."
, Hint "Remove this rule if it is no longer needed."
, Hint "Add 'input' to the declaration to indicate this rule is an input."
]
in Err Nothing title markers hints
noOutputRelationsToReport :: NoOutputRelation Position -> Report Text
noOutputRelationsToReport e@(NoOutputRelation _) =
let title = "No output relations found"
markers = [(mainErrorPosition e, This "This module does not produce any results")]
hints = [ Hint "Add an 'output' qualifier to one of the relations defined in this module." ]
in Err Nothing title markers hints
conflictingDefinitionsToReport :: ConflictingDefinitionGroup Position -> Report Text
conflictingDefinitionsToReport e@(ConflictingDefinitionGroup name locs) =
Err Nothing title (mainMarker:markers) hints
where
title = "Multiple definitions for '" <> unId name <> "'"
mainMarker =
(mainErrorPosition e, This $ "'" <> unId name <> "' is originally defined here.")
markers = tail locs & toList & map (, Where $ "'" <> unId name <> "' is re-defined here.")
hints = [Hint $ "You can solve this by removing the duplicate definitions for '" <> unId name <> "'."]
externUsedAsFactToReport :: ExternUsedAsFact Position -> Report Text
externUsedAsFactToReport e@(ExternUsedAsFact _ externLoc name) =
Err Nothing title markers hints
where
title = "Extern definition used as top level fact"
markers =
[ (mainErrorPosition e, This $ "'" <> unId name <> "' is used as a fact here, which is not allowed for extern definitions.")
, (externLoc, Where $ "'" <> unId name <> "' previously defined here as external.")
]
hints = [ Hint $ "Convert '" <> unId name <> "' to a relation."
, Hint "Remove the top level fact."
]
externUsedAsRuleToReport :: ExternUsedAsRule Position -> Report Text
externUsedAsRuleToReport e@(ExternUsedAsRule _ externLoc name) =
Err Nothing title markers hints
where
title = "Extern definition used in rule head"
markers =
[ (mainErrorPosition e, This $ "'" <> unId name <> "' is used as a rule head here, which is not allowed for extern definitions.")
, (externLoc, Where $ "'" <> unId name <> "' previously defined here as external.")
]
hints = [ Hint $ "Convert '" <> unId name <> "' to a relation."
, Hint "Remove the rule."
]
cyclicNegationToReport :: CyclicNegation Position -> Report Text
cyclicNegationToReport e =
Err Nothing title markers hints
where
title = "Negation used in recursive set of rules"
markers =
[ (mainErrorPosition e, This "This negation is used in a set of rules that is recursive, which is not allowed.")
]
hints = [ Hint "Restructure the program so the negation does not occur in the set of recursive rules."
, Hint "Remove the negation entirely."
]
-- NOTE: pattern match is done this way to keep track of additional errors that need to be reported
{-# ANN semanticErrorsToReportsWithLocations ("HLint: ignore Use record patterns" :: String) #-}
semanticErrorsToReportsWithLocations :: SemanticErrors Position -> [(Report Text, Location)]
semanticErrorsToReportsWithLocations e@(SemanticErrors _ _ _ _ _ _ _ _ _ _ _ _ _) =
concat [ ungroundedVarReports
, wildcardInFactReports
, wildcardInRuleHeadReports
, wildcardInConstraintReports
, wildcardInBinOpReports
, wildcardInExternReports
, unconstrainedVarReports
, deadInternalRelationReports
, noOutputReports
, conflictingDefinitionReports
, externUsedAsFactReports
, externUsedAsRuleReports
, cyclicNegationReports
]
where
getReportsWithLocationsFor
:: HasMainErrorPosition a
=> (SemanticErrors Position -> Container a)
-> (a -> Report Text)
-> [(Report Text, Location)]
getReportsWithLocationsFor f g =
map (g &&& positionToLocation . mainErrorPosition) (f e)
ungroundedVarReports = getReportsWithLocationsFor ungroundedVars ungroundedVarToReport
wildcardInFactReports = getReportsWithLocationsFor wildcardsInFacts wildcardInFactToReport
wildcardInRuleHeadReports = getReportsWithLocationsFor wildcardsInRuleHeads wildcardInRuleHeadToReport
wildcardInConstraintReports = getReportsWithLocationsFor wildcardsInConstraints wildcardInConstraintToReport
wildcardInBinOpReports = getReportsWithLocationsFor wildcardsInBinOps wildcardInBinOpToReport
wildcardInExternReports = getReportsWithLocationsFor wildcardsInExternAtoms wildcardInExternToReport
unconstrainedVarReports = getReportsWithLocationsFor unconstrainedVars unconstrainedVarToReport
deadInternalRelationReports = getReportsWithLocationsFor deadInternalRelations deadInternalRelationToReport
noOutputReports = getReportsWithLocationsFor noOutputRelations noOutputRelationsToReport
conflictingDefinitionReports = getReportsWithLocationsFor conflictingDefinitions conflictingDefinitionsToReport
externUsedAsFactReports = getReportsWithLocationsFor externsUsedAsFact externUsedAsFactToReport
externUsedAsRuleReports = getReportsWithLocationsFor externsUsedAsRule externUsedAsRuleToReport
cyclicNegationReports = getReportsWithLocationsFor cyclicNegations cyclicNegationToReport
pluralize :: Int -> Text -> Text -> Text
pluralize count singular plural' =
if count == 1 then singular else plural'
getSourcePos :: FilePath -> Text -> SpanMap -> NodeId -> Position
getSourcePos file' fileContent spanMap nodeId =
let span' = lookupSpan spanMap nodeId
in sourceSpanToPosition $ spanToSourceSpan file' fileContent span'
-- Diagnose is 1-based, Eclair 0-based
-- TODO get rid of this hack (and diagnose alltogether)
getSourcePosCLI :: FilePath -> Text -> SpanMap -> NodeId -> Position
getSourcePosCLI file' fileContent spanMap nodeId =
addOffset $ getSourcePos file' fileContent spanMap nodeId
where
addOffset pos =
Position (both (+1) $ begin pos) (both (+1) $ end pos) (file pos)
sourceSpanToPosition :: SourceSpan -> Position
sourceSpanToPosition sourceSpan =
let beginPos' = sourceSpanBegin sourceSpan
endPos' = sourceSpanEnd sourceSpan
start = (sourcePosLine beginPos', sourcePosColumn beginPos')
end' = (sourcePosLine endPos', sourcePosColumn endPos')
in Position start end' (sourceSpanFile sourceSpan)
positionToLocation :: Position -> Location
positionToLocation position =
let locStart = uncurry Pos (both fromIntegral $ begin position)
locEnd = uncurry Pos (both fromIntegral $ end position)
in Location (file position) locStart locEnd
both :: (a -> b) -> (a, a) -> (b, b)
both f = bimap f f
renderType :: Type -> Text
renderType ty =
let userFacingType = case ty of
U32 -> "u32"
Str -> "string"
TUnknown x -> "t" <> show x
in "'" <> userFacingType <> "'"
class HasMainErrorPosition a where
mainErrorPosition :: a -> Position
instance HasMainErrorPosition (NoOutputRelation Position) where
mainErrorPosition (NoOutputRelation pos) = startOfFile $ file pos
where startOfFile = Position (1, 1) (1, 2) -- Diagnose is 1-based!
instance HasMainErrorPosition (DeadInternalRelation Position) where
mainErrorPosition (DeadInternalRelation pos _) = pos
instance HasMainErrorPosition (WildcardInConstraint Position) where
mainErrorPosition (WildcardInConstraint _ pos) = pos
instance HasMainErrorPosition (WildcardInBinOp Position) where
mainErrorPosition (WildcardInBinOp _ pos) = pos
instance HasMainErrorPosition (WildcardInFact Position) where
mainErrorPosition (WildcardInFact _ factArgPos _) = factArgPos
instance HasMainErrorPosition (WildcardInExtern Position) where
mainErrorPosition (WildcardInExtern _ externArgPos _) = externArgPos
instance HasMainErrorPosition (UnconstrainedRuleVar Position) where
mainErrorPosition (UnconstrainedRuleVar _ varPos _) = varPos
instance HasMainErrorPosition (UngroundedVar Position) where
mainErrorPosition (UngroundedVar _ varPos _) = varPos
instance HasMainErrorPosition (WildcardInRuleHead Position) where
mainErrorPosition (WildcardInRuleHead _ ruleArgPos _) = ruleArgPos
instance HasMainErrorPosition (ConflictingDefinitionGroup Position) where
mainErrorPosition (ConflictingDefinitionGroup _ positions) = head positions
instance HasMainErrorPosition (ExternUsedAsFact Position) where
mainErrorPosition (ExternUsedAsFact pos _ _) = pos
instance HasMainErrorPosition (ExternUsedAsRule Position) where
mainErrorPosition (ExternUsedAsRule pos _ _) = pos
instance HasMainErrorPosition (CyclicNegation Position) where
mainErrorPosition (CyclicNegation pos) = pos
instance HasMainErrorPosition (TypeError Position) where
mainErrorPosition = \case
UnknownConstraint pos _ -> pos
UnknownFunction pos _ -> pos
ArgCountMismatch _ _ (pos, _) -> pos
TypeMismatch pos _ _ _ -> pos
UnificationFailure _ _ ctx -> getContextLocation (last ctx)
HoleFound pos _ _ _ -> pos
UnexpectedFunctionType pos _ -> pos
UnexpectedConstraintType pos _ -> pos
instance HasMainErrorPosition (ConversionError Position) where
mainErrorPosition = \case
HoleNotSupported pos -> pos
UnsupportedType pos _ -> pos
UnsupportedCase pos -> pos
-- Helper function to transform a Megaparsec error bundle into multiple reports
-- Extracted from the Diagnose library, and simplified for usage in Eclair.
errReportsWithLocationsFromBundle
:: Text -> P.ParseErrorBundle Text CustomParseErr -> [(Report Text, Location)]
errReportsWithLocationsFromBundle msg errBundle =
toList (addLabelAndLocation <$> P.bundleErrors errBundle)
where
addLabelAndLocation e =
let (_, pos) = P.reachOffset (P.errorOffset e) (P.bundlePosState errBundle)
source = fromSourcePos (P.pstateSourcePos pos)
msgs = lines $ toText (P.parseErrorTextPretty e)
markers = case msgs of
[m] ->
[(source, This m)]
[m1, m2] ->
[(source, This m1), (source, Where m2)]
_ ->
[(source, This "<>")]
report = Err Nothing msg markers mempty
in (report, positionToLocation source)
fromSourcePos sourcePos =
let begin' = both (fromIntegral . P.unPos) (P.sourceLine sourcePos, P.sourceColumn sourcePos)
end' = second (+ 1) begin'
in Position begin' end' (P.sourceName sourcePos)
data UseColor = UseColor
deriving Eq
prettyError :: Maybe UseColor -> Diagnostic Text -> Doc AnsiStyle
prettyError useColor =
applyStyle . prettyDiagnostic useUnicode tabSpaces
where
applyStyle =
if useColor == Just UseColor
then style
else unAnnotate
useUnicode = True
tabSpaces = 2
style :: Style
style = reAnnotate style'
where
style' = \case
ThisColor isError ->
colorDull $ if isError then Red else Yellow
MaybeColor ->
color Magenta
WhereColor ->
colorDull Blue
HintColor ->
colorDull Cyan
FileColor ->
bold <> colorDull Green
RuleColor ->
bold <> color Black
KindColor isError ->
bold <> style' (ThisColor isError)
NoLineColor ->
bold <> colorDull Magenta
MarkerStyle st ->
bold <> style' st
CodeStyle ->
color White
================================================
FILE: lib/Eclair/JSON.hs
================================================
{-# LANGUAGE LinearTypes, MagicHash #-}
-- | Helper module encoding Haskell values as JSON.
-- Only a limited set of functionality is provided.
-- (Needed since hermes-json only does decoding of JSON.)
module Eclair.JSON
( JSON(..)
, encodeJSON
) where
import Data.Text.Builder.Linear.Buffer
import GHC.Prim (Addr#)
data JSON
= Null
| Boolean Bool
| Number Int
| String Text
| Object [(Text, JSON)]
| Array [JSON]
encodeJSON :: JSON -> Text
encodeJSON json =
runBuffer (`toJSON'` json)
where
toJSON' :: Buffer %1 -> JSON -> Buffer
toJSON' buf = \case
Null ->
buf |># "null"#
Boolean b ->
buf |># if b then "true"# else "false"#
Number x ->
buf |> show x
String s ->
dquotes buf (|> s)
Object pairs ->
braces buf (\buf' ->
sepBy ","# buf' pairs (\buf'' (k, v) ->
(dquotes buf'' (|> k) |>. ':') `toJSON'` v
)
)
Array elems ->
brackets buf (\buf' -> sepBy ","# buf' elems toJSON')
type BufferDecorator = Buffer %1 -> (Buffer %1 -> Buffer) -> Buffer
brackets :: BufferDecorator
brackets = betweenChars '[' ']'
{-# INLINABLE brackets #-}
braces :: BufferDecorator
braces = betweenChars '{' '}'
{-# INLINABLE braces #-}
dquotes :: BufferDecorator
dquotes = betweenChars '"' '"'
{-# INLINABLE dquotes #-}
betweenChars :: Char -> Char -> BufferDecorator
betweenChars begin end buf f =
f (buf |>. begin) |>. end
{-# INLINABLE betweenChars #-}
sepBy :: forall a. Addr# -> Buffer %1 -> [a] -> (Buffer %1 -> a -> Buffer) -> Buffer
sepBy separator buf as f =
foldlIntoBuffer combine buf parts
where
parts = intersperse Nothing $ map Just as
combine :: Buffer %1 -> Maybe a -> Buffer
combine buf' = \case
Nothing ->
buf' |># separator
Just a ->
f buf' a
{-# INLINABLE sepBy #-}
================================================
FILE: lib/Eclair/LLVM/Allocator/Arena.hs
================================================
{-# LANGUAGE GADTs #-}
module Eclair.LLVM.Allocator.Arena
( Arena
, allocator
) where
import Prelude hiding (void)
import Eclair.LLVM.Allocator.Common
import Eclair.LLVM.Codegen
data Arena a
-- TODO support multiple implementations, switch based on an enum:
-- - variant that only allocates, never frees until destroyed
-- - variant that can free sometimes, when allocation counter hits 0
-- - bump up vs bump down (each has it's own benefits): https://fitzgeraldnick.com/2019/11/01/always-bump-downwards.html
allocator :: Int -> Allocator a -> Allocator (Arena a)
allocator arenaSize inner
= Allocator
{ aType = mkType
, aInit = arenaInit arenaSize
, aDestroy = arenaDestroy arenaSize
, aAlloc = arenaAlloc
, aFree = arenaFree
, aKind = Node
, aInner = inner
}
mkType :: Text -> Type -> AllocCodegenM Type
mkType prefix baseTy =
typedef (Name $ prefix <> "arena_allocator") Off
[ baseTy -- inner allocator
, ptr void -- start
, ptr void -- current
]
innerPtr :: Operand -> AllocIRCodegenM Operand
innerPtr = addr innerAllocOf
arenaInit :: Int -> VTable -> InitFn
arenaInit arenaSize fns alloc = do
inner <- innerPtr alloc
vtInit fns inner
let size = int32 $ fromIntegral arenaSize
memory <- vtAllocate fns inner size
didAllocationFail <- memory `eq` nullPtr void
if' didAllocationFail $ do
assign startPtrOf alloc (nullPtr void)
assign currentPtrOf alloc (nullPtr void)
retVoid
memoryEnd <- gep memory [size]
assign startPtrOf alloc memory
-- NOTE: we start at end and bump down, this can be implemented faster
-- https://fitzgeraldnick.com/2019/11/01/always-bump-downwards.html
assign currentPtrOf alloc memoryEnd
arenaDestroy :: Int -> VTable -> DestroyFn
arenaDestroy arenaSize fns alloc = do
startPtr <- deref startPtrOf alloc
isNull <- startPtr `eq` nullPtr void
if' isNull $ do
vtDestroy fns =<< innerPtr alloc
retVoid
inner <- innerPtr alloc
let numBytes = int32 $ fromIntegral arenaSize
vtDeallocate fns inner startPtr numBytes
vtDestroy fns =<< innerPtr alloc
assign startPtrOf alloc (nullPtr void)
assign currentPtrOf alloc (nullPtr void)
arenaAlloc :: VTable -> AllocateFn
arenaAlloc _ alloc numBytes = do
startPtr <- deref startPtrOf alloc
currentPtr <- deref currentPtrOf alloc
numBytesNegated <- sub (int32 0) numBytes
newPtr <- gep currentPtr [numBytesNegated]
newAddr <- ptrtoint newPtr i64
startAddr <- ptrtoint startPtr i64
noSpaceLeft <- newAddr `ult` startAddr
if' noSpaceLeft $ do
pure $ nullPtr void
assign currentPtrOf alloc newPtr
pure newPtr
-- Arena can't free individual pieces of memory, only everything at once
arenaFree :: VTable -> DeallocateFn
arenaFree _ _ _ _ = pass
data Paths
= Alloc
| InnerAlloc
| StartPtr
| CurrentPtr
innerAllocOf :: Path Alloc InnerAlloc
innerAllocOf = mkPath [int32 0]
startPtrOf :: Path Alloc StartPtr
startPtrOf = mkPath [int32 1]
currentPtrOf :: Path Alloc CurrentPtr
currentPtrOf = mkPath [int32 2]
================================================
FILE: lib/Eclair/LLVM/Allocator/Common.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE GADTs #-}
module Eclair.LLVM.Allocator.Common
( Allocator(..)
, Blueprint(..)
, AllocatorKind(..)
, AllocatorKindTag(..)
, VTable(..)
, None(..)
, AllocCodegenM
, AllocIRCodegenM
, InitFn
, DestroyFn
, AllocateFn
, DeallocateFn
, cgAlloc
, mkBaseAllocator
, module Eclair.LLVM.Externals
) where
import Prelude hiding (void)
import qualified Data.Kind as K
import Eclair.LLVM.Codegen
import Eclair.LLVM.Externals
type AllocCodegenM = StateT Externals ModuleBuilder
type AllocIRCodegenM = IRBuilderT AllocCodegenM
type InitFn
= Operand -- allocator
-> AllocIRCodegenM ()
type DestroyFn
= Operand -- allocator
-> AllocIRCodegenM ()
type AllocateFn
= Operand -- allocator
-> Operand -- length (in bytes)
-> AllocIRCodegenM Operand
type DeallocateFn
= Operand -- allocator
-> Operand -- ptr
-> Operand -- length
-> AllocIRCodegenM ()
-- TODO add resize everywhere, just like alloc and free
-- type ResizeFn = Operand -- ptr
-- -> Operand -- length
-- -> AllocIRCodegenM ()
-- Helper type that for performing actions on an allocator.
-- This allows a composed allocator to call inner functionality freely.
data VTable
= VTable
{ vtInit :: InitFn
, vtDestroy :: DestroyFn
, vtAllocate :: AllocateFn
, vtDeallocate :: DeallocateFn
}
data AllocatorKindTag
= IsRoot
| IsNode
data AllocatorKind (k :: AllocatorKindTag) where
Root :: AllocatorKind 'IsRoot
Node :: AllocatorKind 'IsNode
type family CreateTypeFn (k :: AllocatorKindTag) where
CreateTypeFn 'IsRoot = Text -> AllocCodegenM Type
CreateTypeFn 'IsNode = Text -> Type -> AllocCodegenM Type
type family AllocatorFn (k :: AllocatorKindTag) (ty :: K.Type) where
AllocatorFn 'IsRoot f = f
AllocatorFn 'IsNode f = VTable -> f
data None a = None
type family BackingAllocator (k :: AllocatorKindTag) :: (K.Type -> K.Type) where
BackingAllocator 'IsRoot = None
BackingAllocator 'IsNode = Allocator
-- First we build up the allocator info in a data-structure.
-- "Stateless" allocators carry no state, and call direct functions provided by the OS (mmap, malloc, ...)
-- "Stateful" allocators do have state, and can further enhance the behavior of the underlying allocator.
data Allocator repr where
Allocator
:: { aType :: CreateTypeFn k
, aInit :: AllocatorFn k InitFn
, aDestroy :: AllocatorFn k DestroyFn
, aAlloc :: AllocatorFn k AllocateFn
, aFree :: AllocatorFn k DeallocateFn
, aInner :: BackingAllocator k inner
, aKind :: AllocatorKind k
}
-> Allocator repr
-- Helper type for keeping references to generated allocator code
data Blueprint repr
= Blueprint
{ bpType :: Type
, bpInitFn :: Operand
, bpDestroyFn :: Operand
, bpAllocateFn :: Operand
, bpDeallocateFn :: Operand
}
-- Helper type during codegen process.
data Gen
= Gen
{ generateTy :: Text -> AllocCodegenM Type
, generateInit :: InitFn
, generateDestroy :: DestroyFn
, generateAlloc :: AllocateFn
, generateFree :: DeallocateFn
}
-- This function does the actual code generation of the allocator.
cgAlloc :: Text -> Allocator repr -> AllocCodegenM (Blueprint repr)
cgAlloc prefix allocator = do
let g = cgHelper allocator
allocatorTy <- generateTy g prefix
allocFn <- function (Name $ prefix <> "_alloc")
[(ptr allocatorTy, "allocator"), (i32, "size")] (ptr void)
$ \[alloc, size] -> do
ret =<< generateAlloc g alloc size
freeFn <- function (Name $ prefix <> "_free")
[(ptr allocatorTy, "allocator"), (ptr i8, "memory"), (i32, "size")] void
$ \[alloc, memory, size] -> do
generateFree g alloc memory size
initFn <- function (Name $ prefix <> "_init")
[(ptr allocatorTy, "allocator")] void
$ \[alloc] -> do
generateInit g alloc
destroyFn <- function (Name $ prefix <> "_destroy")
[(ptr allocatorTy, "allocator")] void
$ \[alloc] -> do
generateDestroy g alloc
pure $ Blueprint allocatorTy initFn destroyFn allocFn freeFn
where
-- Recursively generates the code
cgHelper :: Allocator repr -> Gen
cgHelper = \case
Allocator genTy genInit genDestroy genAlloc genFree innerAlloc kind ->
case kind of
Root ->
Gen { generateTy = genTy
, generateInit = genInit
, generateDestroy = genDestroy
, generateAlloc = genAlloc
, generateFree = genFree
}
Node ->
let generated = cgHelper innerAlloc
vtable = VTable
{ vtInit = generateInit generated
, vtDestroy = generateDestroy generated
, vtAllocate = generateAlloc generated
, vtDeallocate = generateFree generated
}
in Gen
{ generateTy = \namePrefix -> do
-- First generate inner type, then outer type.
ty <- generateTy generated namePrefix
genTy namePrefix ty
-- Pass generated inner code as function, then generate outer code based on that.
, generateInit = genInit vtable
, generateDestroy = genDestroy vtable
, generateAlloc = genAlloc vtable
, generateFree = genFree vtable
}
mkBaseAllocator
:: (Text -> AllocCodegenM Type)
-> (Operand -> AllocIRCodegenM Operand)
-> (Operand -> Operand -> AllocIRCodegenM ())
-> Allocator repr
mkBaseAllocator mkType allocFn freeFn
= Allocator
{ aType = mkType
, aInit = const pass
, aDestroy = const pass
, aAlloc = const allocFn
, aFree = const freeFn
, aKind = Root
, aInner = None
}
================================================
FILE: lib/Eclair/LLVM/Allocator/Malloc.hs
================================================
module Eclair.LLVM.Allocator.Malloc
( Malloc
, allocator
) where
import Eclair.LLVM.Allocator.Common
import Eclair.LLVM.Codegen
data Malloc
allocator :: Allocator Malloc
allocator = mkBaseAllocator mkType allocFn freeFn
mkType :: Text -> AllocCodegenM Type
mkType prefix =
typedef (Name $ prefix <> "_mallocator") Off []
allocFn :: Operand -> AllocIRCodegenM Operand
allocFn numBytes = do
malloc <- gets extMalloc
call malloc [numBytes]
freeFn :: Operand -> Operand -> AllocIRCodegenM ()
freeFn memory _ = do
free <- gets extFree
_ <- call free [memory]
pass
================================================
FILE: lib/Eclair/LLVM/Allocator/Page.hs
================================================
module Eclair.LLVM.Allocator.Page
( Page
, allocator
, roundToNearestPageSize -- for testing only
) where
import Eclair.LLVM.Allocator.Common
import Eclair.LLVM.Codegen
data Page
-- TODO: parametrize on page size (add argument, pass to helper functions)
allocator :: Allocator Page
allocator = mkBaseAllocator mkType allocatePages freePages
mkType :: Text -> AllocCodegenM Type
mkType prefix =
typedef (Name $ prefix <> "page_allocator") Off []
pageSize :: Operand
pageSize = int32 4096
allocatePages :: Operand -> AllocIRCodegenM Operand
allocatePages numBytes = do
mmap <- gets extMmap
numBytes' <- flip zext i64 =<< roundToNearestPageSize numBytes
let hint = nullPtr VoidType
protRead = int32 1
protWrite = int32 2
mapPrivate = int32 2
mapAnonymous = int32 32
noFd = int32 (-1)
offset = int32 0
prot <- protRead `or` protWrite -- allow both reads and writes
flags <- mapPrivate `or` mapAnonymous -- anonymous private mapping, can be used as RAM
call mmap [hint, numBytes', prot, flags, noFd, offset]
roundToNearestPageSize :: Operand -> AllocIRCodegenM Operand
roundToNearestPageSize numBytes = do
x1 <- numBytes `add` pageSize
x2 <- x1 `sub` int32 1
y <- int32 0 `sub` pageSize
x2 `and` y
freePages :: Operand -> Operand -> AllocIRCodegenM ()
freePages memory len = do
munmap <- gets extMunmap
len' <- zext len i64
_ <- call munmap [memory, len']
pass
================================================
FILE: lib/Eclair/LLVM/BTree/Bounds.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.BTree.Bounds
( mkLinearSearchLowerBound
, mkLinearSearchUpperBound
, mkBtreeLowerBound
, mkBtreeUpperBound
) where
import Prelude hiding (void)
import Eclair.LLVM.BTree.Types
mkLinearSearchLowerBound :: Operand -> ModuleCodegen Operand
mkLinearSearchLowerBound compareValues = do
value <- typeOf Value
let args = [(ptr value, "val"), (ptr value, "current"), (ptr value, "end")]
function "eclair_btree_linear_search_lower_bound" args (ptr value) $ \[val, curr, end] -> mdo
-- Finds an iterator to first element not less than given value.
currentPtr <- allocate (ptr value) curr
let loopCondition = do
current <- load currentPtr 0
current `ne` end
loopWhile loopCondition $ mdo
current <- load currentPtr 0
result <- call compareValues [current, val]
isGtOrEqThan <- result `ne` int8 (-1)
if' isGtOrEqThan $
ret current
current' <- gep current [int32 1]
store currentPtr 0 current'
ret end
mkLinearSearchUpperBound :: Operand -> ModuleCodegen Operand
mkLinearSearchUpperBound compareValues = do
value <- typeOf Value
let args = [(ptr value, "val"), (ptr value, "current"), (ptr value, "end")]
function "eclair_btree_linear_search_upper_bound" args (ptr value) $ \[val, curr, end] -> mdo
-- Finds an iterator to first element that is greater than given value.
currentPtr <- allocate (ptr value) curr
let loopCondition = do
current <- load currentPtr 0
current `ne` end
loopWhile loopCondition $ mdo
current <- load currentPtr 0
result <- call compareValues [current, val]
isGreaterThan <- result `eq` int8 1
if' isGreaterThan $
ret current
current' <- gep current [int32 1]
store currentPtr 0 current'
ret end
mkBtreeLowerBound :: Operand -> Operand -> Operand -> Operand -> Operand -> ModuleCodegen Operand
mkBtreeLowerBound isEmptyTree iterInit iterInitEnd searchLowerBound compareValues = do
tree <- typeOf BTree
iter <- typeOf Iterator
node <- typeOf Node
innerNode <- typeOf InnerNode
value <- typeOf Value
valSize <- asks (valueSize . typeSizes)
let args = [(ptr tree, "tree"), (ptr value, "val"), (ptr iter, "result")]
function "eclair_btree_lower_bound" args void $ \[t, val, result] -> mdo
isEmpty <- call isEmptyTree [t]
if' isEmpty $ do
_ <- call iterInitEnd [result]
retVoid
res <- allocateIter
_ <- call iterInitEnd [res]
currentPtr <- allocate (ptr node) =<< deref rootPtrOf t
loop $ mdo
current <- load currentPtr 0
numElems <- deref (metaOf ->> numElemsOf) current
first <- addr (valueAt (int16 0)) current
last <- addr (valueAt numElems) current
pos <- call searchLowerBound [val, first, last]
idx <- pointerDiff i16 pos first >>= (`udiv` int32 (toInteger valSize))
isLeaf <- deref (metaOf ->> nodeTypeOf) current >>= (`eq` leafNodeTypeVal)
if' isLeaf $ mdo
isLast <- pos `eq` last
condBr isLast handleLast handleOther
handleLast <- blockNamed "handle_last"
copy currentPtrOf res result
copy valuePosOf res result
retVoid
handleOther <- blockNamed "handle_not_last"
_ <- call iterInit [result, current, idx]
retVoid
isNotLast <- pos `ne` last
if' isNotLast $ do
matchFound' <- (int8 0 `eq`) =<< call compareValues [pos, val]
if' matchFound' $ do
_ <- call iterInit [result, current, idx]
retVoid
if' isNotLast $ do
call iterInit [res, current, idx]
let iCurrent = ptrcast innerNode current
store currentPtr 0 =<< deref (childAt idx) iCurrent
mkBtreeUpperBound :: Operand -> Operand -> Operand -> Operand -> ModuleCodegen Operand
mkBtreeUpperBound isEmptyTree iterInit iterInitEnd searchUpperBound = do
tree <- typeOf BTree
iter <- typeOf Iterator
node <- typeOf Node
innerNode <- typeOf InnerNode
value <- typeOf Value
valSize <- asks (valueSize . typeSizes)
let args = [(ptr tree, "tree"), (ptr value, "val"), (ptr iter, "result")]
function "eclair_btree_upper_bound" args void $ \[t, val, result] -> mdo
isEmpty <- call isEmptyTree [t]
if' isEmpty $ do
_ <- call iterInitEnd [result]
retVoid
res <- allocateIter
_ <- call iterInitEnd [res]
currentPtr <- allocate (ptr node) =<< deref rootPtrOf t
loop $ mdo
current <- load currentPtr 0
numElems <- deref (metaOf ->> numElemsOf) current
first <- addr (valueAt (int16 0)) current
last <- addr (valueAt numElems) current
pos <- call searchUpperBound [val, first, last]
idx <- pointerDiff i16 pos first >>= (`udiv` int32 (toInteger valSize))
isLeaf <- deref (metaOf ->> nodeTypeOf) current >>= (`eq` leafNodeTypeVal)
if' isLeaf $ mdo
isLast <- pos `eq` last
condBr isLast handleLast handleOther
handleLast <- blockNamed "handle_last"
copy currentPtrOf res result
copy valuePosOf res result
retVoid
handleOther <- blockNamed "handle_not_last"
_ <- call iterInit [result, current, idx]
retVoid
-- Can the following be done with just pointer comparisons?
isNotLast <- pos `ne` last
if' isNotLast $ do
call iterInit [result, current, idx]
let iCurrent = ptrcast innerNode current
store currentPtr 0 =<< deref (childAt idx) iCurrent
================================================
FILE: lib/Eclair/LLVM/BTree/Compare.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.BTree.Compare
( mkCompare
) where
import Eclair.LLVM.BTree.Types
import qualified Data.Map as Map
mkCompare :: ModuleCodegen Operand
mkCompare = do
settings <- getParams
tys <- asks types
let column' = columnTy tys
value = valueTy tys
compare' <- function "eclair_btree_value_compare" [(column', "lhs"), (column', "rhs")] i8 $ \[lhs, rhs] -> mdo
result1 <- lhs `ult` rhs
if' result1 $
ret $ int8 (-1)
result2 <- lhs `ugt` rhs
ret =<< select result2 (int8 1) (int8 0)
function "eclair_btree_value_compare_values" [(ptr value, "lhs"), (ptr value, "rhs")] i8 $ \[lhs, rhs] -> mdo
let columns = map fromIntegral $ index settings
results <- flip execStateT mempty $ flip (zygo endCheck) columns $ \case
Nil -> pass
Cons col (atEnd, asm) -> do
blk <- blockNamed "comparison"
let indices = [int32 0, int32 col]
lhsPtr <- gep lhs indices
rhsPtr <- gep rhs indices
lhsValue <- load lhsPtr 0
rhsValue <- load rhsPtr 0
compareResult <- call compare' [lhsValue, rhsValue]
modify $ Map.insert compareResult blk
case atEnd of
End -> br end
Continue -> mdo
isEqual <- compareResult `eq` int8 0
condBr isEqual continue end
asm
continue <- currentBlock
pass
end <- blockNamed "end"
ret =<< phi (Map.toList results)
where
endCheck = \case
Nil -> End
_ -> Continue
data ControlFlow
= Continue
| End
================================================
FILE: lib/Eclair/LLVM/BTree/Create.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.BTree.Create
( mkNodeNew
, mkBtreeInit
, mkBtreeInitEmpty
, mkBtreeSwap
) where
import Prelude hiding (void, swap)
import Eclair.LLVM.BTree.Types
mkNodeNew :: ModuleCodegen Operand
mkNodeNew = mdo
md <- getParams
nodeType <- typeOf NodeType
node <- typeOf Node
innerNode <- typeOf InnerNode
sizes <- asks typeSizes
let numKeys' = numKeys md sizes
ptrSize = pointerSize sizes
valuesByteCount = numKeys' * valueSize sizes
leafSize = int32 . toInteger $ leafNodeSize sizes
innerSize = int32 . toInteger $ innerNodeSize sizes
malloc <- asks (extMalloc . externals)
function "eclair_btree_node_new" [(nodeType, "type")] (ptr node) $ \[ty] -> mdo
structSize <- select ty innerSize leafSize
memory <- call malloc [structSize]
let n = ptrcast node memory
assign (metaOf ->> parentOf) n (nullPtr node)
assign (metaOf ->> posInParentOf) n (int16 0)
assign (metaOf ->> numElemsOf) n (int16 0)
assign (metaOf ->> nodeTypeOf) n ty
valuesPtr <- addr valuesOf n
memset valuesPtr 0 valuesByteCount
isInner <- ty `eq` innerNodeTypeVal
if' isInner $ mdo
let inner = ptrcast innerNode n
let childrenByteCount = (numKeys' + 1) * ptrSize
childrenPtr <- addr childrenOf inner
memset childrenPtr 0 childrenByteCount
ret n
mkBtreeInitEmpty :: ModuleCodegen Operand
mkBtreeInitEmpty = do
tree <- typeOf BTree
node <- typeOf Node
function "eclair_btree_init_empty" [(ptr tree, "tree")] void $ \[t] -> mdo
assign rootPtrOf t (nullPtr node)
assign firstPtrOf t (nullPtr node)
mkBtreeInit :: Operand -> ModuleCodegen Operand
mkBtreeInit btreeInsertRange = do
tree <- typeOf BTree
iter <- typeOf Iterator
let args = [(ptr tree, "tree"), (ptr iter, "start"), (ptr iter, "end")]
function "eclair_btree_init" args void $ \[t, start, end] -> mdo
_ <- call btreeInsertRange [t, start, end]
pass
mkBtreeSwap :: ModuleCodegen Operand
mkBtreeSwap = do
tree <- typeOf BTree
function "eclair_btree_swap" [(ptr tree, "lhs"), (ptr tree, "rhs")] void $ \[lhs, rhs] ->
for_ [rootPtrOf, firstPtrOf] $ \path ->
swap path lhs rhs
================================================
FILE: lib/Eclair/LLVM/BTree/Destroy.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.BTree.Destroy
( mkBtreeDestroy
, mkBtreeClear
) where
import Prelude hiding (void)
import Eclair.LLVM.BTree.Types
mkBtreeDestroy :: Operand -> ModuleCodegen Operand
mkBtreeDestroy btreeClear = do
tree <- typeOf BTree
function "eclair_btree_destroy" [(ptr tree, "tree")] void $ \[t] -> do
_ <- call btreeClear [t]
pass
mkNodeDelete :: ModuleCodegen Operand
mkNodeDelete = mdo
node <- typeOf Node
innerNode <- typeOf InnerNode
free <- asks (extFree . externals)
nodeDelete <- function "eclair_btree_node_delete" [(ptr node, "node")] void $ \[n] -> mdo
nodeTy <- deref (metaOf ->> nodeTypeOf) n
isInner <- nodeTy `eq` innerNodeTypeVal
if' isInner $ do -- Delete children of inner node
let inner = ptrcast innerNode n
numElements <- deref (metaOf ->> numElemsOf) n
loopFor (int16 0) (`ule` numElements) (add (int16 1)) $ \i -> mdo
child <- deref (childAt i) inner
isNotNull <- child `ne` nullPtr node
if' isNotNull $
call nodeDelete [child]
let memory = ptrcast i8 n
_ <- call free [memory]
pass
pure nodeDelete
mkBtreeClear :: ModuleCodegen Operand
mkBtreeClear = do
tree <- typeOf BTree
node <- typeOf Node
nodeDelete <- mkNodeDelete
function "eclair_btree_clear" [(ptr tree, "tree")] void $ \[t] -> do
root <- deref rootPtrOf t
isNotNull <- root `ne` nullPtr node
if' isNotNull $ do
_ <- call nodeDelete [root]
assign rootPtrOf t (nullPtr node)
assign firstPtrOf t (nullPtr node)
================================================
FILE: lib/Eclair/LLVM/BTree/Find.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.BTree.Find
( mkBtreeContains
, mkBtreeFind
) where
import Prelude hiding (void)
import Eclair.LLVM.BTree.Types
mkBtreeContains :: Operand -> Operand -> Operand -> ModuleCodegen Operand
mkBtreeContains iterIsEqual btreeFind btreeEnd = do
tree <- typeOf BTree
value <- typeOf Value
function "eclair_btree_contains" [(ptr tree, "tree"), (ptr value, "val")] i1 $ \[t, val] -> do
iterPtr <- allocateIter
endIterPtr <- allocateIter
_ <- call btreeFind [t, val, iterPtr]
_ <- call btreeEnd [t, endIterPtr]
isEqual <- call iterIsEqual [iterPtr, endIterPtr]
ret =<< not' isEqual
mkBtreeFind :: Operand -> Operand -> Operand -> Operand -> Operand -> ModuleCodegen Operand
mkBtreeFind isEmptyTree searchLowerBound compareValues iterInit iterInitEnd = do
tree <- typeOf BTree
iter <- typeOf Iterator
node <- typeOf Node
innerNode <- typeOf InnerNode
value <- typeOf Value
valSize <- asks (valueSize . typeSizes)
let args = [(ptr tree, "tree"), (ptr value, "val"), (ptr iter, "result")]
function "eclair_btree_find" args void $ \[t, val, result] -> mdo
isEmpty <- call isEmptyTree [t]
if' isEmpty $ do
_ <- call iterInitEnd [result]
retVoid
currentPtr <- allocate (ptr node) =<< deref rootPtrOf t
-- Find iterator using iterative approach
loop $ mdo
current <- load currentPtr 0
numElems <- deref (metaOf ->> numElemsOf) current
first <- addr (valueAt (int16 0)) current
last <- addr (valueAt numElems) current
pos <- call searchLowerBound [val, first, last]
idx <- pointerDiff i16 pos first >>= (`udiv` int32 (toInteger valSize))
-- Can the following equality check be done using just pointers?
foundMatch <- pos `ult` last
if' foundMatch $ do
matchesVal <- (int8 0 `eq`) =<< call compareValues [pos, val]
if' matchesVal $ do
_ <- call iterInit [result, current, idx]
retVoid
isLeaf <- deref (metaOf ->> nodeTypeOf) current >>= (`eq` leafNodeTypeVal)
if' isLeaf $ do
_ <- call iterInitEnd [result]
retVoid
-- Continue search in child node
let iCurrent = ptrcast innerNode current
store currentPtr 0 =<< deref (childAt idx) iCurrent
================================================
FILE: lib/Eclair/LLVM/BTree/Insert.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.BTree.Insert
( mkBtreeInsertValue
, mkBtreeInsertRangeTemplate
) where
import Prelude hiding (void)
import Eclair.LLVM.Table
import Eclair.LLVM.BTree.Types
mkNodeSplitPoint :: ModuleCodegen Operand
mkNodeSplitPoint = mdo
nodeSize <- typeOf NodeSize
numberOfKeys <- numKeysAsOperand
function "eclair_btree_node_split_point" [] nodeSize $ \_ -> mdo
a' <- mul (int16 3) numberOfKeys
a <- udiv a' (int16 4)
b <- sub numberOfKeys (int16 2)
ret =<< minimum' Unsigned a b
mkSplit :: Operand -> Operand -> Operand -> ModuleCodegen Operand
mkSplit nodeNew nodeSplitPoint growParent = mdo
node <- typeOf Node
innerNode <- typeOf InnerNode
numberOfKeys <- numKeysAsOperand
function "eclair_btree_node_split" [(ptr node, "node"), (ptr (ptr node), "root")] void $ \[n, root] -> mdo
-- TODO: how to do assertions in LLVM?
-- assert(n->meta.num_elements == NUM_KEYS);
splitPoint <- call nodeSplitPoint []
splitPoint' <- add (int16 1) splitPoint
ty <- deref (metaOf ->> nodeTypeOf) n
-- Create a new sibling node and move some of the data to sibling
sibling <- call nodeNew [ty]
jPtr <- allocate i16 (int16 0)
loopFor splitPoint' (`ult` numberOfKeys) (add (int16 1)) $ \i -> mdo
j <- load jPtr 0
assign (valueAt j) sibling =<< deref (valueAt i) n
store jPtr 0 =<< add (int16 1) j
isInner <- ty `eq` innerNodeTypeVal
if' isInner $ mdo
let iSibling = ptrcast innerNode sibling
let iN = ptrcast innerNode n
store jPtr 0 (int16 0)
loopFor splitPoint' (`ule` numberOfKeys) (add (int16 1)) $ \i -> mdo
j <- load jPtr 0
iChild <- deref (childAt i) iN
assign (metaOf ->> parentOf) iChild sibling
assign (metaOf ->> posInParentOf) iChild j
assign (childAt j) iSibling iChild
store jPtr 0 =<< add (int16 1) j
assign (metaOf ->> numElemsOf) n splitPoint
siblingNumKeys <- sub numberOfKeys splitPoint >>= flip sub (int16 1)
assign (metaOf ->> numElemsOf) sibling siblingNumKeys
_ <- call growParent [n, root, sibling]
pass
mkGrowParent :: Operand -> Operand -> ModuleCodegen Operand
mkGrowParent nodeNew insertInner = mdo
node <- typeOf Node
innerNode <- typeOf InnerNode
function "eclair_btree_node_grow_parent" [(ptr node, "node"), (ptr (ptr node), "root"), (ptr node, "sibling")] void $
\[n, root, sibling] -> mdo
parent <- deref (metaOf ->> parentOf) n
isNull <- parent `eq` nullPtr node
numElems <- deref (metaOf ->> numElemsOf) n
condBr isNull createNewRoot insertNewNodeInParent
createNewRoot <- blockNamed "create_new_root"
-- TODO: assert(n == *root)
newRoot <- call nodeNew [innerNodeTypeVal]
let iNewRoot = ptrcast innerNode newRoot
assign (metaOf ->> numElemsOf) newRoot (int16 1)
lastValueOfN <- deref (valueAt numElems) n
assign (valueAt (int16 0)) newRoot lastValueOfN
assign (childAt (int16 0)) iNewRoot n
assign (childAt (int16 1)) iNewRoot sibling
assign (metaOf ->> parentOf) n newRoot
assign (metaOf ->> parentOf) sibling newRoot
-- assign (metaOf ->> posInParentOf) n (int16 0) -- Not needed, root already has position 0
assign (metaOf ->> posInParentOf) sibling (int16 1)
store root 0 newRoot
retVoid
insertNewNodeInParent <- blockNamed "insert_new_node_in_parent"
pos <- deref (metaOf ->> posInParentOf) n
lastValuePtr <- addr (valueAt numElems) n
_ <- call insertInner [parent, root, pos, n, lastValuePtr, sibling]
retVoid
mkInsertInner :: Operand -> ModuleCodegen Operand
mkInsertInner rebalanceOrSplit = mdo
node <- typeOf Node
innerNode <- typeOf InnerNode
nodeSize <- typeOf NodeSize
value <- typeOf Value
let args = [ (ptr node, "node"), (ptr (ptr node), "root")
, (nodeSize, "pos"), (ptr node, "predecessor")
, (ptr value, "key"), (ptr node, "new_node")
]
numberOfKeys <- numKeysAsOperand
insertInner <- function "eclair_btree_node_insert_inner" args void $
\[n, root, pos, predecessor, key, newNode] -> mdo
-- Need to allocate pos on the stack, otherwise pos updates are
-- not visible later on!
posPtr <- allocate nodeSize pos
numElems <- deref (metaOf ->> numElemsOf) n
needsRebalanceOrSplit <- numElems `uge` numberOfKeys
if' needsRebalanceOrSplit $ do
position' <- load posPtr 0
position'' <- sub position' =<< call rebalanceOrSplit [n, root, pos]
store posPtr 0 position''
numElems' <- deref (metaOf ->> numElemsOf) n -- NOTE: n might be updated in rebalanceOrSplit
needsInsertInNewNode <- position'' `ugt` numElems'
if' needsInsertInNewNode $ do
-- Insertion needs to be done in new sibling node:
pos''' <- sub position'' numElems' >>= flip sub (int16 1)
store posPtr 0 pos'''
parent <- ptrcast innerNode <$> deref (metaOf ->> parentOf) n
siblingPos <- add (int16 1) =<< deref (metaOf ->> posInParentOf) n
sibling <- deref (childAt siblingPos) parent
_ <- call insertInner [sibling, root, pos''', predecessor, key, newNode]
retVoid
-- Move bigger keys one forward
let iN = ptrcast innerNode n
numElems'' <- deref (metaOf ->> numElemsOf) n
startIdx <- sub numElems'' (int16 1)
pos' <- load posPtr 0
loopFor startIdx (`sge` pos') (`sub` int16 1) $ \i -> mdo
j <- add i (int16 1)
k <- add i (int16 2)
assign (valueAt j) n =<< deref (valueAt i) n
assign (childAt k) iN =<< deref (childAt j) iN
childK <- deref (childAt k) iN
increment int16 (metaOf ->> posInParentOf) childK
-- TODO: assert(i_n->children[pos] == predecessor);
-- Insert new element
assign (valueAt pos') n =<< load key 0
pos'' <- add pos' (int16 1)
assign (childAt pos'') iN newNode
assign (metaOf ->> parentOf) newNode n
assign (metaOf ->> posInParentOf) newNode pos''
increment int16 (metaOf ->> numElemsOf) n
pure insertInner
mkRebalanceOrSplit :: Operand -> ModuleCodegen Operand
mkRebalanceOrSplit splitFn = mdo
node <- typeOf Node
innerNode <- typeOf InnerNode
nodeSize <- typeOf NodeSize
numberOfKeys <- numKeysAsOperand
let args = [(ptr node, "node"), (ptr (ptr node), "root"), (nodeSize, "idx")]
function "eclair_btree_node_rebalance_or_split" args nodeSize $ \[n, root, idx] -> mdo
-- TODO assert(n->meta.num_elements == NUM_KEYS);
parent <- ptrcast innerNode <$> deref (metaOf ->> parentOf) n
pos <- deref (metaOf ->> posInParentOf) n
hasParent <- parent `ne` nullPtr node
posGTZero <- pos `ugt` int16 0
shouldRebalance <- and hasParent posGTZero
condBr shouldRebalance rebalance split
rebalance <- blockNamed "rebalance"
-- Option A) re-balance data
pos' <- sub pos (int16 1)
left <- deref (childAt pos') parent
-- Compute amount of elements movable to the left
leftSlotsOpen <- calculateLeftSlotsOpen numberOfKeys left idx
hasOpenLeftSlots <- leftSlotsOpen `ugt` int16 0
if' hasOpenLeftSlots $ do
splitPos <- deref (metaOf ->> posInParentOf) n >>= (`sub` int16 1)
splitter <- addr (baseOf ->> valueAt splitPos) parent
splitterValue <- load splitter 0
-- Move keys to left node
leftNumElems <- deref (metaOf ->> numElemsOf) left
assign (valueAt leftNumElems) left splitterValue
leftSlotsOpen' <- sub leftSlotsOpen (int16 1)
loopFor (int16 0) (`ult` leftSlotsOpen') (add (int16 1)) $ \i -> do
j <- add leftNumElems (int16 1) >>= add i
assign (valueAt j) left =<< deref (valueAt i) n
store splitter 0 =<< deref (valueAt leftSlotsOpen') n
-- Shift keys in this node to the left
numElemsN <- deref (metaOf ->> numElemsOf) n
idxEnd <- sub numElemsN leftSlotsOpen
loopFor (int16 0) (`ult` idxEnd) (add (int16 1)) $ \i -> do
j <- add i leftSlotsOpen
assign (valueAt i) n =<< deref (valueAt j) n
-- And children (if necessary)
isInnerNode <- deref (metaOf ->> nodeTypeOf) n >>= (`eq` innerNodeTypeVal)
if' isInnerNode $ do
let iN = ptrcast innerNode n
let iLeft = ptrcast innerNode left
-- Move children
loopFor (int16 0) (`ult` leftSlotsOpen) (add (int16 1)) $ \i -> do
leftNumElems' <- deref (metaOf ->> numElemsOf) left
leftPos <- add leftNumElems' (int16 1) >>= add i
assign (childAt leftPos) iLeft =<< deref (childAt i) iN
-- Update moved children
loopFor (int16 0) (`ult` leftSlotsOpen) (add (int16 1)) $ \i -> do
leftNumElems' <- deref (metaOf ->> numElemsOf) left
leftPos <- add leftNumElems' (int16 1) >>= add i
child <- deref (childAt i) iN
assign (metaOf ->> parentOf) child left
assign (metaOf ->> posInParentOf) child leftPos
-- Shift child pointer to the left
endIdx <- sub numElemsN leftSlotsOpen >>= add (int16 1)
loopFor (int16 0) (`ult` endIdx) (add (int16 1)) $ \i -> do
j <- add i leftSlotsOpen
assign (childAt i) iN =<< deref (childAt j) iN
-- Update position of children
child <- deref (childAt i) iN
assign (metaOf ->> posInParentOf) child i
-- Update node sizes
update (metaOf ->> numElemsOf) left (`add` leftSlotsOpen)
update (metaOf ->> numElemsOf) n (`sub` leftSlotsOpen)
ret leftSlotsOpen
br split
split <- blockNamed "split"
-- Option B) split
_ <- call splitFn [n, root]
ret (int16 0) -- No re-balancing
where
calculateLeftSlotsOpen numberOfKeys left' idx = do
numElems <- deref (metaOf ->> numElemsOf) left'
openSlots <- sub numberOfKeys numElems
isLessThan <- openSlots `slt` idx
select isLessThan openSlots idx
mkBtreeInsertValue :: Operand -> Operand -> Operand -> Operand -> Operand -> ModuleCodegen Operand
mkBtreeInsertValue nodeNew compareValues searchLowerBound searchUpperBound isEmptyTree = mdo
tree <- typeOf BTree
node <- typeOf Node
value <- typeOf Value
numberOfKeys <- numKeysAsOperand
splitPoint <- mkNodeSplitPoint
split <- mkSplit nodeNew splitPoint growParent
growParent <- mkGrowParent nodeNew insertInner
insertInner <- mkInsertInner rebalanceOrSplit
rebalanceOrSplit <- mkRebalanceOrSplit split
function "eclair_btree_insert_value" [(ptr tree, "tree"), (ptr value, "val")] i1 $ \[t, val] -> mdo
isEmpty <- call isEmptyTree [t]
condBr isEmpty emptyCase nonEmptyCase
emptyCase <- blockNamed "empty"
leaf <- call nodeNew [leafNodeTypeVal]
assign (metaOf ->> numElemsOf) leaf (int16 1)
assign (valueAt (int16 0)) leaf =<< load val 0
assign rootPtrOf t leaf
assign firstPtrOf t leaf
br inserted
nonEmptyCase <- blockNamed "non_empty"
-- Insert using iterative approach
currentPtr <- allocate (ptr node) =<< deref rootPtrOf t
loop $ mdo
loopBlock <- currentBlock
current <- load currentPtr 0
isInner <- deref (metaOf ->> nodeTypeOf) current >>= (`eq` innerNodeTypeVal)
condBr isInner inner leaf
inner <- blockNamed "inner"
insertInNonEmptyInnerNode loopBlock noInsert currentPtr current val
leaf <- blockNamed "leaf"
insertInNonEmptyLeafNode rebalanceOrSplit noInsert inserted t currentPtr current val numberOfKeys
noInsert <- blockNamed "no_insert"
ret (bit 0)
inserted <- blockNamed "inserted_new_value"
ret (bit 1)
where
insertInNonEmptyInnerNode loopBlock noInsert currentPtr current val = mdo
innerNode <- typeOf InnerNode
valSize <- asks (valueSize . typeSizes)
numElems <- deref (metaOf ->> numElemsOf) current
first <- addr (valueAt (int16 0)) current
last <- addr (valueAt numElems) current
pos <- call searchLowerBound [val, first, last]
idx <- pointerDiff i16 pos first >>= (`udiv` int32 (toInteger valSize))
notLast <- pos `ne` last
if' notLast $ do
alreadyInserted <- (int8 0 `eq`) =<< call compareValues [pos, val]
condBr alreadyInserted noInsert continueInsert
continueInsert <- blockNamed "inner_continue_insert"
let iCurrent = ptrcast innerNode current
store currentPtr 0 =<< deref (childAt idx) iCurrent
br loopBlock
insertInNonEmptyLeafNode rebalanceOrSplit noInsert inserted t currentPtr current val numberOfKeys = mdo
-- Rest is for leaf nodes
innerNode <- typeOf InnerNode
valSize <- asks (valueSize . typeSizes)
-- TODO: assert(current->meta.type == LEAF_NODE);
numElems <- deref (metaOf ->> numElemsOf) current
first <- addr (valueAt (int16 0)) current
last <- addr (valueAt numElems) current
pos <- call searchUpperBound [val, first, last]
distance <- pointerDiff i16 pos first >>= (`udiv` int32 (toInteger valSize))
idxPtr <- allocate i16 distance
notFirst <- pos `ne` first
if' notFirst $ do
valueAtPrevPos <- gep pos [int32 (-1)]
alreadyInserted <- (int8 0 `eq`) =<< call compareValues [valueAtPrevPos, val]
condBr alreadyInserted noInsert continueInsert
continueInsert <- blockNamed "leaf_continue_insert"
nodeIsFull <- numElems `uge` numberOfKeys
condBr nodeIsFull split noSplit
split <- blockNamed "split"
root <- addr rootPtrOf t
idx <- load idxPtr 0
res <- call rebalanceOrSplit [current, root, idx]
idx' <- sub idx res
store idxPtr 0 idx'
-- Insert in right fragment if needed
numElems' <- deref (metaOf ->> numElemsOf) current -- NOTE: numElems' modified after rebalanceOrSplit
shouldInsertRight <- idx' `ugt` numElems'
if' shouldInsertRight $ do
numElems'' <- add numElems' (int16 1)
idx'' <- sub idx' numElems''
store idxPtr 0 idx''
parent <- ptrcast innerNode <$> deref (metaOf ->> parentOf) current
nextPos <- deref (metaOf ->> posInParentOf) current >>= add (int16 1)
store currentPtr 0 =<< deref (childAt nextPos) parent
br noSplit
noSplit <- blockNamed "no_split"
-- No split -> move keys and insert new element
current' <- load currentPtr 0 -- NOTE: current might have changed in previous part
idx''' <- load idxPtr 0
numElems''' <- deref (metaOf ->> numElemsOf) current' -- NOTE: Might've been updated in the meantime
loopFor numElems''' (`ugt` idx''') (`sub` int16 1) $ \j -> do
-- TODO: memmove possible?
j' <- sub j (int16 1)
assign (valueAt j) current' =<< deref (valueAt j') current'
assign (valueAt idx''') current' =<< load val 0
update (metaOf ->> numElemsOf) current' (add (int16 1))
br inserted
mkBtreeInsertRangeTemplate :: Operand -> ModuleCodegen (Template IteratorParams Operand)
mkBtreeInsertRangeTemplate btreeInsertValue = do
-- Context of BTree template
tree <- typeOf BTree
pure $ do
-- Context of insert range template
iterParams <- getParams
let iterTy = ipTypeIter iterParams
args = [(ptr tree, "tree"), (ptr iterTy, "begin"), (ptr iterTy, "end")]
function "eclair_btree_insert_range" args void $ \[t, begin, end] -> do
let loopCondition = do
isEqual <- call (ipIterIsEqual iterParams) [begin, end]
not' isEqual
loopWhile loopCondition $ do
-- NOTE: Can directly insert value in other btree, same array type!
val <- call (ipIterCurrent iterParams) [begin]
_ <- call btreeInsertValue [t, val]
call (ipIterNext iterParams) [begin]
================================================
FILE: lib/Eclair/LLVM/BTree/Iterator.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.BTree.Iterator
( mkIteratorInit
, mkIteratorInitEnd
, mkIteratorIsEqual
, mkIteratorCurrent
, mkIteratorNext
, mkBtreeBegin
, mkBtreeEnd
) where
import Prelude hiding (void)
import Eclair.LLVM.BTree.Types
mkIteratorInit :: ModuleCodegen Operand
mkIteratorInit = do
iter <- typeOf Iterator
node <- typeOf Node
nodeSize <- typeOf NodeSize
let args = [(ptr iter, "iter"), (ptr node, "cur"), (nodeSize, "pos")]
function "eclair_btree_iterator_init" args void $ \[it, cur, pos] -> do
assign currentPtrOf it cur
assign valuePosOf it pos
mkIteratorInitEnd :: Operand -> ModuleCodegen Operand
mkIteratorInitEnd iterInit = do
iter <- typeOf Iterator
node <- typeOf Node
function "eclair_btree_iterator_end_init" [(ptr iter, "iter")] void $ \[it] -> do
_ <- call iterInit [it, nullPtr node, int16 0]
retVoid
mkIteratorIsEqual :: ModuleCodegen Operand
mkIteratorIsEqual = do
iter <- typeOf Iterator
function "eclair_btree_iterator_is_equal" [(ptr iter, "lhs"), (ptr iter, "rhs")] i1 $ \[lhs, rhs] -> mdo
currentLhs <- deref currentPtrOf lhs
currentRhs <- deref currentPtrOf rhs
isDifferentPtrs <- currentLhs `ne` currentRhs
if' isDifferentPtrs $
ret (bit 0)
valuePosLhs <- deref valuePosOf lhs
valuePosRhs <- deref valuePosOf rhs
ret =<< valuePosLhs `eq` valuePosRhs
mkIteratorCurrent :: ModuleCodegen Operand
mkIteratorCurrent = do
iter <- typeOf Iterator
value <- typeOf Value
function "eclair_btree_iterator_current" [(ptr iter, "iter")] (ptr value) $ \[it] -> mdo
valuePos <- deref valuePosOf it
currentNode <- deref currentPtrOf it
ret =<< addr (valueAt valuePos) currentNode
mkIteratorNext :: ModuleCodegen Operand
mkIteratorNext = do
iter <- typeOf Iterator
function "eclair_btree_iterator_next" [(ptr iter, "iter")] void $ \[it] -> mdo
current <- deref currentPtrOf it
isInner <- deref (metaOf ->> nodeTypeOf) current >>= (`eq` innerNodeTypeVal)
if' isInner $ do
innerIterNext leafNextBlock it
retVoid
leafNextBlock <- leafIterNext it
pass
where
leafIterNext iter = mdo
leafNextBlock <- blockNamed "leaf.next"
node <- typeOf Node
-- Case 1: Still elements left to iterate -> increment position
increment int16 valuePosOf iter
valuePos <- deref valuePosOf iter
current <- deref currentPtrOf iter
numElems <- deref (metaOf ->> numElemsOf) current
hasNextInLeaf <- valuePos `ult` numElems
if' hasNextInLeaf
retVoid
-- Case 2: at right-most element -> go to next inner node
let loopCondition = mdo
isNull <- deref currentPtrOf iter >>= (`eq` nullPtr node)
condBr isNull nullBlock notNullBlock
nullBlock <- blockNamed "leaf.no_parent"
br endLoopCondition
notNullBlock <- blockNamed "leaf.has_parent"
pos' <- deref valuePosOf iter
current' <- deref currentPtrOf iter
numElems' <- deref (metaOf ->> numElemsOf) current'
atEnd <- pos' `eq` numElems'
br endLoopCondition
endLoopCondition <- blockNamed "loop.condition.end"
phi [(bit 0, nullBlock), (atEnd, notNullBlock)]
loopWhile loopCondition $ do
current' <- deref currentPtrOf iter
assign valuePosOf iter =<< deref (metaOf ->> posInParentOf) current'
assign currentPtrOf iter =<< deref (metaOf ->> parentOf) current'
pure leafNextBlock
innerIterNext leafNext iter = mdo
node <- typeOf Node
innerNode <- typeOf InnerNode
-- Case 3: Go to left most child in inner node (a leaf node)
nextPos <- deref valuePosOf iter >>= add (int16 1)
iCurrent <- ptrcast innerNode <$> deref currentPtrOf iter
currentPtr <- allocate (ptr node) =<< deref (childAt nextPos) iCurrent
let loopCondition' = do
ty <- deref (metaOf ->> nodeTypeOf) =<< load currentPtr 0
ty `eq` innerNodeTypeVal
loopWhile loopCondition' $ do
iCurrent' <- ptrcast innerNode <$> load currentPtr 0
firstChild <- deref (childAt (int16 0)) iCurrent'
store currentPtr 0 firstChild
currentLeaf <- load currentPtr 0
assign currentPtrOf iter currentLeaf
assign valuePosOf iter (int16 0)
-- Leaf nodes may be empty due to biased insertion => go to next
isNotEmpty <- deref (metaOf ->> numElemsOf) currentLeaf >>= (`ne` int16 0)
if' isNotEmpty $ do
retVoid
br leafNext
mkBtreeBegin :: ModuleCodegen Operand
mkBtreeBegin = do
tree <- typeOf BTree
iter <- typeOf Iterator
function "eclair_btree_begin" [(ptr tree, "tree"), (ptr iter, "result")] void $ \[t, result] -> do
assign currentPtrOf result =<< deref firstPtrOf t
assign valuePosOf result (int16 0)
mkBtreeEnd :: Operand -> ModuleCodegen Operand
mkBtreeEnd iteratorInitEnd = do
tree <- typeOf BTree
iter <- typeOf Iterator
function "eclair_btree_end" [(ptr tree, "tree"), (ptr iter, "result")] void $ \[_t, result] -> do
_ <- call iteratorInitEnd [result]
pass
================================================
FILE: lib/Eclair/LLVM/BTree/Size.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.BTree.Size
( mkNodeCountEntries
, mkBtreeIsEmpty
, mkBtreeSize
) where
import Prelude hiding (void)
import Eclair.LLVM.BTree.Types
mkNodeCountEntries :: ModuleCodegen Operand
mkNodeCountEntries = mdo
node <- typeOf Node
countEntries <- function "eclair_btree_node_count_entries" [(ptr node, "node")] i64 $ \[n] -> mdo
numElements <- deref (metaOf ->> numElemsOf) n
ty <- deref (metaOf ->> nodeTypeOf) n
isLeaf <- ty `eq` leafNodeTypeVal
numElements' <- zext numElements i64
if' isLeaf $
ret numElements'
count <- loopChildren n i64 numElements' $ \entryCount child -> mdo
childNodeCount <- call countEntries [child]
add entryCount childNodeCount
ret count
pure countEntries
where
loopChildren n ty beginValue f = mdo
innerNode <- typeOf InnerNode
let inner = ptrcast innerNode n
result <- allocate ty beginValue
numElements <- deref (metaOf ->> numElemsOf) n
loopFor (int16 0) (`ule` numElements) (add (int16 1)) $ \i -> mdo
currentResult <- load result 0
child <- deref (childAt i) inner
updatedResult <- f currentResult child
store result 0 updatedResult
load result 0
mkBtreeIsEmpty :: ModuleCodegen Operand
mkBtreeIsEmpty = do
tree <- typeOf BTree
node <- typeOf Node
function "eclair_btree_is_empty" [(ptr tree, "tree")] i1 $ \[t] -> do
root <- deref rootPtrOf t
ret =<< root `eq` nullPtr node
mkBtreeSize :: Operand -> ModuleCodegen Operand
mkBtreeSize nodeCountEntries = do
tree <- typeOf BTree
node <- typeOf Node
function "eclair_btree_size" [(ptr tree, "tree")] i64 $ \[t] -> mdo
root <- deref rootPtrOf t
isNull <- root `eq` nullPtr node
condBr isNull nullBlock notNullBlock
nullBlock <- blockNamed "null"
ret (int64 0)
notNullBlock <- blockNamed "not_null"
count <- call nodeCountEntries [root]
ret count
================================================
FILE: lib/Eclair/LLVM/BTree/Types.hs
================================================
module Eclair.LLVM.BTree.Types
( Meta(..)
, Types(..)
, SearchIndex
, SearchType(..)
, Sizes(..)
, CGState(..)
, IRCodegen
, ModuleCodegen
, Index(..)
, metaOf
, valuesOf
, valueAt
, parentOf
, posInParentOf
, numElemsOf
, nodeTypeOf
, baseOf
, childrenOf
, childAt
, currentPtrOf
, valuePosOf
, rootPtrOf
, firstPtrOf
, DataType(..)
, typeOf
, allocateIter
, memset
, leafNodeTypeVal
, innerNodeTypeVal
, numKeysAsOperand
, numKeysHelper
, numKeys
, module Eclair.LLVM.Externals
, module Eclair.LLVM.Codegen
) where
import Eclair.LLVM.Codegen
import Eclair.LLVM.Hash
import Eclair.LLVM.Externals
import Prettyprinter
data Meta
= Meta
{ numColumns :: Int -- Amount of columns each node has
, index :: SearchIndex -- Which columns are used to index values
, blockSize :: Word64 -- Number of bytes per btree node
, searchType :: SearchType -- Search strategy used in a single node
}
deriving stock (Eq, Ord, Show)
deriving stock Generic
deriving ToHash via HashWithPrefix "btree" Meta
instance Pretty Meta where
pretty meta =
"num_columns=" <> pretty (numColumns meta) <> comma <+>
-- TODO: use "withCommas"
"index=" <> brackets (Prelude.fold $ intersperse comma $ map pretty (index meta)) <> comma <+>
"block_size=" <> pretty (blockSize meta) <> comma <+>
"search_type=" <> pretty (searchType meta)
type Column = Int
type SearchIndex = [Column]
data SearchType = Linear | Binary
deriving stock (Eq, Ord, Show)
deriving stock (Generic, Enum)
instance ToHash SearchType where
getHash = \case
Linear -> getHash ("linear" :: Text)
Binary -> getHash ("binary" :: Text)
instance Pretty SearchType where
pretty Linear = "linear"
pretty Binary = "binary"
data Types
= Types
{ btreeTy :: Type
, iteratorTy :: Type
, nodeSizeTy :: Type
, nodeTypeTy :: Type
, nodeTy :: Type
, leafNodeTy :: Type
, innerNodeTy :: Type
, valueTy :: Type
, columnTy :: Type
}
data Sizes
= Sizes
{ pointerSize :: Word64
, valueSize :: Word64
, nodeDataSize :: Word64
, leafNodeSize :: Word64
, innerNodeSize :: Word64
}
-- State used during rest of the btree codegen
data CGState
= CGState
{ types :: Types
, typeSizes :: Sizes
, externals :: Externals
}
type IRCodegen = IRBuilderT ModuleCodegen
type ModuleCodegen = ReaderT CGState (Template Meta)
data Index
= NodeIdx
| InnerNodeIdx
| MetaIdx
| ValueIdx
| PositionIdx
| NumElemsIdx
| NodeTypeIdx
| IteratorIdx
| TreeIdx
| ArrayOf Index
| PtrOf Index
metaOf :: Path 'NodeIdx 'MetaIdx
metaOf = mkPath [int32 0]
valuesOf :: Path 'NodeIdx ('ArrayOf 'ValueIdx)
valuesOf = mkPath [int32 1]
valueAt :: Operand -> Path 'NodeIdx 'ValueIdx
valueAt idx = mkPath [int32 1, idx]
parentOf :: Path 'MetaIdx 'NodeIdx
parentOf = mkPath [int32 0]
posInParentOf :: Path 'MetaIdx 'PositionIdx
posInParentOf = mkPath [int32 1]
numElemsOf :: Path 'MetaIdx 'NumElemsIdx
numElemsOf = mkPath [int32 2]
nodeTypeOf :: Path 'MetaIdx 'NodeTypeIdx
nodeTypeOf = mkPath [int32 3]
baseOf :: Path 'InnerNodeIdx 'NodeIdx
baseOf = mkPath [int32 0]
childrenOf :: Path 'InnerNodeIdx ('ArrayOf 'NodeIdx)
childrenOf = mkPath [int32 1]
childAt :: Operand -> Path 'InnerNodeIdx ('PtrOf 'NodeIdx)
childAt idx = mkPath [int32 1, idx]
currentPtrOf :: Path 'IteratorIdx ('PtrOf 'NodeIdx)
currentPtrOf = mkPath [int32 0]
valuePosOf :: Path 'IteratorIdx 'PositionIdx
valuePosOf = mkPath [int32 1]
rootPtrOf :: Path 'TreeIdx ('PtrOf 'NodeIdx)
rootPtrOf = mkPath [int32 0]
firstPtrOf :: Path 'TreeIdx ('PtrOf 'NodeIdx)
firstPtrOf = mkPath [int32 1]
data DataType
= NodeType
| Node
| InnerNode
| Value
| NodeSize
| Iterator
| BTree
typeOf :: MonadReader CGState m => DataType -> m Type
typeOf dt =
let getType = case dt of
Node -> nodeTy
NodeType -> nodeTypeTy
InnerNode -> innerNodeTy
Value -> valueTy
NodeSize -> nodeSizeTy
Iterator -> iteratorTy
BTree -> btreeTy
in getType <$> asks types
memset :: Operand -> Word8 -> Word64 -> IRCodegen ()
memset p val byteCount = do
memsetFn <- asks (extMemset . externals)
let p' = ptrcast i8 p
_ <- call memsetFn [ p'
, int8 $ fromIntegral val
, int64 (fromIntegral byteCount)
, bit 0
]
pass
leafNodeTypeVal, innerNodeTypeVal :: Operand
leafNodeTypeVal = bit 0
innerNodeTypeVal = bit 1
numKeys :: Meta -> Sizes -> Word64
numKeys settings sizes =
numKeysHelper settings nodeMetaSize valueByteSize
where
nodeMetaSize = nodeDataSize sizes
valueByteSize = valueSize sizes
-- NOTE: Where possible, use the more userfriendly numKeys function
numKeysHelper :: Meta -> Word64 -> Word64 -> Word64
numKeysHelper settings nodeMetaSize valueByteSize =
max 3 desiredNumberOfKeys
where
blockByteSize = blockSize settings
valuesByteSize =
if blockByteSize > nodeMetaSize
then blockByteSize - nodeMetaSize
else 0
desiredNumberOfKeys = valuesByteSize `div` valueByteSize
numKeysAsOperand :: ModuleCodegen Operand
numKeysAsOperand = do
metadata <- getParams
sizes <- asks typeSizes
pure $ int16 $ toInteger $ numKeys metadata sizes
-- NOTE: this only allocates on stack, but doesn't initialize it,
-- this still needs to happen in rest of the code
allocateIter :: IRCodegen Operand
allocateIter = do
iter <- typeOf Iterator
alloca iter (Just (int32 1)) 0
================================================
FILE: lib/Eclair/LLVM/BTree.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
module Eclair.LLVM.BTree
( Meta(..)
, SearchIndex
, SearchType(..)
, codegen
) where
import Prelude hiding (void, swap)
import Control.Monad.Morph
import Eclair.LLVM.Codegen
import Eclair.LLVM.Table
import Eclair.LLVM.BTree.Types
import Eclair.LLVM.BTree.Create
import Eclair.LLVM.BTree.Destroy
import Eclair.LLVM.BTree.Compare
import Eclair.LLVM.BTree.Iterator
import Eclair.LLVM.BTree.Insert
import Eclair.LLVM.BTree.Find
import Eclair.LLVM.BTree.Bounds
import Eclair.LLVM.BTree.Size
codegen :: Externals -> ConfigT (TemplateT Meta IO) Table
codegen exts = do
sizes <- computeSizes
lift $ hoist intoIO $ do
tys <- generateTypes sizes
runReaderT generateTableFunctions $ CGState tys sizes exts
where intoIO = pure . runIdentity
computeSizes :: ConfigT (TemplateT Meta IO) Sizes
computeSizes = do
(ctx, td) <- (cfgLLVMContext &&& cfgTargetData) <$> getConfig
settings <- getParams
let nodeDataTy = StructureType Off
[ -- Next type doesn't matter here, but we need to break the
-- cyclic loop or Haskell will throw an exception.
ptrTy -- parent
, i16 -- position_in_parent
, i16 -- num_elements
, i1 -- node type
]
ptrTy = ptr i8
valueType = ArrayType (fromIntegral $ numColumns settings) i32
(ptrSz, valueSz, nodeDataSz) <- withLLVMTypeInfo ctx $ do
let sizeOf = llvmSizeOf ctx td
pointerSize' <- sizeOf ptrTy
valueSize' <- sizeOf valueType
nodeDataSize' <- sizeOf nodeDataTy
pure (pointerSize', valueSize', nodeDataSize')
let numKeys' = fromIntegral $ numKeysHelper settings nodeDataSz valueSz
nodeType = StructureType Off [nodeDataTy, ArrayType numKeys' valueType]
innerNodeType = StructureType Off [nodeType, ArrayType (numKeys' + 1) (ptr nodeType)]
(leafNodeSz, innerNodeSz) <- withLLVMTypeInfo ctx $ do
let sizeOf = llvmSizeOf ctx td
leafNodeSize' <- sizeOf nodeType
innerNodeSize' <- sizeOf innerNodeType
pure (leafNodeSize', innerNodeSize')
pure $ Sizes ptrSz valueSz nodeDataSz leafNodeSz innerNodeSz
generateTypes :: (MonadModuleBuilder m, MonadFix m, MonadTemplate Meta m, HasSuffix m)
=> Sizes -> m Types
generateTypes sizes = mdo
meta <- getParams
let numKeys' = fromIntegral $ numKeys meta sizes
let columnTy' = i32
valueTy' = ArrayType (fromIntegral $ numColumns meta) columnTy'
positionTy = i16
nodeSizeTy' = i16 -- Note: used to be size_t/i64
nodeTypeTy' = i1
nodeDataName = "node_data_t"
nodeDataTy <- typedef nodeDataName Off
[ ptr nodeTy -- parent
, positionTy -- position_in_parent
, nodeSizeTy' -- num_elements
, nodeTypeTy' -- node type
]
nodeTy <- typedef "node_t" Off
[ nodeDataTy -- meta
, ArrayType numKeys' valueTy' -- values
]
let leafNodeTy' = nodeTy
innerNodeTy <- typedef "inner_node_t" Off
[ nodeTy -- base
, ArrayType (numKeys' + 1) (ptr nodeTy) -- children
]
btreeIteratorTy <- typedef "btree_iterator_t" Off
[ ptr nodeTy -- current
, positionTy -- value pos
]
btreeTy <- typedef "btree_t" Off
[ ptr nodeTy -- root
, ptr nodeTy -- first
]
pure $ Types
{ btreeTy = btreeTy
, iteratorTy = btreeIteratorTy
, nodeSizeTy = nodeSizeTy'
, nodeTypeTy = nodeTypeTy'
, nodeTy = nodeTy
, leafNodeTy = leafNodeTy'
, innerNodeTy = innerNodeTy
, valueTy = valueTy'
, columnTy = columnTy'
}
generateTableFunctions :: ModuleCodegen Table
generateTableFunctions = mdo
tree <- typeOf BTree
iter <- typeOf Iterator
value <- typeOf Value
compareValues <- mkCompare
nodeNew <- mkNodeNew
nodeCountEntries <- mkNodeCountEntries
iterInit <- mkIteratorInit
iterInitEnd <- mkIteratorInitEnd iterInit
iterIsEqual <- mkIteratorIsEqual
iterCurrent <- mkIteratorCurrent
iterNext <- mkIteratorNext
searchLowerBound <- mkLinearSearchLowerBound compareValues
searchUpperBound <- mkLinearSearchUpperBound compareValues
btreeInitEmpty <- mkBtreeInitEmpty
btreeInit <- mkBtreeInit btreeInsertRange
btreeDestroy <- mkBtreeDestroy btreeClear
isEmptyTree <- mkBtreeIsEmpty
btreeSize <- mkBtreeSize nodeCountEntries
btreeInsert <- mkBtreeInsertValue nodeNew compareValues searchLowerBound searchUpperBound isEmptyTree
btreeInsertRangeTemplate <- mkBtreeInsertRangeTemplate btreeInsert
-- We need to instantiate it atleast once for use in the BTree itself.
let iterParams = IteratorParams
{ ipIterCurrent = iterCurrent
, ipIterNext = iterNext
, ipIterIsEqual = iterIsEqual
, ipTypeIter = iter
}
btreeInsertRange <- lift $ partialInstantiate iterParams btreeInsertRangeTemplate
btreeBegin <- mkBtreeBegin
btreeEnd <- mkBtreeEnd iterInitEnd
btreeContains <- mkBtreeContains iterIsEqual btreeFind btreeEnd
btreeFind <- mkBtreeFind isEmptyTree searchLowerBound compareValues iterInit iterInitEnd
btreeLowerBound <- mkBtreeLowerBound isEmptyTree iterInit iterInitEnd searchLowerBound compareValues
btreeUpperBound <- mkBtreeUpperBound isEmptyTree iterInit iterInitEnd searchUpperBound
btreeClear <- mkBtreeClear
btreeSwap <- mkBtreeSwap
pure Table
{ fnInit = btreeInit
, fnInitEmpty = btreeInitEmpty
, fnDestroy = btreeDestroy
, fnPurge = btreeClear
, fnSwap = btreeSwap
, fnBegin = btreeBegin
, fnEnd = btreeEnd
, fnInsert = btreeInsert
, fnInsertRangeTemplate = btreeInsertRangeTemplate
, fnIsEmpty = isEmptyTree
, fnSize = btreeSize
, fnLowerBound = btreeLowerBound
, fnUpperBound = btreeUpperBound
, fnContains = btreeContains
, fnIterIsEqual = iterIsEqual
, fnIterCurrent = iterCurrent
, fnIterNext = iterNext
, typeObj = tree
, typeIter = iter
, typeValue = value
}
================================================
FILE: lib/Eclair/LLVM/Codegen.hs
================================================
{-# LANGUAGE RoleAnnotations, PolyKinds #-}
module Eclair.LLVM.Codegen
( module Eclair.LLVM.Codegen
, module Eclair.LLVM.Template
, module Eclair.LLVM.Config
, module LLVM.Codegen
) where
import qualified Data.Map as M
import Foreign.ForeignPtr
import Foreign.Ptr hiding (nullPtr)
import Eclair.LLVM.Template
import LLVM.Codegen hiding (function, typedef, typeOf)
import qualified LLVM.C.API as LibLLVM
import Eclair.LLVM.Config
llvmSizeOf :: (MonadModuleBuilder m, MonadIO m)
=> ForeignPtr LibLLVM.Context -> Ptr LibLLVM.TargetData -> Type -> m Word64
llvmSizeOf ctx td ty = liftIO $ do
ty' <- encodeType ctx ty
LibLLVM.sizeOfType td ty'
withLLVMTypeInfo :: (MonadModuleBuilder m, MonadIO m)
=> ForeignPtr LibLLVM.Context -> m a -> m a
withLLVMTypeInfo ctx m = do
-- First, we forward declare all struct types known up to this point,
typedefs <- getTypedefs
structTys <- liftIO $ M.traverseWithKey (forwardDeclareStruct ctx) typedefs
-- Then we serialize all types (including structs, with their bodies),
_ <- liftIO $ traverse (serialize ctx) structTys
-- Finally, we can call the function with all type info available in LLVM.
m
where
forwardDeclareStruct ctx' name structTy =
(,structTy) <$> LibLLVM.mkOpaqueStructType ctx' name
serialize :: ForeignPtr LibLLVM.Context -> (Ptr LibLLVM.Type, Type) -> IO ()
serialize ctx' (llvmTy, ty) = case ty of
StructureType packed tys -> do
tys' <- traverse (encodeType ctx') tys
LibLLVM.setNamedStructBody llvmTy tys' packed
_ ->
panic $ "Unexpected typedef: only structs are allowed, but got: " <> show ty
-- NOTE: this only works if all the named structs are known beforehand (a.k.a. forward declared)!
encodeType :: ForeignPtr LibLLVM.Context -> Type -> IO (Ptr LibLLVM.Type)
encodeType ctx = go
where
go = \case
VoidType ->
LibLLVM.mkVoidType ctx
IntType bits ->
LibLLVM.mkIntType ctx bits
PointerType ty ->
LibLLVM.mkPointerType =<< go ty
StructureType packed tys -> do
tys' <- traverse go tys
LibLLVM.mkAnonStructType ctx tys' packed
ArrayType count ty -> do
ty' <- go ty
LibLLVM.mkArrayType ty' count
FunctionType retTy argTys -> do
retTy' <- go retTy
argTys' <- traverse go argTys
LibLLVM.mkFunctionType retTy' argTys'
NamedTypeReference name ->
LibLLVM.getTypeByName ctx name
================================================
FILE: lib/Eclair/LLVM/Config.hs
================================================
module Eclair.LLVM.Config
( Config(..)
, ConfigT
, runConfigT
, MonadConfig(..)
) where
import qualified LLVM.C.API as LibLLVM
import LLVM.Codegen
import Control.Monad.Morph
import Foreign.ForeignPtr
import Foreign.Ptr
import Eclair.Common.Config (Target)
-- This is a helper module for carrying around specific information
-- when compiling to a specific LLVM platform.
data Config
= Config
{ cfgTargetTriple :: Maybe Target
, cfgLLVMContext :: ForeignPtr LibLLVM.Context
, cfgTargetData :: Ptr LibLLVM.TargetData
}
-- TODO: automatically wrap ModuleBuilderT and call it CompileT?
newtype ConfigT m a
= ConfigT
{ unConfigT :: ReaderT Config m a
} deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadModuleBuilder)
via ReaderT Config m
deriving MonadTrans via ReaderT Config
instance MFunctor ConfigT where
hoist f =
ConfigT . hoist f . unConfigT
runConfigT :: Config -> ConfigT m a -> m a
runConfigT cfg m =
runReaderT (unConfigT m) cfg
class Monad m => MonadConfig m where
getConfig :: m Config
instance Monad m => MonadConfig (ConfigT m) where
getConfig =
ConfigT ask
-- TODO other instances
================================================
FILE: lib/Eclair/LLVM/Externals.hs
================================================
module Eclair.LLVM.Externals
( Externals(..)
) where
import Eclair.LLVM.Codegen (Operand)
-- Functions that are defined outside of LLVM.
data Externals
= Externals
{ extMalloc :: Operand
, extFree :: Operand
, extMemset :: Operand
, extMemcpy :: Operand
, extMemcmp :: Operand
, extMmap :: Operand
, extMunmap :: Operand
}
================================================
FILE: lib/Eclair/LLVM/Hash.hs
================================================
{-# LANGUAGE TypeApplications, UndecidableInstances, TypeOperators, DefaultSignatures #-}
module Eclair.LLVM.Hash
( Hash
, unHash
, HashEnum(..)
, HashWithPrefix(..)
, HashOnly(..)
, ToHash(..)
) where
import qualified Data.Text as T
newtype Hash = Hash { unHash :: T.Text }
instance Semigroup Hash where
Hash h1 <> Hash h2 =
Hash $ h1 <> "__" <> h2
newtype HashEnum a = HashEnum a
newtype HashWithPrefix (prefix :: Symbol) a
= HashWithPrefix a
newtype HashOnly (ty :: Symbol) a = HashOnly a
class ToHash a where
getHash :: a -> Hash
default getHash :: (Generic a, GToHash (Rep a)) => a -> Hash
getHash a = gGetHash (from a)
instance ToHash T.Text where
getHash = Hash
instance ToHash Int where
getHash = Hash . show
instance ToHash Word64 where
getHash = Hash . show
instance ToHash a => ToHash [a] where
getHash = getFoldableHash
instance ToHash a => ToHash (NonEmpty a) where
getHash = getFoldableHash
instance ToHash a => ToHash (Set a) where
getHash = getFoldableHash
getFoldableHash :: (Foldable f, ToHash a) => f a -> Hash
getFoldableHash =
Hash . mconcat . intersperse "_" . map (unHash . getHash) . toList
instance (Enum a) => ToHash (HashEnum a) where
getHash (HashEnum a) = getHash $ fromEnum a
instance forall prefix a. (KnownSymbol prefix, Generic a, GToHash (Rep a))
=> ToHash (HashWithPrefix prefix a) where
getHash (HashWithPrefix a) =
let pre = Hash $ toText $ symbolVal (Proxy :: Proxy prefix)
h = gGetHash (from a)
in pre <> h
instance (HasField ty a b, ToHash b) => ToHash (HashOnly ty a) where
getHash (HashOnly a) =
getHash $ getField @ty a
class GToHash f where
gGetHash :: f a -> Hash
instance ToHash a => GToHash (K1 i a) where
gGetHash (K1 x) = getHash x
instance GToHash U1 where
gGetHash U1 = Hash "0"
instance GToHash a => GToHash (M1 i c a) where
gGetHash (M1 x) = gGetHash x
instance (GToHash f, GToHash g) => GToHash (f :*: g) where
gGetHash (a :*: b) =
gGetHash a <> gGetHash b
================================================
FILE: lib/Eclair/LLVM/HashMap.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.HashMap
( HashMap(..)
, Types(..)
, codegen
) where
import Prelude hiding (void, HashMap)
import Control.Monad.Morph
import Eclair.LLVM.Codegen
import Eclair.LLVM.Externals
import qualified Eclair.LLVM.Symbol as Symbol
import qualified Eclair.LLVM.Vector as Vector
-- NOTE: this is a really naive hashmap (no growing / re-hashing yet),
-- should be replaced by something more sophisticated, like:
-- https://github.com/souffle-lang/souffle/blob/d1522e06c6e99c259951dc348689a77fa5f5c932/src/include/souffle/datastructure/ConcurrentInsertOnlyHashMap.h
data Types
= Types
{ tyHashMap :: Type
, tyKey :: Type
, tyValue :: Type
, tyEntry :: Type -- struct containing key + value type
}
data HashMap
= HashMap
{ hashMapTypes :: Types
, hashMapInit :: Operand
, hashMapDestroy :: Operand
, hashMapGetOrPutValue :: Operand
, hashMapLookup :: Operand
, hashMapContains :: Operand
}
data CGState
= CGState
{ types :: Types
, symbolCodegen :: Symbol.Symbol
, vectorCodegen :: Vector.Vector
}
type ModuleCodegen = ReaderT CGState ModuleBuilder
type IRCodegen = IRBuilderT ModuleCodegen
-- NOTE: no need to turn into template (for now)
codegen :: Symbol.Symbol -> Externals -> ConfigT (ModuleBuilderT IO) HashMap
codegen symbol exts = do
let keyTy = Symbol.tySymbol symbol
valueTy = i32
entryTy <- typedef "entry_t" Off [keyTy, valueTy]
vec <- hoist (instantiate "entry" entryTy) $ Vector.codegen exts Nothing
lift $ do
let vecTy = Vector.tyVector $ Vector.vectorTypes vec
hashMapTy <- typedef "hashmap_t" Off [ArrayType capacity vecTy]
let tys = Types
{ tyHashMap = hashMapTy
, tyKey = keyTy
, tyValue = valueTy
, tyEntry = entryTy
}
hoist intoIO $ runReaderT generateFunctions $ CGState tys symbol vec
where
intoIO = pure . runIdentity
-- TODO make this variable sized
capacity :: Word32
capacity = 64
generateFunctions :: ModuleCodegen HashMap
generateFunctions = do
tys <- asks types
hmHash <- mkHash
hmInit <- mkHashMapInit
hmDestroy <- mkHashMapDestroy
hmGetOrPutValue <- mkHashMapGetOrPutValue hmHash
hmLookup <- mkHashMapLookup hmHash
hmContains <- mkHashMapContains hmHash
pure $ HashMap
{ hashMapTypes = tys
, hashMapInit = hmInit
, hashMapDestroy = hmDestroy
, hashMapGetOrPutValue = hmGetOrPutValue
, hashMapLookup = hmLookup
, hashMapContains = hmContains
}
mkHash :: ModuleCodegen Operand
mkHash = do
symbolTy <- symbolType
let hashTy = i32
-- TODO better hash function?
function "eclair_symbol_hash" [(ptr symbolTy, "symbol")] hashTy $ \[symbol] -> do
hashPtr <- allocate hashTy (int32 0)
symbolSize <- deref Symbol.sizeOf symbol
dataPtr <- deref Symbol.dataOf symbol
loopFor (int32 0) (`ult` symbolSize) (add (int32 1)) $ \i -> do
-- We need a raw gep here, since the data is dynamically allocated.
bytePtr <- gep dataPtr [i]
byte <- load bytePtr 0 >>= (`zext` i32)
currentHashCode <- load hashPtr 0
result1 <- mul (int32 31) currentHashCode
result2 <- add byte result1
store hashPtr 0 result2
hashCode <- load hashPtr 0
ret =<< modulo hashCode capacity
mkHashMapInit :: ModuleCodegen Operand
mkHashMapInit = do
(hmTy, vec) <- asks (tyHashMap . types &&& vectorCodegen)
function "eclair_hashmap_init" [(ptr hmTy, "hashmap")] void $ \[hm] -> do
loopBuckets hm $ \bucketPtr -> do
call (Vector.vectorInit vec) [bucketPtr]
mkHashMapDestroy :: ModuleCodegen Operand
mkHashMapDestroy = do
(hmTy, vec) <- asks (tyHashMap . types &&& vectorCodegen)
function "eclair_hashmap_destroy" [(ptr hmTy, "hashmap")] void $ \[hm] -> do
loopBuckets hm $ \bucketPtr -> do
call (Vector.vectorDestroy vec) [bucketPtr]
mkHashMapGetOrPutValue :: Operand -> ModuleCodegen Operand
mkHashMapGetOrPutValue hashFn = do
(hmTy, entryTy) <- asks ((tyHashMap &&& tyEntry) . types)
symbolTy <- asks (Symbol.tySymbol . symbolCodegen)
vec <- asks vectorCodegen
let args = [(ptr hmTy, "hashmap"), (ptr symbolTy, "symbol"), (i32, "value")]
function "eclair_hashmap_get_or_put_value" args i32 $ \[hm, symbolPtr, value] -> do
bucketPtr <- bucketForHash hashFn hm symbolPtr
loopEntriesInBucket symbolPtr bucketPtr $
ret <=< deref valueOf
symbolValue <- load symbolPtr 0
newEntryPtr <- alloca entryTy Nothing 0
assign symbolOf newEntryPtr symbolValue
assign valueOf newEntryPtr value
_ <- call (Vector.vectorPush vec) [bucketPtr, newEntryPtr]
ret value
-- NOTE: this is a unsafe lookup, assumes element is in there!
-- NOTE: the index 0xFFFFFFFF is assumed to mean: not found.
-- This should be a safe assumption as long as there are less keys than this in the hashmap
mkHashMapLookup :: Operand -> ModuleCodegen Operand
mkHashMapLookup hashFn = do
(hmTy, symbolTy) <- asks (tyHashMap . types &&& Symbol.tySymbol . symbolCodegen)
let args = [(ptr hmTy, "hashmap"), (ptr symbolTy, "symbol")]
function "eclair_hashmap_lookup" args i32 $ \[hm, symbolPtr] -> do
bucketPtr <- bucketForHash hashFn hm symbolPtr
loopEntriesInBucket symbolPtr bucketPtr $
ret <=< deref valueOf
ret $ int32 0xFFFFFFFF
mkHashMapContains :: Operand -> ModuleCodegen Operand
mkHashMapContains hashFn = do
(hmTy, symbolTy) <- asks (tyHashMap . types &&& Symbol.tySymbol . symbolCodegen)
let args = [(ptr hmTy, "hashmap"), (ptr symbolTy, "symbol")]
function "eclair_hashmap_contains" args i1 $ \[hm, symbolPtr] -> do
bucketPtr <- bucketForHash hashFn hm symbolPtr
loopEntriesInBucket symbolPtr bucketPtr $
const $ ret (bit 1)
ret $ bit 0
bucketForHash :: Operand -> Operand -> Operand -> IRCodegen Operand
bucketForHash hashFn hm symbolPtr = do
h <- call hashFn [symbolPtr]
idx <- modulo h capacity
addr (bucketAt idx) hm
loopEntriesInBucket :: Operand -> Operand -> (Operand -> IRCodegen a) -> IRCodegen ()
loopEntriesInBucket symbolPtr bucketPtr instrsForMatch = do
(vec, symbol) <- asks (vectorCodegen &&& symbolCodegen)
entryCount <- call (Vector.vectorSize vec) [bucketPtr]
loopFor (int32 0) (`ult` entryCount) (add (int32 1)) $ \i -> do
entryPtr <- call (Vector.vectorGetValue vec) [bucketPtr, i]
entrySymbolPtr <- addr symbolOf entryPtr
isMatch <- call (Symbol.symbolIsEqual symbol) [entrySymbolPtr, symbolPtr]
if' isMatch $
instrsForMatch entryPtr
-- Helpers
-- NOTE: this assumes capacity is a power of 2!
-- TODO: add proper modulo instruction to llvm-codegen
modulo :: Operand -> Word32 -> IRCodegen Operand
modulo value divisor =
value `and` int32 (toInteger divisor - 1)
loopBuckets :: Operand -> (Operand -> IRCodegen a) -> IRCodegen ()
loopBuckets hm f = do
let currentCapacity = int32 $ toInteger capacity
loopFor (int32 0) (`ult` currentCapacity) (add (int32 1)) $ \i -> do
bucketPtr <- addr (bucketAt i) hm
f bucketPtr
symbolType :: ModuleCodegen Type
symbolType =
asks (Symbol.tySymbol . symbolCodegen)
data Index
= HashMapIdx
| BucketIdx -- A vector inside the hashmap
| EntryIdx
| SymbolIdx
| ValueIdx
bucketAt :: Operand -> Path 'HashMapIdx 'BucketIdx
bucketAt idx = mkPath [int32 0, idx]
symbolOf :: Path 'EntryIdx 'SymbolIdx
symbolOf = mkPath [int32 0]
valueOf :: Path 'EntryIdx 'ValueIdx
valueOf = mkPath [int32 1]
================================================
FILE: lib/Eclair/LLVM/Metadata.hs
================================================
module Eclair.LLVM.Metadata
( Metadata(..)
, mkMeta
, getIndex
, getNumColumns
) where
import Eclair.RA.IndexSelection (Index(..))
import Eclair.TypeSystem
import Eclair.LLVM.Hash
import qualified Eclair.LLVM.BTree as BTree
import Prettyprinter
newtype Metadata
= BTree BTree.Meta
deriving (Eq, Ord, Show)
deriving ToHash via BTree.Meta
-- TODO: support other datastructures (Trie, ...)
instance Pretty Metadata where
pretty (BTree meta) = "btree" <> parens (pretty meta)
mkMeta :: Index -> [Type] -> Metadata
mkMeta (Index columns) ts =
-- TODO: choose datastructure based on index/types
BTree $ BTree.Meta
{ BTree.numColumns = length ts
, BTree.index = columns
, BTree.blockSize = 256
, BTree.searchType = BTree.Linear
}
getIndex :: Metadata -> Index
getIndex = \case
BTree meta ->
Index $ BTree.index meta
getNumColumns :: Metadata -> Int
getNumColumns = \case
BTree meta ->
BTree.numColumns meta
================================================
FILE: lib/Eclair/LLVM/Symbol.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.Symbol
( Symbol(..)
, codegen
, sizeOf
, dataOf
) where
import Prelude hiding (Symbol, void)
import Eclair.LLVM.Codegen
import Eclair.LLVM.Externals
data Symbol
= Symbol
{ tySymbol :: Type -- A symbol (string). Assumes UTF-8 encoding.
, symbolInit :: Operand
, symbolDestroy :: Operand
, symbolIsEqual :: Operand
}
data CGState
= CGState
{ externals :: Externals
, tySym :: Type
}
type ModuleCodegen = ReaderT CGState ModuleBuilder
codegen :: Externals -> ModuleBuilder Symbol
codegen exts = do
symbolTy <- generateTypes
runReaderT generateFunctions $ CGState exts symbolTy
generateTypes :: ModuleBuilder Type
generateTypes =
-- For now, only up to 4GB of strings are supported.
-- TODO consider strings with i8 and i16 as size also
typedef "symbol_t" On [i32, ptr i8]
generateFunctions :: ModuleCodegen Symbol
generateFunctions = do
symbolTy <- asks tySym
symInit <- mkSymbolInit
symDestroy <- mkSymbolDestroy
symIsEqual <- mkSymbolIsEqual
pure $ Symbol
{ tySymbol = symbolTy
, symbolInit = symInit
, symbolDestroy = symDestroy
, symbolIsEqual = symIsEqual
}
-- NOTE: this copies data to the new struct, and assumes memory has already been
-- allocated for the symbol. Don't pass a const char* / ptr i8 that point to
-- static memory because it will be freed during cleanup.
mkSymbolInit :: ModuleCodegen Operand
mkSymbolInit = do
symbolTy <- asks tySym
let args = [(ptr symbolTy, "symbol"), (i32, "size"), (ptr i8, "data")]
function "eclair_symbol_init" args void $ \[symbol, size, utf8Data] -> do
-- assert(symbol && "symbol cannot be NULL!");
-- assert(utf8Data && "data cannot be NULL!");
assign sizeOf symbol size
assign dataOf symbol utf8Data
-- NOTE: this only destroys the memory this symbol is pointing to.
mkSymbolDestroy :: ModuleCodegen Operand
mkSymbolDestroy = do
(symbolTy, freeFn) <- asks (tySym &&& extFree . externals)
let args = [(ptr symbolTy, "symbol")]
function "eclair_symbol_destroy" args void $ \[symbol] -> do
-- assert(symbol && "symbol cannot be NULL!");
dataPtr <- deref dataOf symbol
call freeFn [dataPtr]
mkSymbolIsEqual :: ModuleCodegen Operand
mkSymbolIsEqual = do
(symbolTy, memcmpFn) <- asks (tySym &&& extMemcmp . externals)
let args = [(ptr symbolTy, "symbol1"), (ptr symbolTy, "symbol2")]
function "eclair_symbol_is_equal" args i1 $ \[symbol1, symbol2] -> do
-- assert(symbol1 && "symbol1 cannot be NULL!");
-- assert(symbol2 && "symbol2 cannot be NULL!");
size1 <- deref sizeOf symbol1
size2 <- deref sizeOf symbol2
isNotEqualSize <- size1 `ne` size2
if' isNotEqualSize $
ret $ bit 0
data1 <- deref dataOf symbol1
data2 <- deref dataOf symbol2
size1' <- zext size1 i64
result <- call memcmpFn [data1, data2, size1']
ret =<< result `eq` bit 0
data Index
= SymbolIdx
| SizeIdx
| DataIdx
sizeOf :: Path 'SymbolIdx 'SizeIdx
sizeOf = mkPath [int32 0]
dataOf :: Path 'SymbolIdx 'DataIdx
dataOf = mkPath [int32 1]
================================================
FILE: lib/Eclair/LLVM/SymbolTable.hs
================================================
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.SymbolTable
( SymbolTable(..)
, codegen
) where
import Prelude hiding (void)
import LLVM.Codegen
import qualified Eclair.LLVM.Vector as Vector
import qualified Eclair.LLVM.HashMap as HashMap
data SymbolTable
= SymbolTable
{ tySymbolTable :: Type
, symbolTableInit :: Operand
, symbolTableDestroy :: Operand
, symbolTableFindOrInsert :: Operand
, symbolTableContainsIndex :: Operand
, symbolTableContainsSymbol :: Operand
, symbolTableLookupIndex :: Operand
, symbolTableLookupSymbol :: Operand
}
data CGState
= CGState
{ symbolTableTy :: Type
, symbolTy :: Type
, vectorCodegen :: Vector.Vector
, hashMapCodegen :: HashMap.HashMap
}
type ModuleCodegen = ReaderT CGState ModuleBuilder
codegen :: Type -> Vector.Vector -> HashMap.HashMap -> ModuleBuilder SymbolTable
codegen symbolTy' vec hm = do
let vecTy = Vector.tyVector $ Vector.vectorTypes vec
hmTy = HashMap.tyHashMap $ HashMap.hashMapTypes hm
ty <- typedef "symbol_table" Off [ vecTy -- maps indexes (i32) to symbols
, hmTy -- maps symbols to indexes
]
runReaderT generateFunctions $ CGState ty symbolTy' vec hm
generateFunctions :: ModuleCodegen SymbolTable
generateFunctions = do
ty <- asks symbolTableTy
stInit <- mkSymbolTableInit
stDestroy <- mkSymbolTableDestroy
stFindOrInsert <- mkSymbolTableFindOrInsert
stContainsIndex <- mkSymbolTableContainsIndex
stContainsSymbol <- mkSymbolTableContainsSymbol
stLookupIndex <- mkSymbolTableLookupIndex
stLookupSymbol <- mkSymbolTableLookupSymbol
pure $ SymbolTable
{ tySymbolTable = ty
, symbolTableInit = stInit
, symbolTableDestroy = stDestroy
, symbolTableFindOrInsert = stFindOrInsert
, symbolTableContainsIndex = stContainsIndex
, symbolTableContainsSymbol = stContainsSymbol
, symbolTableLookupIndex = stLookupIndex
, symbolTableLookupSymbol = stLookupSymbol
}
mkSymbolTableInit :: ModuleCodegen Operand
mkSymbolTableInit = do
CGState ty _ vec hm <- ask
function "eclair_symbol_table_init" [(ptr ty, "table")] void $ \[symTab] -> do
-- assert(table && "symbol table cannot be NULL!");
vecPtr <- addr vecOf symTab
hmPtr <- addr hashMapOf symTab
_ <- call (Vector.vectorInit vec) [vecPtr]
_ <- call (HashMap.hashMapInit hm) [hmPtr]
pass
mkSymbolTableDestroy :: ModuleCodegen Operand
mkSymbolTableDestroy = do
CGState ty _ vec hm <- ask
function "eclair_symbol_table_destroy" [(ptr ty, "table")] void $ \[symTab] -> do
-- assert(table && "symbol table cannot be NULL!");
vecPtr <- addr vecOf symTab
hmPtr <- addr hashMapOf symTab
_ <- call (Vector.vectorDestroy vec) [vecPtr]
_ <- call (HashMap.hashMapDestroy hm) [hmPtr]
pass
mkSymbolTableFindOrInsert :: ModuleCodegen Operand
mkSymbolTableFindOrInsert = do
CGState ty symbolTy' vec hm <- ask
let args = [(ptr ty, "table"), (ptr symbolTy', "symbol")]
function "eclair_symbol_table_find_or_insert" args i32 $ \[symTabPtr, symbolPtr] -> do
-- assert(table && "symbol table cannot be NULL!");
vecPtr <- addr vecOf symTabPtr
hmPtr <- addr hashMapOf symTabPtr
count <- call (Vector.vectorSize vec) [vecPtr]
value <- call (HashMap.hashMapGetOrPutValue hm) [hmPtr, symbolPtr, count]
isInsertOfNewValue <- count `eq` value
if' isInsertOfNewValue $ do
-- New value is being inserted, so we need to update mapping in other direction.
call (Vector.vectorPush vec) [vecPtr, symbolPtr]
ret value
mkSymbolTableContainsIndex :: ModuleCodegen Operand
mkSymbolTableContainsIndex = do
CGState ty _ vec _ <- ask
let args = [(ptr ty, "table"), (i32, "index")]
function "eclair_symbol_table_contains_index" args i1 $ \[symTabPtr, idx] -> do
-- assert(table && "symbol table cannot be NULL!");
vecPtr <- addr vecOf symTabPtr
size <- call (Vector.vectorSize vec) [vecPtr]
ret =<< idx `ult` size
mkSymbolTableContainsSymbol :: ModuleCodegen Operand
mkSymbolTableContainsSymbol = do
CGState ty symbolTy' _ hm <- ask
let args = [(ptr ty, "table"), (ptr symbolTy', "symbol")]
function "eclair_symbol_table_contains_symbol" args i1 $ \[symTabPtr, symbolPtr] -> do
hmPtr <- addr hashMapOf symTabPtr
ret =<< call (HashMap.hashMapContains hm) [hmPtr, symbolPtr]
mkSymbolTableLookupIndex :: ModuleCodegen Operand
mkSymbolTableLookupIndex = do
CGState ty symbolTy' _ hm <- ask
let args = [(ptr ty, "table"), (ptr symbolTy', "symbol")]
function "eclair_symbol_table_lookup_index" args i32 $ \[symTabPtr, symbolPtr] -> do
hmPtr <- addr hashMapOf symTabPtr
ret =<< call (HashMap.hashMapLookup hm) [hmPtr, symbolPtr]
mkSymbolTableLookupSymbol :: ModuleCodegen Operand
mkSymbolTableLookupSymbol = do
CGState ty symbolTy' vec _ <- ask
let args = [(ptr ty, "table"), (i32, "index")]
function "eclair_symbol_table_lookup_symbol" args (ptr symbolTy') $ \[symTabPtr, idx] -> do
-- assert(symbol_table_contains_index(table, index));
vecPtr <- addr vecOf symTabPtr
ret =<< call (Vector.vectorGetValue vec) [vecPtr, idx]
-- Helpers
data Index
= SymbolTableIdx
| VecIdx
| HashMapIdx
vecOf :: Path 'SymbolTableIdx 'VecIdx
vecOf = mkPath [int32 0]
hashMapOf :: Path 'SymbolTableIdx 'HashMapIdx
hashMapOf = mkPath [int32 1]
================================================
FILE: lib/Eclair/LLVM/Table.hs
================================================
module Eclair.LLVM.Table
( Table(..)
, IteratorParams(..)
) where
import Eclair.LLVM.Codegen (Operand, Type, Template)
-- A data type used as template params for 'fnInsertRange' defined below.
data IteratorParams
= IteratorParams
{ ipIterCurrent :: Operand
, ipIterNext :: Operand
, ipIterIsEqual :: Operand
, ipTypeIter :: Type
}
-- A data type representing all functionality of a Datalog table / container.
-- This is similar to a vtable in C++, except here everything is guaranteed to be inlined
-- because of specialization. Each of the operands refers to a different LLVM function.
-- The types are also "exported" because they are used in other parts of the code.
data Table
= Table
{ fnInit :: Operand
, fnInitEmpty :: Operand
, fnDestroy :: Operand
, fnPurge :: Operand
, fnSwap :: Operand
, fnBegin :: Operand
, fnEnd :: Operand
, fnIsEmpty :: Operand
, fnSize :: Operand
, fnLowerBound :: Operand
, fnUpperBound :: Operand
, fnContains :: Operand
, fnInsert :: Operand
, fnInsertRangeTemplate :: Template IteratorParams Operand
, fnIterIsEqual :: Operand
, fnIterCurrent :: Operand
, fnIterNext :: Operand
, typeObj :: Type
, typeIter :: Type
, typeValue :: Type
}
================================================
FILE: lib/Eclair/LLVM/Template.hs
================================================
{-# LANGUAGE UndecidableInstances, FunctionalDependencies #-}
module Eclair.LLVM.Template
( TemplateT
, Template
, HasSuffix(..)
, MonadTemplate(..)
, Suffix
, cmapParams
, instantiate
, partialInstantiate
, function
, typedef
) where
import Control.Monad.Morph
import LLVM.Codegen hiding (function, typedef)
import qualified LLVM.Codegen as CG
import qualified Control.Monad.State.Lazy as LazyState
import qualified Control.Monad.State.Strict as StrictState
import qualified Control.Monad.RWS.Lazy as LazyRWS
import qualified Control.Monad.RWS.Strict as StrictRWS
import Eclair.LLVM.Config
type Suffix = Text
-- | A MTL-like monad transformer that allows generating code in a way similar to C++ templates.
-- Instead of complicated machinery in the compiler, this transformer just adds a suffix to all generated functions and types.
-- It is up to the programmer to make sure all provided suffixes to one template are unique!
-- The type variable 'p' is short for "template parameters" and can be used to tweak (specialize) the code generation.
-- The type variable 'm' allows running this stack in a pure context, or in a stack on top of IO.
newtype TemplateT p m a
= TemplateT
{ unTemplateT :: ReaderT (Suffix, p) (ModuleBuilderT m) a
} deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadError e, MonadState s, MonadModuleBuilder)
via ReaderT (Suffix, p) (ModuleBuilderT m)
type Template p = TemplateT p Identity
instance MFunctor (TemplateT p) where
hoist nat = TemplateT . hoist (hoist nat) . unTemplateT
instance MonadReader r m => MonadReader r (TemplateT p m) where
ask = lift ask
local f (TemplateT m) =
TemplateT $ hoist (local f) m
class HasSuffix m where
getSuffix :: m Suffix
instance Monad m => HasSuffix (TemplateT p m) where
getSuffix = TemplateT $ asks (("_" <>) . fst)
-- The following instance makes 'function' behave the same as in llvm-codegen
instance Monad m => HasSuffix (ModuleBuilderT m) where
getSuffix = pure mempty
-- This allows getting the suffix inside a function body with llvm-codegen
instance (Monad m, HasSuffix m) => HasSuffix (IRBuilderT m) where
getSuffix = lift getSuffix
-- MTL boilerplate:
instance (Monad m, HasSuffix m) => HasSuffix (ReaderT r m) where
getSuffix = lift getSuffix
instance (Monad m, HasSuffix m, Monoid w) => HasSuffix (WriterT w m) where
getSuffix = lift getSuffix
instance (Monad m, HasSuffix m) => HasSuffix (LazyState.StateT w m) where
getSuffix = lift getSuffix
instance (Monad m, HasSuffix m) => HasSuffix (StrictState.StateT w m) where
getSuffix = lift getSuffix
instance (Monad m, HasSuffix m, Monoid w) => HasSuffix (LazyRWS.RWST r w s m) where
getSuffix = lift getSuffix
instance (Monad m, HasSuffix m, Monoid w) => HasSuffix (StrictRWS.RWST r w s m) where
getSuffix = lift getSuffix
instance (Monad m, HasSuffix m) => HasSuffix (ExceptT e m) where
getSuffix = lift getSuffix
instance (Monad m, HasSuffix m) => HasSuffix (ConfigT m) where
getSuffix = lift getSuffix
class MonadTemplate p m | m -> p where
getParams :: m p
instance Monad m => MonadTemplate p (TemplateT p m) where
getParams = TemplateT $ asks snd
instance (Monad m, MonadTemplate p m) => MonadTemplate p (ReaderT r m) where
getParams = lift getParams
instance (Monad m, MonadTemplate p m, Monoid w) => MonadTemplate p (WriterT w m) where
getParams = lift getParams
instance (Monad m, MonadTemplate p m, Monoid w) => MonadTemplate p (LazyState.StateT w m) where
getParams = lift getParams
instance (Monad m, MonadTemplate p m, Monoid w) => MonadTemplate p (StrictState.StateT w m) where
getParams = lift getParams
instance (Monad m, MonadTemplate p m, Monoid w) => MonadTemplate p (LazyRWS.RWST r w s m) where
getParams = lift getParams
instance (Monad m, MonadTemplate p m, Monoid w) => MonadTemplate p (StrictRWS.RWST r w s m) where
getParams = lift getParams
instance (Monad m, MonadTemplate p m) => MonadTemplate p (ExceptT e m) where
getParams = lift getParams
-- This allows getting the params inside a function body with llvm-codegen
instance (Monad m, MonadTemplate p m) => MonadTemplate p (IRBuilderT m) where
getParams = lift getParams
instance (Monad m, MonadTemplate p m) => MonadTemplate p (ConfigT m) where
getParams = lift getParams
instance MonadTrans (TemplateT p) where
lift m =
TemplateT $ ReaderT $ const $ lift m
-- "contramap" over the template params.
-- Useful if you only need access to part of the template data
-- and/or types of the params don't match.
cmapParams :: (p2 -> p1) -> TemplateT p1 m a -> TemplateT p2 m a
cmapParams f (TemplateT m) =
TemplateT $ flip withReaderT m $ second f
-- This instantiates a template, given a template name suffix and some template parameters.
-- The result is the underlying ModuleBuilerT which generates specialized code based on the parameters.
instantiate :: Suffix -> p -> TemplateT p m a -> ModuleBuilderT m a
instantiate suffix p (TemplateT t) =
runReaderT t (suffix, p)
-- This instantiates a template and wraps it into another template.
-- Useful for templated member functions on a templated object.
partialInstantiate :: Monad m => p1 -> TemplateT p1 m a -> TemplateT p2 m a
partialInstantiate p t = do
suffix <- getSuffix
embedIntoTemplate $ instantiate suffix p t
where
-- This embeds a plain ModuleBuilderT action into a template.
-- This action has no access to the actual template params from this point onwards.
embedIntoTemplate :: ModuleBuilderT m a -> TemplateT p m a
embedIntoTemplate m = TemplateT $ ReaderT $ const m
-- The next functions replace the corresponding functions defined in llvm-codegen.
-- The functions automatically add a suffix if needed, to guarantee unique function names.
-- In the actual codegen, you will still need to call 'getParams' to get access to the params,
-- to do the actual specialization based on them.
function :: (MonadModuleBuilder m, HasSuffix m)
=> Name -> [(Type, ParameterName)] -> Type -> ([Operand] -> IRBuilderT m a) -> m Operand
function (unName -> name) args retTy body = do
suffix <- getSuffix
let nameWithSuffix = Name $ name <> suffix
CG.function nameWithSuffix args retTy body
typedef :: (MonadModuleBuilder m, HasSuffix m)
=> Name -> Flag Packed -> [Type] -> m Type
typedef (unName -> name) packedFlag tys = do
suffix <- getSuffix
let nameWithSuffix = Name $ name <> suffix
CG.typedef nameWithSuffix packedFlag tys
================================================
FILE: lib/Eclair/LLVM/Vector.hs
================================================
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Eclair.LLVM.Vector
( Vector(..)
, Types(..)
, Destructor
, codegen
, startPtrOf
) where
import Prelude hiding (EQ, void)
import Control.Monad.Morph
import Eclair.LLVM.Codegen
import Eclair.LLVM.Externals
data Types
= Types
{ tyIndex :: Type
, tyElement :: Type
, tyVector :: Type
}
data Vector
= Vector
{ vectorTypes :: Types
, vectorInit :: Operand
, vectorDestroy :: Operand
, vectorPush :: Operand
, vectorSize :: Operand
, vectorGetValue :: Operand
}
-- Type representing what to do when an element of the vector is destroyed.
-- The operand is a pointer to an element type that needs to be cleaned up.
type Destructor = Operand -> IRCodegen ()
data CGState
= CGState
{ externals :: Externals
, types :: Types
, sizeElement :: Word64
, destructor :: Maybe Destructor
}
type VectorParams = Type
type ModuleCodegen = ReaderT CGState (Template VectorParams)
type IRCodegen = IRBuilderT ModuleCodegen
codegen :: Externals -> Maybe Destructor -> ConfigT (TemplateT VectorParams IO) Vector
codegen exts dtor = do
tyElem <- getParams
(ctx, td) <- (cfgLLVMContext &&& cfgTargetData) <$> getConfig
sizeOfElem <- withLLVMTypeInfo ctx $ llvmSizeOf ctx td tyElem
hoist (hoist intoIO) $ lift $ do
tys <- generateTypes
runReaderT generateFunctions $ CGState exts tys sizeOfElem dtor
where
intoIO = pure . runIdentity
generateTypes :: Template VectorParams Types
generateTypes = do
tyElem <- getParams
tyVec <- typedef "vector_t" Off
[ ptr tyElem -- pointer to start of the vector
, ptr tyElem -- pointer to one element past end of the vector
, i32 -- capacity: how many elements can fit inside the vector
]
pure $ Types
{ tyIndex = i32
, tyElement = tyElem
, tyVector = tyVec
}
generateFunctions :: ModuleCodegen Vector
generateFunctions = do
tys <- asks types
vInit <- mkVectorInit
vDestroy <- mkVectorDestroy
vSize <- mkVectorSize
vPush <- mkVectorPush vSize
vGetValue <- mkVectorGetValue
pure $ Vector
{ vectorTypes = tys
, vectorInit = vInit
, vectorDestroy = vDestroy
, vectorPush = vPush
, vectorSize = vSize
, vectorGetValue = vGetValue
}
initialCapacity :: Int
initialCapacity = 16 -- or 0?
growFactor :: Int
growFactor = 2 -- or 1.5? needs rounding then..
-- NOTE: Assumes vector memory already allocated in other code
mkVectorInit :: ModuleCodegen Operand
mkVectorInit = do
CGState exts tys sizeOfElem _ <- ask
let (vecTy, elemTy) = (tyVector &&& tyElement) tys
mallocFn = extMalloc exts
function "eclair_vector_init" [(ptr vecTy, "vec")] void $ \[vec] -> do
-- assert(vec && "Vector should not be null");
let numBytes = int32 . toInteger $ sizeOfElem * fromIntegral initialCapacity
memoryPtr <- ptrcast elemTy <$> call mallocFn [numBytes]
-- assert(memory && "Failed to allocate memory!");
assign startPtrOf vec memoryPtr
assign endPtrOf vec memoryPtr
assign capacityOf vec (int32 $ fromIntegral initialCapacity)
-- NOTE: Assumes vector memory already allocated in other code
mkVectorDestroy :: ModuleCodegen Operand
mkVectorDestroy = do
CGState exts tys _ elemDestructor <- ask
let (vecTy, elemTy) = (tyVector &&& tyElement) tys
freeFn = extFree exts
function "eclair_vector_destroy" [(ptr vecTy, "vec")] void $ \[vec] -> do
-- assert(vec && "Vector should not be null");
for_ elemDestructor $ \destructor' -> do
iterPtrPtr <- allocate (ptr elemTy) =<< deref startPtrOf vec
let hasNext = do
iterPtr <- load iterPtrPtr 0
endPtr <- deref endPtrOf vec
iterPtr `ne` endPtr
loopWhile hasNext $ do
iterPtr <- load iterPtrPtr 0
destructor' iterPtr
store iterPtrPtr 0 =<< incrementPtr iterPtr
startPtr <- ptrcast i8 <$> deref startPtrOf vec
call freeFn [startPtr]
-- NOTE: Returns the index at which the element was inserted => no size necessary
-- NOTE: does not check for uniqueness!
mkVectorPush :: Operand -> ModuleCodegen Operand
mkVectorPush vectorSize' = do
CGState exts tys sizeElem _ <- ask
let (vecTy, elemTy) = (tyVector &&& tyElement) tys
mallocFn = extMalloc exts
freeFn = extFree exts
memcpyFn = extMemcpy exts
sizeOfElem = int32 $ toInteger sizeElem
vectorGrow <- function "eclair_vector_grow" [(ptr vecTy, "vec")] void $ \[vec] -> do
-- NOTE: size == capacity in this function
-- assert(vec && "Vector should not be null");
currentCapacity <- deref capacityOf vec
currentNumBytes <- mul currentCapacity sizeOfElem >>= (`zext` i64)
newCapacity <- mul currentCapacity (int32 $ toInteger growFactor)
newNumBytes <- mul newCapacity sizeOfElem
newMemoryPtr <- ptrcast elemTy <$> call mallocFn [newNumBytes]
-- assert(new_memory && "Failed to allocate more memory for vector!");
newMemoryEndPtr <- gep newMemoryPtr [currentCapacity]
startPtr <- ptrcast i8 <$> deref startPtrOf vec
let newMemoryPtrBytes = ptrcast i8 newMemoryPtr
_ <- call memcpyFn [newMemoryPtrBytes, startPtr, currentNumBytes, bit 0]
_ <- call freeFn [startPtr]
assign startPtrOf vec newMemoryPtr
assign endPtrOf vec newMemoryEndPtr
assign capacityOf vec newCapacity
function "eclair_vector_push" [(ptr vecTy, "vec"), (ptr elemTy, "elem")] i32 $ \[vec, elem'] -> do
-- assert(vec && "Vector should not be null");
numElems <- call vectorSize' [vec]
capacity <- deref capacityOf vec
isFull <- numElems `eq` capacity
if' isFull $ do
call vectorGrow [vec]
-- Look up vec->end again, pointers can be invalidated due to potential resize!
endPtr <- deref endPtrOf vec
store endPtr 0 =<< load elem' 0
update endPtrOf vec incrementPtr
ret numElems
mkVectorSize :: ModuleCodegen Operand
mkVectorSize = do
CGState _ tys sizeElem _ <- ask
let vecTy = tyVector tys
sizeOfElem = int32 $ toInteger sizeElem
function "eclair_vector_size" [(ptr vecTy, "vec")] i32 $ \[vec] -> do
-- assert(vec && "Vector should not be null");
startPtr <- deref startPtrOf vec
endPtr <- deref endPtrOf vec
byteDiff <- pointerDiff i32 endPtr startPtr
ret =<< udiv byteDiff sizeOfElem
mkVectorGetValue :: ModuleCodegen Operand
mkVectorGetValue = do
(vecTy, elemTy) <- asks ((tyVector &&& tyElement) . types)
function "eclair_vector_get_value" [(ptr vecTy, "vec"), (i32, "idx")] (ptr elemTy) $ \[vec, idx] -> do
startPtr <- deref startPtrOf vec
-- We need a raw gep here, since this is a dynamically allocated pointer that we need to offset.
ret =<< gep startPtr [idx]
-- Helper functions:
incrementPtr :: Operand -> IRCodegen Operand
incrementPtr = (`gep` [int32 1])
data Index
= VectorIdx
| StartPtrIdx
| EndPtrIdx
| CapacityIdx
startPtrOf :: Path 'VectorIdx 'StartPtrIdx
startPtrOf = mkPath [int32 0]
endPtrOf :: Path 'VectorIdx 'EndPtrIdx
endPtrOf = mkPath [int32 1]
capacityOf :: Path 'VectorIdx 'CapacityIdx
capacityOf = mkPath [int32 2]
================================================
FILE: lib/Eclair/LSP/Handlers/Diagnostics.hs
================================================
module Eclair.LSP.Handlers.Diagnostics
( diagnosticsHandler
, DiagnosticSource(..)
, Severity(..)
, Diagnostic(..)
, DiagnosticsResult(..)
) where
import Eclair
import Eclair.LSP.Monad
import Eclair.Common.Location
import Eclair.Error
data DiagnosticSource
= Parser
| Typesystem
| SemanticAnalysis
| Transpiler
deriving (Eq, Show)
data Severity
= Error -- (for now Eclair only has errors)
deriving (Eq, Show)
data Diagnostic
= Diagnostic DiagnosticSource SourceSpan Severity Text
deriving (Eq, Show)
data DiagnosticsResult
= DiagnosticsOk [Diagnostic]
| DiagnosticsError FilePath (Maybe SourcePos) Text
deriving (Eq, Show)
diagnosticsHandler :: FilePath -> LspM DiagnosticsResult
diagnosticsHandler path = do
params <- getParams
mFileContents <- lift $ vfsLookupFile path
case mFileContents of
Nothing ->
pure $ DiagnosticsError path Nothing "File not found in VFS!"
Just _fileContents -> do
errs <- liftLSP $ emitDiagnostics params path
diagnostics <- mconcat <$> traverse errorToDiagnostics errs
pure $ DiagnosticsOk diagnostics
where
errorToDiagnostics :: EclairError -> LspM [Diagnostic]
errorToDiagnostics err = do
vfsVar <- lift getVfsVar
vfs <- liftIO $ readMVar vfsVar
let readSourceFile = unsafeReadFromVFS vfs
source = diagnosticSource err
issues <- liftLSP $ errorToIssues readSourceFile err
traverse (toDiagnostic source) issues
toDiagnostic source issue = do
let msg = renderIssueMessage issue
srcSpan = locationToSourceSpan $ issueLocation issue
pure $ Diagnostic source srcSpan Error msg
diagnosticSource :: EclairError -> DiagnosticSource
diagnosticSource = \case
ParseErr {} -> Parser
TypeErr {} -> Typesystem
SemanticErr {} -> SemanticAnalysis
ConversionErr {} -> Transpiler
================================================
FILE: lib/Eclair/LSP/Handlers/DocumentHighlight.hs
================================================
module Eclair.LSP.Handlers.DocumentHighlight
( documentHighlightHandler
, DocHLResult(..)
) where
import Eclair
import Eclair.AST.IR
import Eclair.Common.Location
import Eclair.LSP.Monad
data DocHLResult
= DocHLOk [SourceSpan]
| DocHLError FilePath SourcePos Text
deriving (Eq, Show)
documentHighlightHandler :: FilePath -> SourcePos -> LspM DocHLResult
documentHighlightHandler path srcPos = do
mFileContents <- lift $ vfsLookupFile path
case mFileContents of
Nothing ->
pure $ DocHLError path srcPos "File not found in VFS!"
Just fileContents ->
case posToOffset srcPos fileContents of
Left err ->
pure $ DocHLError path srcPos err
Right fileOffset -> do
params <- getParams
parseResult <- liftLSP $ runExceptT $ do
(ast, spanMap) <- ExceptT (parse params path)
let mNodeId = lookupNodeId spanMap fileOffset
(ast, spanMap,) <$> liftEither (maybeToRight [] mNodeId)
processParseResult fileContents parseResult
where
processParseResult fileContents = \case
Left _errs ->
pure $ DocHLError path srcPos "Failed to get highlight information!"
Right (ast, spanMap, nodeId) -> do
let refs = findReferences ast nodeId
highlights = getHighlights path fileContents spanMap refs
pure $ DocHLOk highlights
getHighlights file fileContent spanMap =
map (\refNodeId ->
let span' = lookupSpan spanMap refNodeId
sourceSpan = spanToSourceSpan file fileContent span'
in sourceSpan)
-- TODO make this a build task
-- TODO implement for concepts besides variables
findReferences :: AST -> NodeId -> [NodeId]
findReferences ast nodeId =
fst <$> zygo getVarId getRefs ast
where
getVarId = \case
PWildcardF {} ->
-- Wildcard matches with nothing.
mempty
VarF varNodeId var | nodeId == varNodeId ->
First (Just var)
astf ->
fold astf
getRefs = \case
ModuleF _ decls ->
foldMap snd $ filter (isJust . getFirst . fst) decls
RuleF _ _ args clauses -> do
let subtrees = args <> clauses
in case getFirst $ foldMap fst subtrees of
Nothing -> mempty
Just var ->
filter ((== var) . snd) $ foldMap snd subtrees
VarF varNodeId var ->
[(varNodeId, var)]
astf ->
foldMap snd astf
================================================
FILE: lib/Eclair/LSP/Handlers/Hover.hs
================================================
module Eclair.LSP.Handlers.Hover
( hoverHandler
, HoverResult(..)
) where
import Eclair
import Eclair.Error
import Eclair.TypeSystem hiding (typeCheck)
import Eclair.Common.Location
import Eclair.LSP.Monad
import qualified Data.Map as M
data HoverResult
= HoverOk SourceSpan Type
| HoverError FilePath SourcePos Text
deriving (Eq, Show)
hoverHandler :: FilePath -> SourcePos -> LspM HoverResult
hoverHandler path srcPos = do
mFileContents <- lift $ vfsLookupFile path
case mFileContents of
Nothing ->
pure $ HoverError path srcPos "File not found in VFS!"
Just fileContents ->
case posToOffset srcPos fileContents of
Left err ->
pure $ HoverError path srcPos err
Right fileOffset -> do
processHoverOffset fileContents fileOffset
where
processHoverOffset fileContents fileOffset = do
params <- getParams
tcResult <- runExceptT $ do
(ast, spanMap) <- ExceptT (liftLSP $ parse params path)
(ast, spanMap,) <$> ExceptT (liftLSP $ typeCheck params path)
case tcResult of
Left errs ->
processErrors errs
Right (_, spanMap, typeInfo) ->
processTypeInfo fileContents fileOffset spanMap typeInfo
processTypeInfo fileContents fileOffset spanMap typeInfo = do
let maybeResult = do
nodeId <- lookupNodeId spanMap fileOffset
ty <- M.lookup nodeId (resolvedTypes typeInfo)
pure (nodeId, ty)
case maybeResult of
Nothing ->
pure $ HoverError path srcPos "No type information for this position!"
Just (nodeId, ty) -> do
let span' = lookupSpan spanMap nodeId
srcSpan = spanToSourceSpan path fileContents span'
pure $ HoverOk srcSpan ty
processErrors errs = do
vfsVar <- lift getVfsVar
vfs <- liftIO $ readMVar vfsVar
issues <- traverse (liftLSP . errorToIssues (unsafeReadFromVFS vfs)) errs
case findIssueAtPosition issues of
Nothing ->
pure $ HoverError path srcPos "File contains errors!"
Just issue -> do
let msg = renderIssueMessage issue
pure $ HoverError path srcPos msg
findIssueAtPosition issues =
flip find (concat issues) $ \i ->
let loc = issueLocation i
startPos' = posToSourcePos $ locationStart loc
endPos' = posToSourcePos $ locationEnd loc
in startPos' <= srcPos && srcPos <= endPos'
================================================
FILE: lib/Eclair/LSP/Handlers.hs
================================================
module Eclair.LSP.Handlers
( module Eclair.LSP.Handlers.Hover
, module Eclair.LSP.Handlers.Diagnostics
, module Eclair.LSP.Handlers.DocumentHighlight
) where
import Eclair.LSP.Handlers.Hover
import Eclair.LSP.Handlers.Diagnostics
import Eclair.LSP.Handlers.DocumentHighlight
================================================
FILE: lib/Eclair/LSP/JSON.hs
================================================
module Eclair.LSP.JSON
( responseToJSON
, diagnosticToJSON
, diagnosticSourceToJSON
, severityToJSON
, srcSpanToJSON
, srcPosToJSON
, typeToJSON
, commandDecoder
, hoverDecoder
, referencesDecoder
, diagnosticsDecoder
, updateVfsDecoder
, srcPosDecoder
) where
import qualified Eclair.JSON as J
import qualified Data.Hermes as H
import Eclair.Common.Pretty
import Eclair.TypeSystem hiding (typeCheck)
import Eclair.LSP.Handlers
import Eclair.LSP.Types
import Eclair.Common.Location
commandDecoder :: H.Decoder Command
commandDecoder = H.object $ do
cmdType <- H.atKey "type" H.text
let mDecoder = case cmdType of
"hover" -> Just hoverDecoder
"document-highlight" -> Just referencesDecoder
"diagnostics" -> Just diagnosticsDecoder
"update-vfs" -> Just updateVfsDecoder
"shutdown" -> Nothing
_ -> Nothing -- TODO return exception?
case mDecoder of
Nothing -> pure Shutdown
Just decoder -> do
H.atKey "command" decoder
hoverDecoder :: H.Decoder Command
hoverDecoder = H.object $
Hover
<$> H.atKey "file" H.string
<*> H.atKey "position" srcPosDecoder
referencesDecoder :: H.Decoder Command
referencesDecoder = H.object $
DocumentHighlight
<$> H.atKey "file" H.string
<*> H.atKey "position" srcPosDecoder
diagnosticsDecoder :: H.Decoder Command
diagnosticsDecoder = H.object $
Diagnostics
<$> H.atKey "file" H.string
updateVfsDecoder :: H.Decoder Command
updateVfsDecoder = H.object $
UpdateVFS
<$> H.atKey "file" H.string
<*> H.atKey "contents" H.text
srcPosDecoder :: H.Decoder SourcePos
srcPosDecoder = H.object $
SourcePos
<$> H.atKey "line" H.int
<*> H.atKey "column" H.int
successResponse :: Text -> J.JSON -> J.JSON
successResponse responseKey response =
J.Object [
("type", J.String "success"),
(responseKey, response)
]
errorResponse :: J.JSON -> J.JSON
errorResponse response =
J.Object [
("type", J.String "error"),
("error", response)
]
responseToJSON :: Response -> J.JSON
responseToJSON = \case
HoverResponse (HoverOk srcSpan ty) ->
successResponse "hover" $ J.Object
[ ("location", srcSpanToJSON srcSpan)
, ("type", typeToJSON ty)
]
HoverResponse (HoverError path pos err) ->
errorResponse $ J.Object
[ ("file", J.String $ toText path)
, ("position", srcPosToJSON pos)
, ("message", J.String err)
]
DocumentHighlightResponse (DocHLOk refs) ->
successResponse "highlights" $ J.Array $ map srcSpanToJSON refs
DocumentHighlightResponse (DocHLError path pos err) ->
errorResponse $ J.Object
[ ("file", J.String $ toText path)
, ("position", srcPosToJSON pos)
, ("message", J.String err)
]
DiagnosticsResponse (DiagnosticsOk diagnostics) ->
successResponse "diagnostics" $ J.Array $ map diagnosticToJSON diagnostics
DiagnosticsResponse (DiagnosticsError path mPos err) ->
errorResponse $ J.Object
[ ("file", J.String $ toText path)
, ("position", srcPosToJSON $ fromMaybe (SourcePos 0 0) mPos)
, ("message", J.String err)
]
SuccessResponse ->
J.Object [("success", J.Boolean True)]
ShuttingDown ->
J.Object [("shutdown", J.Boolean True)]
diagnosticToJSON :: Diagnostic -> J.JSON
diagnosticToJSON (Diagnostic source srcSpan severity msg) =
J.Object
[ ("location", srcSpanToJSON srcSpan)
, ("source", diagnosticSourceToJSON source)
, ("severity", severityToJSON severity)
, ("message", J.String msg)
]
diagnosticSourceToJSON :: DiagnosticSource -> J.JSON
diagnosticSourceToJSON src =
J.String $ show src
severityToJSON :: Severity -> J.JSON
severityToJSON Error =
J.String "error"
srcSpanToJSON :: SourceSpan -> J.JSON
srcSpanToJSON srcSpan =
J.Object
[ ("file", J.String $ toText path)
, ("start", J.Object
[ ("line", J.Number $ sourcePosLine start)
, ("column", J.Number $ sourcePosColumn start)
]
)
, ("end", J.Object
[ ("line", J.Number $ sourcePosLine end)
, ("column", J.Number $ sourcePosColumn end)
]
)
]
where
path = sourceSpanFile srcSpan
start = sourceSpanBegin srcSpan
end = sourceSpanEnd srcSpan
srcPosToJSON :: SourcePos -> J.JSON
srcPosToJSON pos =
J.Object
[ ("line", J.Number $ sourcePosLine pos)
, ("column", J.Number $ sourcePosColumn pos)
]
typeToJSON :: Type -> J.JSON
typeToJSON =
J.String . printDoc
================================================
FILE: lib/Eclair/LSP/Monad.hs
================================================
module Eclair.LSP.Monad
( LspM
, runLSP
, liftLSP
, getParams
, module Eclair.LSP.VFS
, posToOffset
) where
import Eclair (Parameters(..))
import Eclair.LSP.VFS
import Eclair.Common.Location
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
type LspM = ReaderT Parameters (VFST IO)
runLSP :: LspM a -> IO a
runLSP m = do
runVFST $ runReaderT m placeHolderParams
where
-- TODO make number of cores configurable via CLI
placeHolderParams = Parameters 1 Nothing mempty
getParams :: LspM Parameters
getParams = ask
liftLSP :: IO a -> LspM a
liftLSP = lift . lift
-- A hack to go from the LSP position to the offset in the file.
-- TODO check for off by 1 errors!
-- TODO move to Parser.hs
posToOffset :: SourcePos -> Text -> Either Text Int
posToOffset lspPos fileContents = do
case P.runParser p "" fileContents of
Left _ ->
Left "Error computing location offset in file!"
Right offset ->
pure offset
where
p :: P.Parsec Void Text Int
p = do
-- Skip to correct line
replicateM_ (fromIntegral $ sourcePosLine lspPos) $ do
void $ P.takeWhileP Nothing (/= '\n')
P.char '\n'
-- Skip to correct column
void $ P.takeP Nothing (fromIntegral $ sourcePosColumn lspPos)
P.getOffset
================================================
FILE: lib/Eclair/LSP/Types.hs
================================================
module Eclair.LSP.Types
( Command(..)
, Response(..)
) where
import Eclair.Common.Location
import Eclair.LSP.Handlers
data Command
= Hover FilePath SourcePos
| DocumentHighlight FilePath SourcePos
| Diagnostics FilePath
| UpdateVFS FilePath Text
| Shutdown
deriving (Eq, Show)
data Response
= HoverResponse HoverResult
| DocumentHighlightResponse DocHLResult
| DiagnosticsResponse DiagnosticsResult
| SuccessResponse
| ShuttingDown
================================================
FILE: lib/Eclair/LSP/VFS.hs
================================================
module Eclair.LSP.VFS
( VFS
, VFST
, runVFST
, getVfsVar
, vfsSetFile
, vfsLookupFile
, unsafeReadFromVFS
) where
import qualified Data.Map as M
import Data.Maybe (fromJust)
-- Virtual file system (some files might not be saved yet to disk!)
type VFS = M.Map FilePath Text
newtype VFST m a = VFST (ReaderT (MVar VFS) m a)
deriving ( Functor, Applicative, Monad
, MonadReader (MVar VFS), MonadIO)
via ReaderT (MVar VFS) m
instance MonadTrans VFST where
lift m =
VFST $ lift m
runVFST :: MonadIO m => VFST m a -> m a
runVFST (VFST m) = do
vfsVar <- liftIO $ newMVar mempty
runReaderT m vfsVar
getVfsVar :: Monad m => VFST m (MVar VFS)
getVfsVar = ask
-- NOTE: Can be used both for adding and updating
vfsSetFile :: MonadIO m => FilePath -> Text -> VFST m ()
vfsSetFile path contents = do
vfsVar <- getVfsVar
liftIO $ modifyMVar_ vfsVar $
pure . M.insert path contents
vfsLookupFile :: MonadIO m => FilePath -> VFST m (Maybe Text)
vfsLookupFile path = do
vfsVar <- getVfsVar
liftIO $ do
vfs <- readMVar vfsVar
pure $! M.lookup path vfs
-- Helper function used in a couple of handlers to directly read from VFS
-- Can be used as a drop-in replacement for "tryReadFile" in the compiler
-- pipeline once the VFS argument is applied.
unsafeReadFromVFS :: VFS -> FilePath -> IO Text
unsafeReadFromVFS vfs path =
pure . fromJust $ M.lookup path vfs
================================================
FILE: lib/Eclair/LSP.hs
================================================
module Eclair.LSP
( lspMain
) where
import Eclair (Parameters(..))
import Eclair.LSP.Handlers
import Eclair.LSP.Monad
import Eclair.LSP.Types
import Eclair.LSP.JSON
import qualified Eclair.JSON as J
import qualified Data.Hermes as H
import qualified Data.Text.IO as TIO
import qualified Data.ByteString as BS
import qualified Data.Map as M
data NextStep
= Continue
| Stop
lspMain :: IO ()
lspMain = do
env <- H.mkHermesEnv Nothing
runLSP $ do
vfsVar <- lift getVfsVar
let readVFS path = do
vfs <- readMVar vfsVar
pure $! M.lookup path vfs
-- TODO make numCores configurable via CLI
let params = Parameters 1 Nothing readVFS
local (const params) $ go env
where
go env = readCommand env >>= \case
Left _err ->
sendResponse ShuttingDown
Right command -> do
(nextStep, result) <- processCommand command
sendResponse result
case nextStep of
Continue -> go env
Stop -> pass
processCommand :: Command -> LspM (NextStep, Response)
processCommand = \case
Hover path srcPos -> do
result <- hoverHandler path srcPos
pure (Continue, HoverResponse result)
DocumentHighlight path srcPos -> do
hls <- documentHighlightHandler path srcPos
pure (Continue, DocumentHighlightResponse hls)
Diagnostics path -> do
diagnostics <- diagnosticsHandler path
pure (Continue, DiagnosticsResponse diagnostics)
UpdateVFS path fileContents -> do
lift $ vfsSetFile path fileContents
pure (Continue, SuccessResponse)
Shutdown ->
pure (Stop, ShuttingDown)
readCommand :: H.HermesEnv -> LspM (Either H.HermesException Command)
readCommand env = liftLSP $
H.parseByteString env commandDecoder <$> BS.hGetLine stdin
sendResponse :: Response -> LspM ()
sendResponse resp =
liftLSP $ do
TIO.hPutStrLn stdout txt
hFlush stdout
where
txt = J.encodeJSON json
json = responseToJSON resp
================================================
FILE: lib/Eclair/Parser.hs
================================================
module Eclair.Parser
( parseFile
, parseText
, Parser
, ParseError
, CustomParseErr
, ParsingError(..)
) where
import Data.Char
import Eclair.AST.IR
import Eclair.Common.Id
import Eclair.Common.Location
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Text.Read as TR
import qualified Data.List.NonEmpty as NE
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Internal as P
import qualified Text.Megaparsec.Char as P
import qualified Text.Megaparsec.Char.Lexer as L
import qualified Control.Monad.Combinators.Expr as L
data CustomParseErr
= TooManyInputOptions
| TooManyOutputOptions
deriving (Eq, Ord, Show)
instance P.ShowErrorComponent CustomParseErr where
showErrorComponent = \case
TooManyInputOptions ->
"More than one option of type 'input' is not allowed."
TooManyOutputOptions ->
"More than one option of type 'output' is not allowed."
type ParseError = P.ParseErrorBundle Text CustomParseErr
type ParserState = (Word32, SpanMap)
type Parser = P.ParsecT CustomParseErr Text (State ParserState)
data ParsingError
= FileNotFound FilePath
| ParsingError ParseError
deriving (Show)
parseFile
:: (FilePath -> IO (Maybe Text))
-> FilePath -> IO (AST, NodeId, SpanMap, Maybe ParsingError)
parseFile tryReadFile path = do
mContents <- tryReadFile path
case mContents of
Nothing ->
pure (emptyModule, NodeId 0, SpanMap path mempty, Just $ FileNotFound path)
Just contents ->
pure $ parseText path contents
parseText :: FilePath -> Text -> (AST, NodeId, SpanMap, Maybe ParsingError)
parseText path text =
f $ runState (runParserT path text astParser) (0, SpanMap path mempty)
where
f ((mAst, mErr), s) =
(fromMaybe emptyModule mAst, NodeId $ fst s, snd s, mErr)
emptyModule :: AST
emptyModule = Module (NodeId 0) mempty
-- Uses the internals of Megaparsec to try and return a parse result along
-- with possible parse errors.
runParserT :: FilePath -> Text -> Parser a -> State ParserState (Maybe a, Maybe ParsingError)
runParserT path text p = do
let s = initialState path text
(P.Reply s' _ result) <- P.runParsecT p s
let toBundle es =
P.ParseErrorBundle
{ P.bundleErrors = NE.sortWith P.errorOffset es,
P.bundlePosState = P.statePosState s
}
pure $ case result of
P.Error fatalError ->
(Nothing, Just $ ParsingError $ toBundle $ fatalError :| P.stateParseErrors s')
P.OK _ x ->
let nonFatalErrs = viaNonEmpty toBundle (P.stateParseErrors s')
in (Just x, ParsingError <$> nonFatalErrs)
where
initialState name s =
P.State
{ P.stateInput = s,
P.stateOffset = 0,
P.statePosState =
P.PosState
{ P.pstateInput = s,
P.pstateOffset = 0,
P.pstateSourcePos = P.initialPos name,
P.pstateTabWidth = P.defaultTabWidth,
P.pstateLinePrefix = ""
},
P.stateParseErrors = []
}
freshNodeId :: Parser NodeId
freshNodeId = do
nodeId <- gets (NodeId . fst)
modify $ first (+1)
pure nodeId
withNodeId :: (NodeId -> Parser a) -> Parser a
withNodeId f = do
nodeId <- freshNodeId
begin <- P.getOffset
parsed <- f nodeId
end <- P.getOffset
modify $ second (insertSpan nodeId (Span begin end))
pure parsed
astParser :: Parser AST
astParser = withNodeId $ \nodeId -> do
whitespace
decls <- withRecovery '.' declParser `P.endBy` whitespace
P.eof
pure $ Module nodeId $ catMaybes decls
declParser :: Parser AST
declParser = do
c <- P.lookAhead P.anySingle
case c of
'@' -> do
withNodeId $ \nodeId ->
typedefParser nodeId <|> externParser nodeId
_ -> factOrRuleParser
externParser :: NodeId -> Parser AST
externParser nodeId = do
void $ lexeme $ P.chunk "@extern"
name <- lexeme identifier
args <- lexeme $ betweenParens $ argParser `P.sepBy1` lexeme comma
mRetTy <- optional typeParser
void $ P.char '.'
pure $ ExternDefinition nodeId name args mRetTy
typedefParser :: NodeId -> Parser AST
typedefParser nodeId = do
void $ lexeme $ P.chunk "@def"
name <- lexeme identifier
args <- lexeme $ betweenParens $ argParser `P.sepBy1` lexeme comma
attrs <- attributesParser
void $ P.char '.'
pure $ DeclareType nodeId name args attrs
where
attributesParser = map (fromMaybe Internal) $ lexeme $ optional $ do
options <- some attrParser
let (inputs, outputs) = partitionEithers options
inputLength = length inputs
outputLength = length outputs
when (inputLength > 1) $ do
P.customFailure TooManyInputOptions
when (outputLength > 1) $ do
P.customFailure TooManyOutputOptions
pure $ case (inputLength, outputLength) of
(0, 1) -> Output
(1, 0) -> Input
_ -> InputOutput
attrParser = lexeme $
Left <$> P.chunk "input" <|> Right <$> P.chunk "output"
argParser :: Parser (Maybe Id, Type)
argParser =
P.try argWithoutName <|> argWithName
where
argWithoutName = (Nothing,) <$> typeParser
argWithName = P.label "field name" $ do
mFieldName <- optional $ do
name <- lexeme identifier
_ <- lexeme $ P.char ':'
pure name
ty <- typeParser
pure (mFieldName, ty)
typeParser :: Parser Type
typeParser = P.label "type" $ lexeme $ u32 <|> str
where
u32 = U32 <$ P.chunk "u32"
str = Str <$ P.chunk "string"
data FactOrRule = FactType | RuleType
factOrRuleParser :: Parser AST
factOrRuleParser = withNodeId $ \nodeId -> do
name <- lexeme identifier
args <- lexeme $ betweenParens $ exprParser `P.sepBy1` comma
declType <- lexeme (RuleType <$ P.chunk ":-") <|> (FactType <$ P.chunk ".")
case declType of
RuleType -> do
body <- ruleClauseParser `P.sepBy1` comma <* period
pure $ Rule nodeId name args body
FactType -> pure $ Atom nodeId name args
where
period = P.char '.'
comma :: Parser Char
comma = lexeme $ P.char ','
ruleClauseParser :: Parser AST
ruleClauseParser = do
negationParser
<|> P.try (atomParser <* P.notFollowedBy opParser)
<|> constraintParser
where
opParser =
void constraintOpParser <|> void arithmeticOpParser
arithmeticOpParser =
P.choice $ concatMap (map $ P.char . snd) arithmeticOps
negationParser :: Parser AST
negationParser = withNodeId $ \nodeId -> do
void $ lexeme $ P.char '!'
Not nodeId <$> atomParser
atomParser :: Parser AST
atomParser = lexeme $ do
withNodeId $ \nodeId -> do
name <- lexeme identifier
args <- betweenParens $ exprParser `P.sepBy1` comma
pure $ Atom nodeId name args
constraintParser :: Parser AST
constraintParser = withNodeId $ \nodeId -> do
lhs <- lexeme exprParser
op <- constraintOpParser
rhs <- lexeme exprParser
pure $ Constraint nodeId op lhs rhs
exprParser :: Parser AST
exprParser =
lexeme $ withNodeId (L.makeExprParser termParser . precedenceTable)
where
precedenceTable nodeId =
map (map (uncurry (binOp nodeId))) arithmeticOps
binOp nodeId op c =
L.InfixL (BinOp nodeId op <$ lexeme (P.char c))
termParser =
lexeme $ betweenParens exprParser <|> value
where
value = withNodeId $ \nodeId ->
Hole nodeId <$ P.char '?' <|>
P.try varParser <|>
atomParser <|>
Lit nodeId <$> literal
arithmeticOps :: [[(ArithmeticOp, Char)]]
arithmeticOps =
[ [(Multiply, '*'), (Divide, '/')]
, [(Plus, '+'), (Minus, '-')]
]
varParser :: Parser AST
varParser = lexeme $ withNodeId $ \nodeId -> do
v <- Var nodeId <$> (identifier <|> wildcard)
P.notFollowedBy $ P.char '('
pure v
constraintOpParser :: Parser LogicalOp
constraintOpParser = P.label "equality or comparison operator" $ lexeme $ do
toOp Equals (P.char '=') <|>
toOp LessOrEqual (P.string "<=") <|>
toOp LessThan (P.char '<') <|>
toOp GreaterOrEqual (P.string ">=") <|>
toOp GreaterThan (P.char '>') <|>
toOp NotEquals (P.string "!=")
where toOp op p = op <$ lexeme p
-- Not sure if we want to support something like _abc?
wildcard :: Parser Id
wildcard =
Id . one <$> P.char '_'
identifier :: Parser Id
identifier = Id <$> do
firstLetter <- P.letterChar P. "start of identifier"
rest <- P.takeWhileP (Just "rest of identifier") isIdentifierChar
let parsed = T.cons firstLetter rest
when (parsed `V.elem` reserved) $ do
fail . toString $ "Reserved keyword: " <> parsed
pure parsed
where
isIdentifierChar c = isAlphaNum c || c == '_'
-- List of reserved words, not allowed to be used in identifiers.
reserved :: V.Vector Text
reserved = V.fromList []
literal :: Parser Literal
literal = number <|> string
digitVector :: V.Vector Char
digitVector = V.fromList ['1'..'9']
number :: Parser Literal
number = LNumber <$> do
positiveNumber <|> zero
where
zero = 0 <$ P.char '0'
positiveNumber = do
firstDigit <- P.satisfy (`V.elem` digitVector) P. "non-zero digit"
digits <- P.takeWhileP Nothing isDigit
P.notFollowedBy P.letterChar
case TR.decimal $ T.cons firstDigit digits of
Right (result, _) -> pure result
Left err -> panic . toText $ "Error occurred during parsing of decimal number: " <> err
string :: Parser Literal
string = LString <$> do
P.between ("\"" P. "string literal") "\"" $
toText <$> many (P.try escaped <|> normal)
where
escaped = do
void $ P.char '\\'
toEscapedChar <$> P.satisfy isEscapeChar
isEscapeChar c =
c `elem` ['"', '\\', 'n', 'r', 't', 'b', 'f', 'v', '0']
toEscapedChar = \case
'"' -> '\"'
'\\' -> '\\'
'n' -> '\n'
'r' -> '\r'
't' -> '\t'
'b' -> '\b'
'f' -> '\f'
'v' -> '\v'
'0' -> '\0'
_ -> panic "Unreachable code in string parser!"
normal = P.anySingleBut '"'
lexeme :: Parser a -> Parser a
lexeme = L.lexeme whitespace
whitespace :: Parser ()
whitespace = L.space spaceParser commentParser blockCommentParser where
spaceParser = P.skipSome wsChar
wsChar = void (P.satisfy $ \c -> c == ' ' || c == '\n') P. "whitespace"
commentParser = L.skipLineComment "//"
blockCommentParser = L.skipBlockComment "/*" "*/"
betweenParens :: Parser a -> Parser a
betweenParens =
P.between (lexeme $ P.char '(') (P.char ')') . lexeme
-- | Helper for parsers that can recover from errors.
-- In case of error, keeps parsing up to and including 'endChar'
withRecovery :: Char -> Parser a -> Parser (Maybe a)
withRecovery endChar p =
P.withRecovery handleErr $ map Just p
where
handleErr err = do
P.registerParseError err
_ <- P.takeWhileP Nothing (/= endChar)
_ <- P.char endChar
pure Nothing
================================================
FILE: lib/Eclair/RA/Codegen.hs
================================================
module Eclair.RA.Codegen
( CodegenM
, runCodegen
, LowerState(..)
, mkLowerState
, CGState(..)
, CGInfo(..)
, getLowerState
, Relation
, Alias
, getFirstFieldOffset
, getContainerInfoByOffset
, idxFromConstraints
, lookupRelationByIndex
, lookupAlias
, withUpdatedAlias
, withEndLabel
, withSearchState
, block
, declareProgram
, fn
, apiFn
, fnArg
, call
, primOp
, fieldAccess
, heapAllocProgram
, freeProgram
, stackAlloc
, loop
, jump
, labelId
, label
, parallel
, ret
, var
, assign
, if'
, not'
, and'
, equals
, notEquals
, lessThan
, lessOrEqual
, greaterThan
, greaterOrEqual
, mkExternOp
, mkArithOp
, plus
, minus
, multiply
, divide
, lit
) where
import Data.Maybe (fromJust)
import qualified Data.List as List
import qualified Data.Map as M
import qualified Data.Set as S
import Eclair.RA.IndexSelection
import Eclair.TypeSystem
import Eclair.Common.Id
import Eclair.Common.Literal
import qualified Eclair.EIR.IR as EIR
import qualified Eclair.RA.IR as RA
import qualified Eclair.LLVM.Metadata as Meta
type Alias = RA.Alias
type Relation = EIR.Relation
type EIR = EIR.EIR
type AliasMap = Map Alias EIR
-- Helper data type that pre-computes some data that is used a lot,
-- to speed up the compiler.
data CGInfo
= CGInfo
{ relInfo :: [(Relation, Index)]
, offsetsForRelationAndIndex :: Map (Relation, Index) Int
, offsetsForRelation :: Map Relation Int -- only tracks first one
}
data LowerState
= LowerState
{ typeEnv :: TypedefInfo
, idxMap :: IndexMap
, idxSelector :: IndexSelector
, cgInfo :: CGInfo
, endLabel :: EIR.LabelId
, aliasMap :: AliasMap
}
mkLowerState :: TypedefInfo -> IndexMap -> IndexSelector -> [(Relation, Index)] -> EIR.LabelId -> LowerState
mkLowerState typedefInfo indexMap getIndexForSearch relInfos end =
LowerState typedefInfo indexMap getIndexForSearch codegenInfo end mempty
where
codegenInfo = CGInfo relInfos offsetsByRelationAndIndex offsetsByRelation
offsetsByRelationAndIndex =
M.fromDistinctAscList
[ (ri, offset)
| ri <- sortNub relInfos
-- + 1 due to symbol table at position 0 in program struct
, let offset = 1 + fromJust (List.elemIndex ri relInfos)
]
offsetsByRelation =
let rs = map fst relInfos
in M.fromDistinctAscList
[ (r, offset)
| r <- sortNub rs
-- + 1 due to symbol table at position 0 in program struct
, let offset = 1 + fromJust (List.elemIndex r rs)
]
data CGState
= Normal LowerState
| Search Alias EIR LowerState
type Count = Int
type IdMapping = Map Text Count
data Mapping
= Mapping
{ labelMapping :: IdMapping
, varMapping :: IdMapping
}
instance Semigroup Mapping where
(Mapping lbls1 vars1) <> (Mapping lbls2 vars2) =
Mapping (combine lbls1 lbls2) (combine vars1 vars2)
where combine = M.unionWith (+)
instance Monoid Mapping where
mempty = Mapping mempty mempty
newtype CodegenM a
= CodeGenM (RWS CGState () Mapping a)
deriving ( Functor, Applicative, Monad
, MonadReader CGState
, MonadState Mapping
)
via (RWS CGState () Mapping)
runCodegen :: LowerState -> CodegenM EIR -> EIR
runCodegen ls (CodeGenM m) =
fst $ evalRWS m (Normal ls) mempty
withSearchState :: Alias -> EIR -> CodegenM a -> CodegenM a
withSearchState alias value m = do
ls <- getLowerState
local (const $ Search alias value ls) m
getLowerState :: CodegenM LowerState
getLowerState = asks getLS
where
getLS = \case
Normal ls -> ls
Search _ _ ls -> ls
block :: [CodegenM EIR] -> CodegenM EIR
block ms = do
actions <- sequence ms
pure $ EIR.Block $ flattenBlocks actions
flattenBlocks :: [EIR] -> [EIR]
flattenBlocks actions = flip concatMap actions $ \case
EIR.Block stmts -> stmts
stmt -> [stmt]
declareProgram :: [(Relation, Meta.Metadata)] -> CodegenM EIR
declareProgram metas = pure $ EIR.DeclareProgram metas
fn :: Text -> [EIR.Type] -> EIR.Type -> [CodegenM EIR] -> CodegenM EIR
fn name tys retTy body = EIR.Function EIR.Private name tys retTy <$> block body
apiFn :: Text -> [EIR.Type] -> EIR.Type -> [CodegenM EIR] -> CodegenM EIR
apiFn name tys retTy body = EIR.Function EIR.Public name tys retTy <$> block body
fnArg :: Int -> CodegenM EIR
fnArg n = pure $ EIR.FunctionArg n
call :: Relation -> Index -> EIR.Function -> [CodegenM EIR] -> CodegenM EIR
call r idx fn' =
primOp (EIR.RelationOp r idx fn')
primOp :: EIR.Op -> [CodegenM EIR] -> CodegenM EIR
primOp op args =
EIR.PrimOp op <$> sequence args
fieldAccess :: CodegenM EIR -> Int -> CodegenM EIR
fieldAccess struct n = flip EIR.FieldAccess n <$> struct
heapAllocProgram :: CodegenM EIR
heapAllocProgram =
pure EIR.HeapAllocateProgram
freeProgram :: CodegenM EIR -> CodegenM EIR
freeProgram ptr = EIR.FreeProgram <$> ptr
stackAlloc :: Relation -> Index -> EIR.Type -> CodegenM EIR
stackAlloc r idx ty =
pure $ EIR.StackAllocate (stripIdPrefixes r) idx ty
loop :: [CodegenM EIR] -> CodegenM EIR
loop ms = do
actions <- sequence ms
pure $ EIR.Loop $ flattenBlocks actions
jump :: EIR.LabelId -> CodegenM EIR
jump lbl = pure $ EIR.Jump lbl
-- NOTE: labelId and label are split up, so label can be used in 2 ways:
-- 1) "endLabel" can also be passed into 'label'
-- 2) dynamic labels used for control flow can be generated with 'labelId' and passed to 'label'
labelId :: Text -> CodegenM EIR.LabelId
labelId name = do
mapping <- gets labelMapping
(lblId, updatedMapping) <- lookupId name mapping
modify $ \s -> s { labelMapping = updatedMapping }
pure . EIR.LabelId $ lblId
label :: EIR.LabelId -> CodegenM EIR
label = pure . EIR.Label
parallel :: [CodegenM EIR] -> CodegenM EIR
parallel ms = do
actions <- sequence ms
pure $ EIR.Par $ flattenBlocks actions
ret :: CodegenM EIR -> CodegenM EIR
ret = map EIR.Return
-- NOTE: 2nd layer is for easy integration with other helper functions
-- e.g.:
--
-- do
-- v <- var "..."
-- sequence [ ... ]
var :: Text -> CodegenM (CodegenM EIR)
var name = do
mapping <- gets varMapping
(varId, updatedMapping) <- lookupId name mapping
modify $ \s -> s { varMapping = updatedMapping }
pure . pure . EIR.Var $ varId
assign :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
assign var' value = do
v <- var'
value >>= \case
EIR.Block stmts ->
let lastStmt = List.last stmts
firstStmts = List.init stmts
in block (map pure $ firstStmts ++ [EIR.Assign v lastStmt])
val -> pure $ EIR.Assign v val
if' :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
if' cond body = do
condition <- var "condition"
block
[ assign condition cond
, EIR.If <$> condition <*> body
]
not' :: CodegenM EIR -> CodegenM EIR
not' bool' = EIR.Not <$> bool'
and' :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
and' lhs rhs = do
lhsResult <- var "bool"
rhsResult <- var "bool"
block
[ assign lhsResult lhs
, assign rhsResult rhs
, EIR.And <$> lhsResult <*> rhsResult
]
mkArithOp :: EIR.ArithmeticOp -> CodegenM EIR -> CodegenM EIR -> CodegenM EIR
mkArithOp op lhs rhs =
let args = sequence [lhs, rhs]
in EIR.PrimOp (EIR.ArithOp op) <$> args
mkExternOp :: Id -> [CodegenM EIR] -> CodegenM EIR
mkExternOp name args = do
let program = EIR.FunctionArg 0
symbolTable = EIR.FieldAccess program 0
args' <- sequence args
pure $ EIR.PrimOp (EIR.ExternOp name) $ symbolTable : args'
plus :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
plus = mkArithOp EIR.Plus
minus :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
minus = mkArithOp EIR.Minus
multiply :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
multiply = mkArithOp EIR.Multiply
divide :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
divide = mkArithOp EIR.Divide
mkConstrainOp :: EIR.LogicalOp -> CodegenM EIR -> CodegenM EIR -> CodegenM EIR
mkConstrainOp op lhs rhs =
let args = sequence [lhs, rhs]
in EIR.PrimOp (EIR.ComparisonOp op) <$> args
equals :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
equals = mkConstrainOp EIR.Equals
notEquals :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
notEquals = mkConstrainOp EIR.NotEquals
lessThan :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
lessThan = mkConstrainOp EIR.LessThan
lessOrEqual :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
lessOrEqual = mkConstrainOp EIR.LessOrEqual
greaterThan :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
greaterThan = mkConstrainOp EIR.GreaterThan
greaterOrEqual :: CodegenM EIR -> CodegenM EIR -> CodegenM EIR
greaterOrEqual = mkConstrainOp EIR.GreaterOrEqual
lit :: Word32 -> CodegenM EIR
lit x =
pure $ EIR.Lit $ LNumber x
lookupId :: Text -> IdMapping -> CodegenM (Text, IdMapping)
lookupId name mapping = do
let (mValue, updatedMapping) = M.insertLookupWithKey update name defaultValue mapping
value = case mValue of
Nothing -> name
Just val -> name <> "_" <> show val
pure (value, updatedMapping)
where
defaultValue = 1
update _ _ prevValue = prevValue + 1
getFieldOffset :: Relation -> Index -> CodegenM Int
getFieldOffset r idx = do
fromJust . M.lookup (r, idx) . offsetsForRelationAndIndex . cgInfo <$> getLowerState
getFirstFieldOffset :: Relation -> CodegenM Int
getFirstFieldOffset r = do
fromJust . M.lookup r . offsetsForRelation . cgInfo <$> getLowerState
getContainerInfoByOffset :: Int -> CodegenM (Relation, Index)
getContainerInfoByOffset offset =
-- - 1 due to symbol table at position 0 in program struct
(List.!! (offset - 1)) . relInfo . cgInfo <$> getLowerState
lookupAlias :: Alias -> CodegenM EIR
lookupAlias a = ask >>= \case
Normal ls -> lookupAlias' ls
Search _ _ ls -> lookupAlias' ls
where
lookupAlias' ls =
pure $ fromJust $ M.lookup a (aliasMap ls)
withUpdatedAlias :: Alias -> EIR -> CodegenM a -> CodegenM a
withUpdatedAlias a curr m = do
state' <- ask <&> \case
Normal ls -> Normal (updateAlias ls curr)
Search a' v ls -> Search a' v (updateAlias ls curr)
local (const state') m
where
updateAlias ls curr' =
ls { aliasMap = M.insert a curr' (aliasMap ls) }
withEndLabel :: EIR.LabelId -> CodegenM a -> CodegenM a
withEndLabel end m = do
local setLabel m
where
setLabel = \case
Normal ls -> Normal (set ls)
Search a v ls -> Search a v (set ls)
set ls = ls { endLabel = end }
idxFromConstraints :: Relation -> Alias -> [(Relation, Column)] -> CodegenM Index
idxFromConstraints r a constraints = do
lowerState <- getLowerState
let (getIndexForSearch, indexMap) = (idxSelector &&& idxMap) lowerState
r' = stripIdPrefixes r
if null constraints
then do
-- NOTE: no constraints so we pick the longest index (total search)
let mIndex = do
indices <- M.lookup r' indexMap
viaNonEmpty head $ sortOn (negate . length . unIndex) $ toList indices
pure $ fromJust mIndex
else do
let columns = mapMaybe (columnsForRelation a) constraints
signature = SearchSignature $ S.fromList columns
idx = getIndexForSearch r signature
pure idx
lookupRelationByIndex :: Relation -> Index -> CodegenM EIR
lookupRelationByIndex r idx = do
field <- getFieldOffset r idx
fieldAccess (fnArg 0) field
================================================
FILE: lib/Eclair/RA/IR.hs
================================================
{-# LANGUAGE TemplateHaskell #-}
module Eclair.RA.IR
( Relation
, RA(..)
, RAF(..)
, Alias
, Clause
, Action
, ColumnIndex
, LogicalOp(..)
, ArithmeticOp(..)
, Op(..)
) where
import Eclair.Common.Id
import Eclair.Common.Pretty
import Eclair.Common.Operator
import Eclair.Common.Location (NodeId(..))
type Relation = Id
type Alias = Id
type Clause = RA
type Action = RA
type ColumnIndex = Int
data Op
= BuiltinOp ArithmeticOp
| ExternOp Id
deriving (Eq, Show)
-- NOTE: removed Insert, couldn't find a use?
data RA
= Search NodeId Relation Alias [Clause] Action
| Project NodeId Relation [RA]
| Merge NodeId Relation Relation
| Swap NodeId Relation Relation
| Purge NodeId Relation
| Par NodeId [RA]
| Loop NodeId [RA]
-- NOTE: counttuples check is 'builtin' atm
-- Later this needs to be changed to Clause to deal with 'X<100' etc as well.
| Exit NodeId [Relation]
| Module NodeId [RA]
| Lit NodeId Word32
| Undef NodeId
| ColumnIndex NodeId Relation ColumnIndex
| CompareOp NodeId LogicalOp RA RA
| PrimOp NodeId Op [RA]
| NotElem NodeId Relation [RA]
| If NodeId RA RA -- NOTE: args are condition and body
deriving (Eq, Show)
makeBaseFunctor ''RA
prettyBlock :: Pretty a => [a] -> Doc ann
prettyBlock = indentBlock . vsep . map pretty
indentBlock :: Doc ann -> Doc ann
indentBlock block = nest indentation (hardline <> block)
instance Pretty Op where
pretty = \case
BuiltinOp op -> pretty op
ExternOp opName -> pretty opName
instance Pretty RA where
pretty = \case
Search _ r alias clauses inner ->
let clausesText =
if null clauses
then ""
else "where" <+> parens (withAnds $ map pretty clauses) <> space
in "search" <+> pretty r <+> "as" <+> pretty alias <+> clausesText <> "do" <>
prettyBlock [inner]
Project _ r terms ->
"project" <+> prettyValues terms <+>
"into" <+> pretty r
Merge _ r1 r2 -> "merge" <+> pretty r1 <+> pretty r2
Swap _ r1 r2 -> "swap" <+> pretty r1 <+> pretty r2
Purge _ r -> "purge" <+> pretty r
Par _ stmts -> "parallel do" <> prettyBlock stmts
Loop _ stmts -> "loop do" <> prettyBlock stmts
If _ cond stmt ->
"if" <+> pretty cond <+> "do" <> prettyBlock [stmt]
Exit _ rs ->
let texts = map formatExitCondition rs
in "exit if" <+> withAnds texts
Module _ stmts ->
vsep $ map pretty stmts
Lit _ x -> pretty x
Undef _ -> "undefined"
ColumnIndex _ r idx -> pretty r <> brackets (pretty idx)
CompareOp _ op lhs rhs -> pretty lhs <+> pretty op <+> pretty rhs
PrimOp _ op args ->
case (op, args) of
(BuiltinOp{}, [lhs, rhs]) ->
parens $ pretty lhs <+> pretty op <+> pretty rhs
_ ->
pretty op <> parens (withCommas $ map pretty args)
NotElem _ r terms -> prettyValues terms <+> "∉" <+> pretty r
where
prettyValues terms = parens (withCommas $ map pretty terms)
formatExitCondition r =
"counttuples" <> parens (pretty r) <+> "=" <+> "0"
================================================
FILE: lib/Eclair/RA/IndexSelection.hs
================================================
module Eclair.RA.IndexSelection
( IndexMap
, IndexSelector
, Index(..)
, SearchSignature(..)
, Column
, runIndexSelection
, columnsForRelation
, NormalizedEquality(..)
, normalizedEqToConstraints
, extractEqualities
, definedColumnsFor
) where
-- Based on the paper "Automatic Index Selection for Large-Scale Datalog Computation"
-- http://www.vldb.org/pvldb/vol12/p141-subotic.pdf
import Data.Maybe (fromJust)
import Eclair.Common.Id
import Eclair.Common.Pretty
import Eclair.RA.IR
import Eclair.Comonads
import Eclair.TypeSystem (TypedefInfo)
import Algebra.Graph.Bipartite.AdjacencyMap
import Algebra.Graph.Bipartite.AdjacencyMap.Algorithm hiding (matching)
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.List as List
import qualified Data.DList.DNonEmpty as NE
type Column = Int
newtype SearchSignature
= SearchSignature (Set Column)
deriving (Eq, Ord, Show)
newtype Index
= Index
{ unIndex :: [Column] -- TODO: use NonEmpty
} deriving (Eq, Ord, Show)
instance Pretty Index where
pretty (Index columns) =
brackets $ withCommas $ map pretty columns
type SearchSet = Set SearchSignature
type SearchChain = NonEmpty SearchSignature
type SearchMap = Map Relation SearchSet
type SearchGraph = AdjacencyMap SearchSignature SearchSignature
type SearchMatching = Matching SearchSignature SearchSignature
type IndexSelection = [(Relation, Map SearchSignature Index)]
type IndexMap = Map Relation (Set Index)
type IndexSelector = Relation -> SearchSignature -> Index
runIndexSelection :: TypedefInfo -> RA -> (IndexMap, IndexSelector)
runIndexSelection defInfo ra =
let searchMap = searchesForProgram defInfo ra
indexSelection :: IndexSelection
indexSelection = Map.foldrWithKey (\r searchSet acc ->
let graph = buildGraph searchSet
matching = maxMatching graph
chains = getChainsFromMatching graph matching
indices = indicesFromChains searchSet chains
in (r, indices):acc) mempty searchMap
combineIdxs idxs idx = idxs <> one idx
indexMap = foldl' combineIdxs mempty <$> Map.fromList indexSelection
indexSelector r s = fromJust $ do
indexMapping <- snd <$> List.find ((== r) . fst) indexSelection
Map.lookup s indexMapping
in (indexMap, indexSelector)
data SearchFact
= SearchOn Relation SearchSignature
| Related Relation Relation
deriving (Eq, Ord)
-- All relations (including delta_XXX, new_XXX) need atleast one index for full order search
-- Swap operation requires indices of r1 and r2 to be related.
searchesForProgram :: TypedefInfo -> RA -> SearchMap
searchesForProgram defInfo ra =
let raSearchFacts = execState (gcata (dsitribute extractEqualities) constraintsForRA ra) mempty
relationFullSearches = getFullSearchesForRelations defInfo
facts = raSearchFacts <> relationFullSearches
in solve facts
where
addFact fact = modify (fact:)
constraintsForRA = \case
SearchF _ r a (foldMap tSnd -> eqs) (tThd -> action) -> do
-- 1. Only direct constraints in the search matter, since that is what
-- is used to select the index with, afterwards we are already
-- looping over the value!
-- 2. Only equality constraints matter, not "NoElem" constraints!
let cs = concatMap normalizedEqToConstraints eqs
relevantCols = mapMaybe (columnsForRelation a) cs
signature = SearchSignature $ Set.fromList relevantCols
unless (null relevantCols) $ do
addFact $ SearchOn r signature
action
NotElemF _ r cols -> do
let values = map tFst cols
cs = definedColumnsFor values
signature = SearchSignature $ Set.fromList cs
addFact $ SearchOn r signature
MergeF _ from' _ -> do
-- Always add a full search signature for the from relation, so we don't lose any data.
let columns = columnsFor . fromJust $ Map.lookup (stripIdPrefixes from') defInfo
signature = SearchSignature $ Set.fromList columns
addFact $ SearchOn from' signature
SwapF _ r1 r2 ->
addFact $ Related r1 r2
raf ->
traverse_ tThd raf
dsitribute
:: Corecursive t
=> (Base t (t, b) -> b)
-> (Base t (Triple t b a) -> Triple t b (Base t a))
dsitribute g m =
let base_t_t = map tFst m
base_t_tb = map (tFst &&& tSnd) m
base_t_a = map tThd m
in Triple (embed base_t_t) (g base_t_tb) base_t_a
-- For every relation we add atleast 1 one index with all columns.
getFullSearchesForRelations :: TypedefInfo -> [SearchFact]
getFullSearchesForRelations defInfo =
[ SearchOn r . toSearchSignature $ unsafeLookup r
| r <- Map.keys defInfo
]
where
unsafeLookup r = fromJust $ Map.lookup r defInfo
toSearchSignature = SearchSignature . Set.fromList . columnsFor
data NormalizedEquality
= NormalizedEquality Alias Column RA
deriving Show
extractEqualities :: RAF (RA, [NormalizedEquality]) -> [NormalizedEquality]
extractEqualities = \case
CompareOpF _ Equals (lhs, _) (rhs, _) | isDefined lhs && isDefined rhs ->
toEqualities lhs rhs
raf ->
foldMap snd raf
where
isDefined = \case
Undef {} -> False
_ -> True
toEqualities lhs rhs = case (lhs, rhs) of
(ColumnIndex _ lA lCol, ColumnIndex _ rA rCol) ->
[ NormalizedEquality lA lCol rhs
, NormalizedEquality rA rCol lhs
]
(ColumnIndex _ lA lCol, _) ->
[NormalizedEquality lA lCol rhs]
(_, ColumnIndex {}) ->
toEqualities rhs lhs
_ ->
mempty
normalizedEqToConstraints :: NormalizedEquality -> [(Relation, Column)]
normalizedEqToConstraints = \case
NormalizedEquality a1 c1 ra -> case ra of
ColumnIndex _ a2 c2 ->
[(a1, c1), (a2, c2)]
_ ->
[(a1, c1)]
columnsForRelation :: Relation -> (Relation, Column) -> Maybe Column
columnsForRelation r (r', col)
| r == r' = Just col
| otherwise = Nothing
solve :: [SearchFact] -> SearchMap
solve facts = execState (traverse solveOne $ sort facts) mempty
where
solveOne = \case
SearchOn r signature ->
modify (Map.insertWith (<>) r (one signature))
Related r1 r2 -> do
signatures1 <- gets (Map.findWithDefault mempty r1)
signatures2 <- gets (Map.findWithDefault mempty r2)
let combined = signatures1 <> signatures2
modify $ Map.insert r1 combined
. Map.insert r2 combined
buildGraph :: SearchSet -> SearchGraph
buildGraph searchSet =
vertices searches searches
`overlay`
edges [(l, r) | l <- searches, r <- searches, l `isSubsetOf` r]
where
searches = toList searchSet
isSubsetOf (SearchSignature xs) (SearchSignature ys) =
xs `Set.isProperSubsetOf` ys
getChainsFromMatching :: SearchGraph -> SearchMatching -> Set SearchChain
getChainsFromMatching g m =
let (covered, uncovered) = List.partition (`leftCovered` m) $ leftVertexList g
uncoveredChains = map one uncovered
coveredChains = map (\n -> NE.toNonEmpty $ getChain (pure n) n) covered
in Set.fromList $ uncoveredChains <> coveredChains
where
leftCovered :: Ord a => a -> Matching a b -> Bool
leftCovered a = Map.member a . pairOfLeft
-- getChain alternates between U and V side of the bipartite graph
-- A lookup is done on V side:
-- - if it finds no match, we have reached end of the chain
-- - Otherwise, we found the next node in the chain, and use
-- this node to find rest of the chain.
getChain acc u =
case Map.lookup u (pairOfLeft m) of
Nothing ->
-- Longest chain at end, needed in indexForChain
acc
Just v ->
-- Implicitly swap U and V side by passing in v as u:
getChain (NE.snoc acc v) v
indicesFromChains :: SearchSet -> Set SearchChain -> Map SearchSignature Index
indicesFromChains (Set.toList -> searchSet) (Set.toList -> chains) =
Map.fromList [ (signature, indexForChain chain)
| chain <- chains
, signature <- searchSet
, signature `elem` chain
]
-- NOTE: assumes chain is sorted from shortest to longest
indexForChain :: SearchChain -> Index
indexForChain chain = Index $ foldMap Set.toList columns
where
SearchSignature shortest :| rest = chain
diffColumns = zipWith columnDiff rest (toList chain)
columns = shortest : diffColumns
columnDiff (SearchSignature long) (SearchSignature short) =
long Set.\\ short
columnsFor :: [a] -> [Int]
columnsFor = zipWith const [0..]
definedColumnsFor :: [RA] -> [Int]
definedColumnsFor values =
catMaybes $ zipWith f [0..] values
where
f c = \case
Undef {} -> Nothing
_ -> Just c
================================================
FILE: lib/Eclair/RA/Lower.hs
================================================
module Eclair.RA.Lower ( compileToEIR ) where
import Prelude
import Data.Maybe (fromJust)
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Eclair.Common.Id
import Eclair.Common.Literal
import Eclair.Comonads hiding (Quad)
import Eclair.TypeSystem
import Eclair.AST.Transforms.ReplaceStrings (StringMap)
import Eclair.RA.Codegen
import Eclair.EIR.IR (EIR)
import Eclair.RA.IR (RA)
import Eclair.RA.IndexSelection
import qualified Eclair.EIR.IR as EIR
import qualified Eclair.RA.IR as RA
import qualified Eclair.LLVM.Metadata as M
compileToEIR :: StringMap -> TypedefInfo -> RA -> EIR
compileToEIR stringMap typedefInfo ra =
let (indexMap, getIndexForSearch) = runIndexSelection typedefInfo ra
containerInfos' = getContainerInfos indexMap typedefInfo
end = "the.end"
lowerState = mkLowerState typedefInfo indexMap getIndexForSearch (map fst containerInfos') end
moduleStmts :: [CodegenM EIR]
moduleStmts =
[ declareProgram $ map (\((r, _), m) -> (r, m)) containerInfos'
, compileInit stringMap
, compileDestroy
, compileRun ra
]
in EIR.Module $ map (runCodegen lowerState) moduleStmts
compileInit :: StringMap -> CodegenM EIR
compileInit stringMap = do
program <- var "program"
let symbolTable = fieldAccess program 0
symbolTableInitAction = primOp EIR.SymbolTableInit [symbolTable]
relationInitActions <- forEachRelation program $ \(r, idx) relationPtr ->
call r idx EIR.InitializeEmpty [relationPtr]
let addSymbolActions = toSymbolTableInsertActions symbolTable stringMap
initActions = symbolTableInitAction : relationInitActions <> addSymbolActions
apiFn "eclair_program_init" [] (EIR.Pointer EIR.Program) $
assign program heapAllocProgram
: initActions
-- Open question: if some facts are known at compile time, search for derived facts up front?
<> [ ret program ]
toSymbolTableInsertActions :: CodegenM EIR -> StringMap -> [CodegenM EIR]
toSymbolTableInsertActions symbolTable stringMap =
map (doInsert . fst) $ sortWith snd $ Map.toList stringMap
where
doInsert symbol =
primOp EIR.SymbolTableInsert [symbolTable, litStr symbol]
litStr =
pure . EIR.Lit . LString
compileDestroy :: CodegenM EIR
compileDestroy = do
let program = fnArg 0
symbolTableDestroyAction = primOp EIR.SymbolTableDestroy [fieldAccess program 0]
relationDestroyActions <- forEachRelation program $ \(r, idx) relationPtr ->
call r idx EIR.Destroy [relationPtr]
let destroyActions = symbolTableDestroyAction : relationDestroyActions
apiFn "eclair_program_destroy" [EIR.Pointer EIR.Program] EIR.Void $
destroyActions
<> [ freeProgram program ]
compileRun :: RA -> CodegenM EIR
compileRun ra = do
apiFn "eclair_program_run" [EIR.Pointer EIR.Program] EIR.Void
[generateProgramInstructions ra]
generateProgramInstructions :: RA -> CodegenM EIR
generateProgramInstructions = gcata (distribute extractEqualities) $ \case
RA.ModuleF _ (map extract -> actions) -> block actions
RA.ParF _ (map extract -> actions) -> parallel actions
RA.SearchF _ r alias clauses (extract -> action) -> do
let eqsInSearch = foldMap tSnd clauses
eqs = concatMap normalizedEqToConstraints eqsInSearch
idx <- idxFromConstraints r alias eqs
let relationPtr = lookupRelationByIndex r idx
isConstrain = \case
RA.CompareOp {} -> True
_ -> False
queryClauses = map extract $ filter ((not . isConstrain) . tFst) clauses
query = List.foldl1' and' queryClauses
(initBoundValues, lbValue, ubValue) <- initValue r idx alias eqsInSearch
block
[ initBoundValues
, rangeQuery r idx relationPtr lbValue ubValue $ \iter -> do
current <- var "current"
block
[ assign current $ call r idx EIR.IterCurrent [iter]
, do
currentValue <- current
case length queryClauses of
0 -> -- No query to check: always matches
withUpdatedAlias alias currentValue action
_ -> do
withSearchState alias currentValue $
withUpdatedAlias alias currentValue $
if' query action
]
]
RA.ProjectF _ r (map extract -> unresolvedValues) -> do
values <- sequence unresolvedValues
let values' = map pure values
indices <- indexesForRelation r
var' <- var "value"
let -- NOTE: for allocating a value, the index does not matter
-- (a value is always represented as [N x i32] internally)
-- This saves us doing a few stack allocations.
firstIdx = fromJust $ viaNonEmpty head indices
allocValue = assign var' $ stackAlloc r firstIdx EIR.Value
assignStmts = zipWith (assign . fieldAccess var') [0..] values'
insertStmts = flip map indices $ \idx ->
-- NOTE: The insert function is different for each r + idx combination though!
call r idx EIR.Insert [lookupRelationByIndex r idx, var']
block $ allocValue : assignStmts <> insertStmts
RA.PurgeF _ r ->
block =<< relationUnaryFn r EIR.Purge
RA.SwapF _ r1 r2 ->
block =<< relationBinFn r1 r2 EIR.Swap
RA.MergeF _ r1 r2 -> do
-- NOTE: r1 = from/src, r2 = to/dst
-- TODO: which idx? just select first matching? or idx on all columns?
idxR1 <- fromJust . viaNonEmpty head <$> indexesForRelation r1
let relation1Ptr = lookupRelationByIndex r1 idxR1
indices2 <- indexesForRelation r2
block $ flip map indices2 $ \idxR2 -> do
beginIter <- var "begin_iter"
endIter <- var "end_iter"
let relation2Ptr = lookupRelationByIndex r2 idxR2
block
[ assign beginIter $ stackAlloc r1 idxR1 EIR.Iter
, assign endIter $ stackAlloc r1 idxR1 EIR.Iter
, call r1 idxR1 EIR.IterBegin [relation1Ptr, beginIter]
, call r1 idxR1 EIR.IterEnd [relation1Ptr, endIter]
, call r2 idxR2 (EIR.InsertRange r1 idxR1) [relation2Ptr, beginIter, endIter]
]
RA.LoopF _ (map extract -> actions) -> do
end <- labelId "loop.end"
block [withEndLabel end $ loop actions, label end]
RA.IfF _ (extract -> condition) (extract -> action) -> do
if' condition action
RA.PrimOpF _ (RA.BuiltinOp op) (map extract -> args) ->
case args of
[lhs, rhs] -> do
let toArithmetic = case op of
RA.Plus -> plus
RA.Minus -> minus
RA.Multiply -> multiply
RA.Divide -> divide
toArithmetic lhs rhs
_ ->
panic "Unexpected case in 'generateProgramInstructions' while lowering RA!"
RA.PrimOpF _ (RA.ExternOp opName) (map extract -> args) -> do
mkExternOp opName args
RA.CompareOpF _ op (extract -> lhs) (extract -> rhs) -> do
let toComparison = case op of
RA.Equals -> equals
RA.NotEquals -> notEquals
RA.LessThan -> lessThan
RA.LessOrEqual -> lessOrEqual
RA.GreaterThan -> greaterThan
RA.GreaterOrEqual -> greaterOrEqual
toComparison lhs rhs
RA.ExitF _ rs -> do
end <- endLabel <$> getLowerState
foldl' f (jump end) =<< traverse getFirstFieldOffset rs
where
f inner field = do
(r, idx) <- getContainerInfoByOffset field
let programPtr = fnArg 0
relationPtr = fieldAccess programPtr field
isEmpty = call r idx EIR.IsEmpty [relationPtr]
if' isEmpty inner
RA.LitF _ x -> lit x
RA.NotElemF _ r values -> do
if containsUndefined $ map tFst values
then existenceCheckPartialSearch
else existenceCheckTotalSearch
where
containsUndefined = isJust . find (\case
RA.Undef {} -> True
_ -> False)
existenceCheckPartialSearch = do
getIndexForSearch <- idxSelector <$> getLowerState
lbValue <- var "lower_bound_value"
ubValue <- var "upper_bound_value"
beginIter <- var "begin_iter"
endIter <- var "end_iter"
let values' = map tFst values
cs = definedColumnsFor values'
signature = SearchSignature $ Set.fromList cs
idx = getIndexForSearch r signature
lbValueWithCols = zipWith (curry $ second $ lowerConstrainValue (lit 0x00000000)) [0..] values'
ubValueWithCols = zipWith (curry $ second $ lowerConstrainValue (lit 0xffffffff)) [0..] values'
lbAssignStmts = block $ map (\(i, val) -> assign (fieldAccess lbValue i) val) lbValueWithCols
ubAssignStmts = block $ map (\(i, val) -> assign (fieldAccess ubValue i) val) ubValueWithCols
relationPtr = lookupRelationByIndex r idx
block
[ assign lbValue $ stackAlloc r idx EIR.Value
, lbAssignStmts
, assign ubValue $ stackAlloc r idx EIR.Value
, ubAssignStmts
, assign beginIter $ stackAlloc r idx EIR.Iter
, assign endIter $ stackAlloc r idx EIR.Iter
, call r idx EIR.IterLowerBound [relationPtr, lbValue, beginIter]
, call r idx EIR.IterUpperBound [relationPtr, ubValue, endIter]
, call r idx EIR.IterIsEqual [beginIter, endIter]
]
existenceCheckTotalSearch = do
let columnValues = map extract values
value <- var "value"
let idx = mkFindIndex columnValues
relationPtr = lookupRelationByIndex r idx
allocValue = assign value $ stackAlloc r idx EIR.Value
containsVar <- var "contains_result"
let assignActions = zipWith (assign . fieldAccess value) [0..] columnValues
containsAction = assign containsVar $ call r idx EIR.Contains [relationPtr, value]
block $ allocValue : assignActions <> [containsAction, not' containsVar]
RA.ColumnIndexF _ a' col -> ask >>= \case
Search a value _ ->
if a == a'
then getColumn value col
else do
currentAliasValue <- lookupAlias a'
getColumn currentAliasValue col
Normal _ -> do
currentAliasValue <- lookupAlias a'
getColumn currentAliasValue col
where
getColumn value =
fieldAccess (pure value)
RA.UndefF {} ->
panic "Undef should not occur when lowering to EIR!"
where
distribute :: Corecursive t
=> (Base t (t, a) -> a)
-> (Base t (Triple t a b) -> Triple t a (Base t b))
distribute f m =
let base_t_t = map tFst m
base_t_ta = map (tFst &&& tSnd) m
base_t_b = map tThd m
in Triple (embed base_t_t) (f base_t_ta) base_t_b
rangeQuery :: Relation
-> Index
-> CodegenM EIR
-> CodegenM EIR
-> CodegenM EIR
-> (CodegenM EIR -> CodegenM EIR)
-> CodegenM EIR
rangeQuery r idx relationPtr lbValue ubValue loopAction = do
beginIter <- var "begin_iter"
endIter <- var "end_iter"
endLabel' <- labelId "range_query.end"
let allocBeginIter = assign beginIter $ stackAlloc r idx EIR.Iter
allocEndIter = assign endIter $ stackAlloc r idx EIR.Iter
initLB = call r idx EIR.IterLowerBound [relationPtr, lbValue, beginIter]
initUB = call r idx EIR.IterUpperBound [relationPtr, ubValue, endIter]
advanceIter = call r idx EIR.IterNext [beginIter]
isAtEnd = call r idx EIR.IterIsEqual [beginIter, endIter]
stopIfFinished = if' isAtEnd (jump endLabel')
loopStmts = [stopIfFinished, loopAction beginIter, advanceIter]
block [allocBeginIter, allocEndIter, initLB, initUB, loop loopStmts, label endLabel']
-- NOTE: only supports unsigned integers for now!
initValue :: Relation -> Index -> RA.Alias -> [NormalizedEquality]
-> CodegenM (CodegenM EIR, CodegenM EIR, CodegenM EIR)
initValue r idx a eqs = do
let r' = stripIdPrefixes r
typeInfo <- fromJust . Map.lookup r' . typeEnv <$> getLowerState
lbValue <- var "lower_bound_value"
ubValue <- var "upper_bound_value"
let columnNrs = take (length typeInfo) [0..]
lbAllocValue = assign lbValue $ stackAlloc r idx EIR.Value
ubAllocValue = assign ubValue $ stackAlloc r idx EIR.Value
-- TODO stack allocate all values so they are not computed twice?
lbValuesWithCols = [(nr, x) | nr <- columnNrs, let x = constrain (lit 0x00000000) nr]
ubValuesWithCols = [(nr, x) | nr <- columnNrs, let x = constrain (lit 0xffffffff) nr]
lbAssignStmts = map (\(i, val) -> assign (fieldAccess lbValue i) val) lbValuesWithCols
ubAssignStmts = map (\(i, val) -> assign (fieldAccess ubValue i) val) ubValuesWithCols
pure (block $ lbAllocValue : ubAllocValue : lbAssignStmts <> ubAssignStmts, lbValue, ubValue)
where
constrain bound col =
case find (\(NormalizedEquality a' col' _) -> a == a' && col == col') eqs of
Nothing ->
bound
Just (NormalizedEquality _ _ ra) ->
lowerConstrainValue bound ra
-- let NormalizedEquality _ _ ra = fromJust $ find (\(NormalizedEquality a' col' _) -> a == a' && col == col') eqs
-- in lowerConstrainValue bound ra
lowerConstrainValue :: CodegenM EIR -> RA -> CodegenM EIR
lowerConstrainValue bound = \case
RA.Lit _ x ->
lit x
RA.Undef _ ->
bound
RA.ColumnIndex _ a' col' ->
fieldAccess (lookupAlias a') col'
RA.PrimOp _ (RA.BuiltinOp op) [lhs, rhs] ->
mkArithOp op (lowerConstrainValue bound lhs) (lowerConstrainValue bound rhs)
RA.PrimOp _ (RA.ExternOp opName) args ->
mkExternOp opName $ map (lowerConstrainValue bound) args
_ -> panic "Unsupported initial value while lowering to RA"
forEachRelation :: CodegenM EIR -> ((Relation, Index) -> CodegenM EIR -> CodegenM EIR) -> CodegenM [CodegenM EIR]
forEachRelation program f = do
cis <- relInfo . cgInfo <$> getLowerState
pure $ zipWith doCall [1..] cis
where
doCall fieldOffset relationInfo =
f relationInfo (fieldAccess program fieldOffset)
relationUnaryFn :: Relation -> EIR.Function -> CodegenM [CodegenM EIR]
relationUnaryFn r fn' = forEachIndex r $ \idx -> do
call r idx fn' [lookupRelationByIndex r idx]
-- NOTE: assumes r1 and r2 have same underlying representation
-- (guaranteed by earlier compiler stages)
relationBinFn :: Relation -> Relation -> EIR.Function -> CodegenM [CodegenM EIR]
relationBinFn r1 r2 fn' = forEachIndex r1 $ \idx -> do
call r1 idx fn'
[ lookupRelationByIndex r1 idx
, lookupRelationByIndex r2 idx
]
forEachIndex :: Relation
-> (Index -> CodegenM EIR)
-> CodegenM [CodegenM EIR]
forEachIndex r f = do
indices <- indexesForRelation r
pure $ map f indices
getContainerInfos :: IndexMap -> TypedefInfo -> [((Relation, Index), M.Metadata)]
getContainerInfos indexMap typedefInfo = containerInfos'
where
combinations r idxs =
(r,) <$> Set.toList idxs
toContainerInfo r idx =
let r' = stripIdPrefixes r
meta = M.mkMeta idx $ fromJust $ Map.lookup r' typedefInfo
in ((r, idx), meta)
storesList = Map.foldMapWithKey combinations indexMap
containerInfos' = map (uncurry toContainerInfo) storesList
-- NOTE: only use this index for a total search (all columns constrained)
mkFindIndex :: [a] -> Index
mkFindIndex =
Index . zipWith const [0..]
indexesForRelation :: Relation -> CodegenM [Index]
indexesForRelation r =
Set.toList . fromJust . Map.lookup r . idxMap <$> getLowerState
================================================
FILE: lib/Eclair/RA/Transforms/HoistConstraints.hs
================================================
module Eclair.RA.Transforms.HoistConstraints
( transform
) where
import Eclair.Transform
import Eclair.RA.IR
import Eclair.Comonads
import Eclair.Common.Id
import Eclair.Common.Location (NodeId(..))
import Data.List (partition)
data HoistState
= HoistState
{ seenAliases :: [Id]
, remainingConstraints :: [(NodeId, [Id], RA)]
}
transform :: Transform RA RA
transform =
let beginState = HoistState mempty mempty
in Transform $ usingReaderT beginState . rewrite
where
rewrite = gcata (distribute collectAliases collectConstraints) hoistConstraints
distribute :: Corecursive t
=> (Base t a -> a)
-> (Base t (t, a, b) -> b)
-> (Base t (Quad t a b c) -> Quad t a b (Base t c))
distribute f g m =
let base_t_t = map qFirst m
base_t_a = map qSecond m
base_t_tab = map (\q -> (qFirst q, qSecond q, qThird q)) m
base_t_c = map qFourth m
in Quad (embed base_t_t) (f base_t_a) (g base_t_tab) base_t_c
collectAliases = \case
ColumnIndexF _ alias _ -> one alias
raf -> fold raf
collectConstraints = \case
IfF nodeId condition inner -> do
let cond = getCondition nodeId condition
cond : getValues inner
raf ->
foldMap getValues raf
where
getCondition nodeId (ra, aliases, _) = (nodeId, aliases, ra)
getValues (_, _, values) = values
hoistConstraints = \case
SearchF nodeId r a cs inner -> do
isFirstSearch <- asks (null . seenAliases)
let innerConstraints = qThird inner
withUpdatedEnv = local $
if isFirstSearch
then const $ HoistState [a] innerConstraints
else \s -> s { seenAliases = a : seenAliases s }
withUpdatedEnv $ do
HoistState aliases constraints <- ask
-- partition all the things!
let (covered, rest) = partition (coversAllAliases aliases) constraints
(indexable, nonIndexable) = partition supportsIndex covered
(relationChecks, nonRelationChecks) = partition dependsOnARelation nonIndexable
cs' = map qFirst cs <> map (\(_, _, c) -> c) indexable
addNonRelationConstraints =
nonRelationChecks
& map (\(nodeId', _, cond) -> If nodeId' cond)
& foldl' (.) id
addNonIndexableConstraints =
relationChecks
& map (\(nodeId', _, cond) -> If nodeId' cond)
& foldl' (.) id
let transformSearch =
addNonRelationConstraints
. Search nodeId r a cs'
. addNonIndexableConstraints
local (\s -> s { remainingConstraints = rest }) $ do
transformSearch <$> qFourth inner
ProjectF nodeId r vals -> do
-- NOTE: remaining conditions are not removed here, to support multiple projections in the future.
remaining <- asks (map (\(nodeId', _, cond) -> (nodeId', cond)) . remainingConstraints)
projectStmt <- Project nodeId r <$> traverse qFourth vals
pure $ foldr (\(nodeId', cond) inner -> If nodeId' cond inner) projectStmt remaining
IfF _ _ inner ->
-- NOTE: constraints are already in the state and handled in
-- project and search, so we don't do anything here.
qFourth inner
raf ->
embed <$> traverse qFourth raf
coversAllAliases aliases (_, as, _) =
all (`elem` aliases) as
supportsIndex = \case
(_, _, ra) -> isIndexable ra
isIndexable = \case
CompareOp _ op (ColumnIndex _ a1 _) (ColumnIndex _ a2 _) ->
isIndexableOp op && a1 /= a2
-- Only other relations or constants are allowed to appear in a value.
-- Other relations besides the current alias are "constant" due to the
-- way the algorithm works.
CompareOp _ op (ColumnIndex _ a1 _) value ->
isIndexableOp op && a1 `notElem` cata collectAliases value
CompareOp _ op value (ColumnIndex _ a1 _) ->
isIndexableOp op && a1 `notElem` cata collectAliases value
_ ->
False
-- TODO add pass for RA so <= and >= can be used in an index
isIndexableOp = (== Equals)
dependsOnARelation (_, _, ra) =
let dependencies = flip cata ra $ \case
ColumnIndexF _ a _ -> [a]
raf -> fold raf
in not $ null dependencies
================================================
FILE: lib/Eclair/RA/Transforms.hs
================================================
module Eclair.RA.Transforms
( simplify
) where
import Eclair.Common.Location (NodeId(..))
import Eclair.RA.IR
import Eclair.Transform
import qualified Eclair.RA.Transforms.HoistConstraints as HoistConstraints
simplify :: RA -> RA
simplify = runTransform (NodeId 0)
HoistConstraints.transform
================================================
FILE: lib/Eclair/Souffle/IR.hs
================================================
module Eclair.Souffle.IR
( Souffle(..)
, ConversionError(..)
, toSouffle
) where
import qualified Eclair.AST.IR as AST
import Prettyprinter
import Eclair.Common.Pretty
import Eclair.Common.Literal
import Eclair.Common.Id
import Eclair.Common.Location (NodeId)
import Eclair.Common.Operator
type AST = AST.AST
data Type
= Unsigned
| Symbol
data UsageMode
= Input
| Output
data Souffle
= Lit Literal
| Var Id
| BinOp ArithmeticOp Souffle Souffle
| Constraint LogicalOp Souffle Souffle
| Rule Id [Souffle] [Souffle]
| Not Souffle
| Atom Id [Souffle]
| DeclareType Id [(Maybe Id, Type)]
| DeclareUsage Id UsageMode
| Module [Souffle]
data ConversionError loc
= HoleNotSupported loc
| UnsupportedType loc AST.Type
| UnsupportedCase loc
deriving Functor
toSouffle :: AST -> Either (ConversionError NodeId) Souffle
toSouffle = map Module . cata f
where
f :: AST.ASTF (Either (ConversionError NodeId) [Souffle])
-> Either (ConversionError NodeId) [Souffle]
f = \case
AST.ModuleF _ decls -> do
map mconcat $ sequence decls
AST.DeclareTypeF nodeId name tys usageMode -> do
souffleTys <- traverse (toSouffleArg nodeId) tys
let declType = DeclareType name souffleTys
usageDecls = case usageMode of
AST.Input ->
one $ DeclareUsage name Input
AST.Output ->
one $ DeclareUsage name Output
AST.InputOutput ->
[ DeclareUsage name Input
, DeclareUsage name Output
]
AST.Internal ->
mempty
pure $ declType : usageDecls
AST.AtomF _ name args -> do
args' <- mconcat <$> sequence args
pure $ one $ Atom name args'
AST.RuleF _ name args clauses -> do
args' <- mconcat <$> sequence args
clauses' <- mconcat <$> sequence clauses
pure $ one $ Rule name args' clauses'
AST.VarF _ name ->
pure $ one $ Var name
AST.LitF _ lit ->
pure $ one $ Lit lit
AST.HoleF nodeId ->
throwError $ HoleNotSupported nodeId
AST.BinOpF _ op lhs rhs -> do
lhs' <- lhs
rhs' <- rhs
pure $ BinOp op <$> lhs' <*> rhs'
AST.ConstraintF _ op lhs rhs -> do
lhs' <- lhs
rhs' <- rhs
pure $ Constraint op <$> lhs' <*> rhs'
AST.NotF _ inner -> do
inner' <- inner
pure $ Not <$> inner'
astf ->
let nodeId = AST.getNodeIdF astf
in throwError $ UnsupportedCase nodeId
toSouffleArg :: NodeId -> (Maybe Id, AST.Type) -> Either (ConversionError NodeId) (Maybe Id, Type)
toSouffleArg nodeId = \case
(mName, AST.U32) -> pure (mName, Unsigned)
(mName, AST.Str) -> pure (mName, Symbol)
ty -> throwError $ UnsupportedType nodeId $ snd ty
instance Pretty Type where
pretty = \case
Unsigned -> "unsigned"
Symbol -> "symbol"
data RenderPosition = TopLevel | Nested
instance Pretty Souffle where
pretty souffleIR = runReader (pretty' souffleIR) TopLevel
where
pretty' = \case
Lit x ->
pure $ pretty x
Var v ->
pure $ pretty v
BinOp op lhs rhs -> do
lhs' <- pretty' lhs
rhs' <- pretty' rhs
pure $ parens $ lhs' <+> pretty op <+> rhs'
Constraint op lhs rhs -> do
lhs' <- pretty' lhs
rhs' <- pretty' rhs
pure $ lhs' <+> pretty op <+> rhs'
Not clause ->
("!" <>) <$> pretty' clause
Atom name values -> do
end <- ask <&> \case
TopLevel -> "."
Nested -> mempty
values' <- traverse pretty' values
pure $ pretty name <> parens (withCommas values') <> end
Rule name values clauses -> do
(values', clauses') <- local (const Nested) $ do
(,) <$> traverse pretty' values <*> traverse pretty' clauses
let separators = replicate (length clauses - 1) "," <> ["."]
pure $ pretty name <> parens (withCommas values') <+> ":-" <> hardline <>
indent 2 (vsep (zipWith (<>) clauses' separators))
DeclareType name args -> do
let defaultArgNames = map (\col -> Id $ "arg_" <> show col) [0 :: Int ..]
argNames = zipWith prettyArg args defaultArgNames
argDocs = zipWith (\argName arg -> argName <> ":" <+> pretty (snd arg)) argNames args
pure $ ".decl" <+> pretty name <> parens (withCommas argDocs)
where
prettyArg arg defaultArg =
pretty $ fromMaybe defaultArg $ fst arg
DeclareUsage name usageMode ->
pure $ case usageMode of
Input -> ".input" <+> pretty name
Output -> ".output" <+> pretty name
Module decls -> do
decls' <- traverse pretty' decls
pure $ vsep $ intersperse mempty decls'
================================================
FILE: lib/Eclair/Transform.hs
================================================
module Eclair.Transform
( Transform(..)
, pureTransform
, TransformM
, runTransform
, fixTransform
, freshNodeId
, RewriteRule
, RewriteRuleT
) where
import Eclair.Common.Location (NodeId(..))
-- A helper monad that provides a fresh supply of unused node IDs.
newtype TransformM a
= TransformM (State NodeId a)
deriving (Functor, Applicative, Monad) via State NodeId
-- | Generates a fresh 'NodeId'.
freshNodeId :: TransformM NodeId
freshNodeId = TransformM $ do
node <- get
modify $ \(NodeId y) -> NodeId (y + 1)
pure node
-- | The main type in this module. A transform is an effectful function from
-- one type to another. Usually the type variables 'a' and 'b' represent IRs in
-- the compiler. (These IRs can potentially be the same, which can be useful
-- for creating "rewrite rules"). Transforms can be composed together using the
-- instances and functions defined in this module.
newtype Transform a b
= Transform (a -> TransformM b)
deriving (Semigroup, Monoid) via Ap (Kleisli TransformM a) b
deriving (Category, Arrow) via Kleisli TransformM
-- | Helper function for creating a transform that doesn't require any effects.
pureTransform :: (a -> b) -> Transform a b
pureTransform f =
Transform $ pure . f
-- | Converts a 'Transform' to an equivalent pure function.
-- The 'NodeId' that is passed in is used as a starting point for generating
-- additional IDs during the transform (if necessary).
runTransform :: NodeId -> Transform ir1 ir2 -> ir1 -> ir2
runTransform nodeId (Transform f) ir1 =
runTransformM (f ir1)
where
runTransformM :: TransformM a -> a
runTransformM (TransformM m) =
evalState m nodeId
-- | A function that recursively keeps applying a 'Transform' until a fixpoint
-- is reached and no more changes occur.
fixTransform :: Eq ir => Transform ir ir -> Transform ir ir
fixTransform (Transform f) =
Transform $ fix $ \recur ir -> do
ir' <- f ir
if ir' == ir
then pure ir'
else recur ir'
-- | Helper type synonym for a rewrite rule, making use of the recursion-schemes library.
-- This is the simplest form of rewrite rule, which allows no extra effects
-- except for the state managed by the 'Transform' itself.
type RewriteRule ir = Base ir (TransformM ir) -> TransformM ir
-- | Helper type synonym for a rewrite rule, making use of the recursion-schemes library.
-- This type of rewrite rule allows adding additional effects via the
-- monad transformer 't'.
type RewriteRuleT t ir = Base ir (t TransformM ir) -> t TransformM ir
================================================
FILE: lib/Eclair/TypeSystem.hs
================================================
module Eclair.TypeSystem
( Type(..)
, TypeError(..)
, Context(..)
, getContextLocation
, TypeInfo(..)
, DefinitionType(..)
, TypedefInfo
, ExternDefInfo
, typeCheck
) where
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.DList as DList
import Data.DList (DList)
import qualified Data.DList.DNonEmpty as DNonEmpty
import Data.DList.DNonEmpty (DNonEmpty)
import Control.Monad.Extra
import Eclair.AST.IR
import Eclair.Common.Id
import Eclair.Common.Location (NodeId)
-- NOTE: This module contains a lot of partial functions due to the fact
-- that the rest of the compiler relies heavily on recursion-schemes.
-- This is however one place where I have not figured out how to apply a
-- recursion-scheme here.. yet!
--
-- TODO: Maybe a variant of a mutumorphism might work here?
data DefinitionType
= ConstraintType [Type]
| FunctionType [Type] Type
deriving (Eq, Show)
type ExternDefInfo = Map Id DefinitionType
type TypedefInfo = Map Id [Type]
data TypeInfo
= TypeInfo
{ infoTypedefs :: TypedefInfo -- NOTE: only typedefs are needed, no external definitions
, resolvedTypes :: Map NodeId Type
} deriving Show
instance Semigroup TypeInfo where
TypeInfo tdInfo1 resolved1 <> TypeInfo tdInfo2 resolved2 =
TypeInfo (tdInfo1 <> tdInfo2) (resolved1 <> resolved2)
instance Monoid TypeInfo where
mempty =
TypeInfo mempty mempty
data Context loc
= WhileChecking loc
| WhileInferring loc
| WhileUnifying loc
deriving (Eq, Ord, Show, Functor)
-- NOTE: for now, no actual types are checked since everything is a u32.
data TypeError loc
= UnknownConstraint loc Id
| UnknownFunction loc Id
| ArgCountMismatch Id (loc, Int) (loc, Int)
| TypeMismatch loc Type Type (NonEmpty (Context loc)) -- 1st type is actual, 2nd is expected
| UnificationFailure Type Type (NonEmpty (Context loc))
| HoleFound loc (NonEmpty (Context loc)) Type (Map Id Type)
-- 1st is error location, 2nd is definition location.
| UnexpectedFunctionType loc loc
| UnexpectedConstraintType loc loc
deriving (Eq, Ord, Show, Functor)
-- Only used internally in this module.
type Ctx = Context NodeId
type TypeErr = TypeError NodeId
type DefMap = Map Id (NodeId, DefinitionType)
type UnresolvedHole = Type -> Map Id Type -> TypeErr
data Env
= Env
{ defs :: DefMap
, tcContext :: DNonEmpty Ctx
}
-- State used to report type information back to the user (via LSP)
data TrackingState
= TrackingState
{ directlyResolvedTypes :: Map NodeId Type -- literals are immediately resolved
, trackedVariables :: [(Id, NodeId)]
}
data CheckState
= CheckState
{ typeEnv :: Map Id Type
, substitution :: IntMap Type
, varCounter :: Int
, errors :: DList TypeErr
, unresolvedHoles :: DList (Type, UnresolvedHole)
-- The tracking state is not needed for the typechecking algorithm,
-- but is used to report information back to the user (via LSP).
, trackingState :: TrackingState
}
newtype TypeCheckM a =
TypeCheckM (RWS Env () CheckState a)
deriving (Functor, Applicative, Monad, MonadState CheckState, MonadReader Env)
via (RWS Env () CheckState)
typeCheck :: AST -> Either [TypeErr] TypeInfo
typeCheck ast
| null typeErrors = pure $ TypeInfo (map snd typeDefMap) resolvedTys
| otherwise = throwError typeErrors
where
(typeDefMap, externDefMap) = cata (combine extractTypedefs extractExternDefs) ast
defMap = map (map ConstraintType) typeDefMap <> externDefMap
(typeErrors, resolvedTys) = checkDecls defMap ast
combine f g = f . map fst &&& g . map snd
extractTypedefs = \case
DeclareTypeF nodeId name args _ ->
one (name, (nodeId, map snd args))
AtomF {} -> mempty
RuleF {} -> mempty
astf -> fold astf
extractExternDefs = \case
ExternDefinitionF nodeId name args mRetTy ->
let tys = map snd args
in one (name, (nodeId, maybe (ConstraintType tys) (FunctionType tys) mRetTy))
AtomF {} -> mempty
RuleF {} -> mempty
astf -> fold astf
-- TODO: try to merge with checkDecl?
checkDecls :: DefMap -> AST -> ([TypeErr], Map NodeId Type)
checkDecls defMap = \case
Module _ decls ->
-- NOTE: By using runM once per decl, each decl is checked with a clean state
let results = map (\d -> runM (beginContext d) defMap $ typecheckDecl d) decls
in bimap fold fold $ partitionEithers results
_ ->
panic "Unexpected AST node in 'checkDecls'"
where
beginContext d = WhileChecking (getNodeId d)
typecheckDecl d = do
checkDecl d
processUnresolvedHoles
checkDecl :: AST -> TypeCheckM ()
checkDecl ast = case ast of
DeclareType {} ->
pass
ExternDefinition {} ->
pass
Atom nodeId name args -> do
ctx <- getContext
-- TODO find better way to update context only for non-top level atoms
let isTopLevelFact = isTopLevel ctx
updateCtx = if isTopLevelFact then id else addCtx
updateCtx $ do
lookupRelationType name >>= \case
Just (nodeId', ConstraintType types) -> do
checkArgCount name (nodeId', types) (nodeId, args)
zipWithM_ checkExpr args types
Just (nodeId', FunctionType {}) -> do
emitError $ UnexpectedFunctionType nodeId nodeId'
Nothing ->
emitError $ UnknownConstraint nodeId name
Rule nodeId name args clauses -> do
lookupRelationType name >>= \case
Just (nodeId', ConstraintType types) -> do
checkArgCount name (nodeId', types) (nodeId, args)
zipWithM_ checkExpr args types
Just (nodeId', FunctionType {}) -> do
emitError $ UnexpectedFunctionType nodeId nodeId'
Nothing ->
emitError $ UnknownConstraint nodeId name
traverse_ checkDecl clauses
Constraint nodeId op lhs rhs -> addCtx $ do
if isEqualityOp op
then do
lhsTy <- inferExpr lhs
rhsTy <- inferExpr rhs
-- NOTE: Because inferred types of vars can contain unification variables,
-- we need to try and unify them.
unifyType nodeId lhsTy rhsTy
else do
-- Comparison => both sides need to be numbers
checkExpr lhs U32
checkExpr rhs U32
Not _ clause -> addCtx $ do
checkDecl clause
_ ->
panic "Unexpected case in 'checkDecl'"
where
addCtx = addContext (WhileChecking $ getNodeId ast)
isTopLevel = (== 1) . length
checkArgCount :: Id -> (NodeId, [Type]) -> (NodeId, [AST]) -> TypeCheckM ()
checkArgCount name (nodeIdTypedef, types) (nodeId, args) = do
let actualArgCount = length args
expectedArgCount = length types
when (actualArgCount /= expectedArgCount) $
emitError $ ArgCountMismatch name (nodeIdTypedef, expectedArgCount) (nodeId, actualArgCount)
checkExpr :: AST -> Type -> TypeCheckM ()
checkExpr ast expectedTy = do
let nodeId = getNodeId ast
addContext (WhileChecking nodeId) $ case ast of
l@Lit {} -> do
actualTy <- inferExpr l
-- NOTE: No need to call 'unifyType', types of literals are always concrete types.
when (actualTy /= expectedTy) $ do
ctx <- getContext
emitError $ TypeMismatch nodeId actualTy expectedTy ctx
PWildcard {} ->
-- NOTE: no checking happens for wildcards, since they always refer to
-- unique vars (and thus cannot cause type errors)
trackDirectlyResolvedType nodeId expectedTy
Var _ var -> do
trackVariable nodeId var
lookupVarType var >>= \case
Nothing ->
-- TODO: also store in context/state a variable was bound here for better errors?
bindVar var expectedTy
Just actualTy -> do
when (actualTy /= expectedTy) $ do
ctx <- getContext
emitError $ TypeMismatch nodeId actualTy expectedTy ctx
Hole {} -> do
holeTy <- emitHoleFoundError nodeId
unifyType nodeId holeTy expectedTy
BinOp _ _ lhs rhs -> do
-- Arithmetic expressions always need to be numbers.
checkExpr lhs U32
checkExpr rhs U32
Atom _ name args -> do
lookupRelationType name >>= \case
Just (nodeId', FunctionType types actualRetTy) -> do
checkArgCount name (nodeId', types) (nodeId, args)
zipWithM_ checkExpr args types
when (actualRetTy /= expectedTy) $ do
ctx <- getContext
emitError $ TypeMismatch nodeId actualRetTy expectedTy ctx
Just (nodeId', ConstraintType {}) -> do
emitError $ UnexpectedConstraintType nodeId nodeId'
Nothing ->
emitError $ UnknownFunction nodeId name
e -> do
-- Basically an unexpected / unhandled case => try inferring as a last resort.
actualTy <- inferExpr e
unifyType (getNodeId e) actualTy expectedTy
inferExpr :: AST -> TypeCheckM Type
inferExpr ast = do
let nodeId = getNodeId ast
addContext (WhileInferring nodeId) $ case ast of
Lit _ lit -> do
let ty = case lit of
LNumber {} -> U32
LString {} -> Str
trackDirectlyResolvedType nodeId ty
pure ty
Var _ var -> do
trackVariable nodeId var
lookupVarType var >>= \case
Nothing -> do
ty <- freshType
-- This introduces potentially a unification variable into the type environment, but we need this
-- for complicated rule bodies where a variable occurs in more than one place.
-- (Otherwise a variable is treated as new each time).
bindVar var ty
pure ty
Just ty ->
pure ty
Hole {} ->
emitHoleFoundError nodeId
BinOp _ _ lhs rhs -> do
-- Arithmetic expressions always need to be numbers.
checkExpr lhs U32
checkExpr rhs U32
pure U32
Atom _ name args -> do
lookupRelationType name >>= \case
Just (nodeId', FunctionType types retTy) -> do
checkArgCount name (nodeId', types) (nodeId, args)
zipWithM_ checkExpr args types
pure retTy
Just (nodeId', ConstraintType {}) -> do
emitError $ UnexpectedConstraintType nodeId nodeId'
-- We generate a fresh type which will always unify, but typechecking will fail anyway
freshType
Nothing -> do
emitError $ UnknownFunction nodeId name
-- We generate a fresh type which will always unify, but typechecking will fail anyway
freshType
_ ->
panic "Unexpected case in 'inferExpr'"
runM :: Ctx -> DefMap -> TypeCheckM a -> Either [TypeErr] (Map NodeId Type)
runM ctx defMap action =
let (TypeCheckM m) = action *> computeTypeInfoById
trackState = TrackingState mempty mempty
tcState = CheckState mempty mempty 0 mempty mempty trackState
env = Env defMap (pure ctx)
(typeInfoById, endState, _) = runRWS m env tcState
errs = toList . errors $ endState
in if null errs then Right typeInfoById else Left errs
emitError :: TypeErr -> TypeCheckM ()
emitError err =
modify $ \s -> s { errors = DList.snoc (errors s) err }
bindVar :: Id -> Type -> TypeCheckM ()
bindVar var ty =
modify $ \s -> s { typeEnv = Map.insert var ty (typeEnv s) }
lookupRelationType :: Id -> TypeCheckM (Maybe (NodeId, DefinitionType))
lookupRelationType name =
asks (Map.lookup name . defs)
-- A variable can either be a concrete type, or a unification variable.
-- In case of unification variable, try looking it up in current substitution.
-- As a result, this will make it so variables in a rule body with same name have the same type.
-- NOTE: if this ends up not being powerful enough, need to upgrade to SCC + a solver for each group of "linked" variables.
lookupVarType :: Id -> TypeCheckM (Maybe Type)
lookupVarType var = do
(maybeVarTy, subst) <- gets (Map.lookup var . typeEnv &&& substitution)
case maybeVarTy of
Just (TUnknown u) -> pure $ IntMap.lookup u subst
maybeTy -> pure maybeTy
-- Generates a fresh unification variable.
freshType :: TypeCheckM Type
freshType = do
x <- gets varCounter
modify $ \s -> s { varCounter = varCounter s + 1 }
pure $ TUnknown x
-- | Tries to unify 2 types, emitting an error in case it fails to unify.
unifyType :: NodeId -> Type -> Type -> TypeCheckM ()
unifyType nodeId t1 t2 = addContext (WhileUnifying nodeId) $ do
subst <- gets substitution
unifyType' (substituteType subst t1) (substituteType subst t2)
where
unifyType' ty1 ty2 =
case (ty1, ty2) of
(U32, U32) ->
pass
(Str, Str) ->
pass
(TUnknown x, TUnknown y) | x == y ->
pass
(TUnknown u, ty) ->
updateSubst u ty
(ty, TUnknown u) ->
updateSubst u ty
_ -> do
ctx <- getContext
emitError $ UnificationFailure ty1 ty2 ctx
-- Update the current substitutions
updateSubst :: Int -> Type -> TypeCheckM ()
updateSubst u ty =
modify $ \s ->
s { substitution = IntMap.insert u ty (substitution s) }
-- Recursively applies a substitution to a type
substituteType :: IntMap Type -> Type -> Type
substituteType subst = \case
U32 ->
U32
Str ->
Str
TUnknown unknown ->
case IntMap.lookup unknown subst of
Nothing ->
TUnknown unknown
Just (TUnknown unknown') | unknown == unknown' ->
TUnknown unknown
Just ty ->
substituteType subst ty
computeTypeInfoById :: TypeCheckM (Map NodeId Type)
computeTypeInfoById = do
ts <- gets trackingState
let vars = Map.toList $ Map.fromListWith (<>) $ one <<$>> trackedVariables ts
resolvedVarTypes <- flip concatMapM vars $ \(var, nodeIds) -> do
varTy <- lookupVarType var
pure $ mapMaybe (\nodeId -> (nodeId,) <$> varTy) nodeIds
pure $ directlyResolvedTypes ts <> Map.fromList resolvedVarTypes
addContext :: Ctx -> (TypeCheckM a -> TypeCheckM a)
addContext ctx = local $ \env ->
env { tcContext = tcContext env `DNonEmpty.snoc` ctx }
getContext :: TypeCheckM (NonEmpty Ctx)
getContext =
asks (DNonEmpty.toNonEmpty . tcContext)
getContextLocation :: Context loc -> loc
getContextLocation = \case
WhileChecking loc -> loc
WhileInferring loc -> loc
WhileUnifying loc -> loc
emitHoleFoundError :: NodeId -> TypeCheckM Type
emitHoleFoundError nodeId = do
ty <- freshType -- We generate a fresh type, and use this later to figure out the type of the hole.
ctx <- getContext
modify' $ \s ->
s { unresolvedHoles = DList.snoc (unresolvedHoles s) (ty, HoleFound nodeId ctx) }
pure ty
processUnresolvedHoles :: TypeCheckM ()
processUnresolvedHoles = do
holes <- gets (toList . unresolvedHoles)
unless (null holes) $ do
(env, subst) <- gets (typeEnv &&& substitution)
let solvedEnv = map (substituteType subst) env
forM_ holes $ \(holeTy, hole) ->
emitError $ hole (substituteType subst holeTy) solvedEnv
modify' $ \s -> s { unresolvedHoles = mempty }
trackDirectlyResolvedType :: NodeId -> Type -> TypeCheckM ()
trackDirectlyResolvedType nodeId ty = do
ts <- gets trackingState
let ts' = ts { directlyResolvedTypes = directlyResolvedTypes ts <> one (nodeId, ty) }
modify $ \s -> s { trackingState = ts' }
trackVariable :: NodeId -> Id -> TypeCheckM ()
trackVariable nodeId var = do
ts <- gets trackingState
let ts' = ts { trackedVariables = (var, nodeId) : trackedVariables ts }
modify $ \s -> s { trackingState = ts' }
================================================
FILE: lib/Eclair.hs
================================================
{-# LANGUAGE GADTs, StandaloneDeriving #-}
module Eclair
( parse
, semanticAnalysis
, typeCheck
, emitDiagnostics
, emitTransformedAST
, emitRA
, emitTransformedRA
, emitEIR
, emitLLVM
, emitSouffle
, Parameters(..)
, EclairError(..)
, handleErrorsCLI
) where
import Control.Exception
import Eclair.AST.Lower
import Eclair.RA.Lower
import Eclair.EIR.Lower
import Eclair.Parser
import Eclair.Common.Pretty
import Eclair.Error
import Eclair.Common.Id
import Eclair.Common.Location
import Eclair.Common.Extern
import Eclair.Common.Config (Target(..))
import Eclair.AST.IR
import Eclair.AST.Transforms (StringMap)
import Eclair.Souffle.IR
import qualified Eclair.AST.Transforms as AST
import qualified Eclair.RA.IR as RA
import qualified Eclair.RA.Transforms as RA
import qualified Eclair.EIR.IR as EIR
import qualified Eclair.TypeSystem as TS
import qualified Eclair.AST.Analysis as SA
import LLVM.Codegen (Module, ppllvm)
import qualified Rock
import Data.GADT.Compare
import Data.Some
import Data.Type.Equality
type RA = RA.RA
type EIR = EIR.EIR
data Query a where
Parse :: FilePath -> Query (AST, NodeId, SpanMap)
RunSemanticAnalysis :: FilePath -> Query SA.SemanticInfo
Typecheck :: FilePath -> Query TS.TypeInfo
EmitDiagnostics :: FilePath -> Query ()
TransformAST :: FilePath -> Query (AST, StringMap)
EmitTransformedAST :: FilePath -> Query ()
CompileRA :: FilePath -> Query RA
TransformRA :: FilePath -> Query RA
EmitRA :: FilePath -> Query ()
EmitTransformedRA :: FilePath -> Query ()
CompileEIR :: FilePath -> Query EIR
EmitEIR :: FilePath -> Query ()
CompileLLVM :: FilePath -> Query Module
EmitLLVM :: FilePath -> Query ()
EmitSouffle :: FilePath -> Query ()
StringMapping :: FilePath -> Query (Map Text Word32)
UsageMapping :: FilePath -> Query (Map Id UsageMode)
ExternDefinitions :: FilePath -> Query [Extern]
deriving instance Eq (Query a)
instance GEq Query where
geq a b = case (a, b) of
(Parse file1, Parse file2) | file1 == file2 -> Just Refl
(RunSemanticAnalysis file1, RunSemanticAnalysis file2) | file1 == file2 -> Just Refl
(Typecheck file1, Typecheck file2) | file1 == file2 -> Just Refl
(EmitDiagnostics file1, EmitDiagnostics file2) | file1 == file2 -> Just Refl
(TransformAST file1, TransformAST file2) | file1 == file2 -> Just Refl
(EmitTransformedAST file1, EmitTransformedAST file2) | file1 == file2 -> Just Refl
(CompileRA file1, CompileRA file2) | file1 == file2 -> Just Refl
(TransformRA file1, TransformRA file2) | file1 == file2 -> Just Refl
(EmitRA file1, EmitRA file2) | file1 == file2 -> Just Refl
(EmitTransformedRA file1, EmitTransformedRA file2) | file1 == file2 -> Just Refl
(CompileEIR file1, CompileEIR file2) | file1 == file2 -> Just Refl
(EmitEIR file1, EmitEIR file2) | file1 == file2 -> Just Refl
(CompileLLVM file1, CompileLLVM file2) | file1 == file2 -> Just Refl
(EmitLLVM file1, EmitLLVM file2) | file1 == file2 -> Just Refl
(EmitSouffle file1, EmitSouffle file2) | file1 == file2 -> Just Refl
(StringMapping file1, StringMapping file2) | file1 == file2 -> Just Refl
(UsageMapping file1, UsageMapping file2) | file1 == file2 -> Just Refl
(ExternDefinitions file1, ExternDefinitions file2) | file1 == file2 -> Just Refl
_ -> Nothing
queryFilePath :: Query a -> FilePath
queryFilePath = \case
Parse path -> path
RunSemanticAnalysis path -> path
Typecheck path -> path
EmitDiagnostics path -> path
TransformAST path -> path
EmitTransformedAST path -> path
CompileRA path -> path
TransformRA path -> path
EmitRA path -> path
EmitTransformedRA path -> path
CompileEIR path -> path
EmitEIR path -> path
CompileLLVM path -> path
EmitLLVM path -> path
EmitSouffle path -> path
StringMapping path -> path
UsageMapping path -> path
ExternDefinitions path -> path
queryEnum :: Query a -> Int
queryEnum = \case
Parse {} -> 0
RunSemanticAnalysis {} -> 1
Typecheck {} -> 2
EmitDiagnostics {} -> 3
TransformAST {} -> 4
EmitTransformedAST {} -> 5
CompileRA {} -> 6
TransformRA {} -> 7
EmitRA {} -> 8
EmitTransformedRA {} -> 9
CompileEIR {} -> 10
EmitEIR {} -> 11
CompileLLVM {} -> 12
EmitLLVM {} -> 13
EmitSouffle {} -> 14
StringMapping {} -> 15
UsageMapping {} -> 16
ExternDefinitions {} -> 17
instance Hashable (Query a) where
hashWithSalt salt =
hashWithSalt salt . (queryFilePath &&& queryEnum)
instance Hashable (Some Query) where
hashWithSalt salt (Some query) =
hashWithSalt salt query
data Parameters
= Parameters
{ paramsNumCores :: Word
, paramsTarget :: !(Maybe Target)
, paramsReadSourceFile :: FilePath -> IO (Maybe Text)
}
rules :: Rock.Task Query ()
-> Parameters
-> Rock.GenRules (Rock.Writer [EclairError] Query) Query
rules abortOnError params (Rock.Writer query) = case query of
Parse path -> liftIO $ do
(ast, nodeId, spanMap, mParseErr) <- parseFile (paramsReadSourceFile params) path
pure ((ast, nodeId, spanMap), ParseErr path <$> maybeToList mParseErr)
RunSemanticAnalysis path -> do
(ast, _, spans) <- Rock.fetch (Parse path)
result <- liftIO $ SA.runAnalysis (paramsNumCores params) ast
let errs = if SA.hasSemanticErrors result
then one $ SemanticErr path spans $ SA.semanticErrors result
else mempty
pure (SA.semanticInfo result, errs)
Typecheck path -> do
(ast, _, spans) <- Rock.fetch (Parse path)
case TS.typeCheck ast of
Left err ->
pure (mempty, one $ TypeErr path spans err)
Right typeInfo ->
pure (typeInfo, mempty)
EmitDiagnostics path -> noError $ do
-- Just triggering these tasks collects all the corresponding errors.
_ <- Rock.fetch (Parse path)
_ <- Rock.fetch (RunSemanticAnalysis path)
_ <- Rock.fetch (Typecheck path)
pass
TransformAST path -> noError $ do
-- Need to run SA and typechecking before any transformations / lowering
-- to ensure we don't perform work on invalid programs.
-- And thanks to rock, the results will be cached anyway.
analysis <- Rock.fetch (RunSemanticAnalysis path)
_ <- Rock.fetch (Typecheck path)
-- Past this point, the code should be valid!
-- We abort if this is not the case.
abortOnError
(ast, nodeId, _) <- Rock.fetch (Parse path)
externDefs <- Rock.fetch (ExternDefinitions path)
pure $ AST.simplify nodeId externDefs analysis ast
EmitTransformedAST path -> noError $ do
(ast, _) <- Rock.fetch (TransformAST path)
liftIO $ putTextLn $ printDoc ast
StringMapping path -> noError $ do
(_, mapping) <- Rock.fetch (TransformAST path)
pure mapping
UsageMapping path -> noError $ do
(ast, _, _) <- Rock.fetch (Parse path)
pure $ SA.computeUsageMapping ast
ExternDefinitions path -> noError $ do
(ast, _, _) <- Rock.fetch (Parse path)
pure $ getExternDefs ast
CompileRA path -> noError $ do
ast <- fst <$> Rock.fetch (TransformAST path)
externDefs <- Rock.fetch (ExternDefinitions path)
pure $ compileToRA externDefs ast
TransformRA path -> noError $ do
ra <- Rock.fetch (CompileRA path)
pure $ RA.simplify ra
EmitRA path -> noError $ do
ra <- Rock.fetch (CompileRA path)
liftIO $ putTextLn $ printDoc ra
EmitTransformedRA path -> noError $ do
ra <- Rock.fetch (TransformRA path)
liftIO $ putTextLn $ printDoc ra
CompileEIR path -> noError $ do
stringMapping <- Rock.fetch (StringMapping path)
ra <- Rock.fetch (TransformRA path)
typeInfo <- Rock.fetch (Typecheck path)
pure $ compileToEIR stringMapping (TS.infoTypedefs typeInfo) ra
EmitEIR path -> noError $ do
eir <- Rock.fetch (CompileEIR path)
liftIO $ putTextLn $ printDoc eir
CompileLLVM path -> noError $ do
eir <- Rock.fetch (CompileEIR path)
stringMapping <- Rock.fetch (StringMapping path)
usageMapping <- Rock.fetch (UsageMapping path)
externDefs <- Rock.fetch (ExternDefinitions path)
liftIO $ compileToLLVM (paramsTarget params) stringMapping usageMapping externDefs eir
EmitLLVM path -> noError $ do
llvmModule <- Rock.fetch (CompileLLVM path)
liftIO $ putTextLn $ ppllvm llvmModule
EmitSouffle path -> do
(ast, _, spanMap) <- Rock.fetch (Parse path)
case toSouffle ast of
Left err ->
pure ((), one $ ConversionErr path spanMap err)
Right souffleIR -> do
liftIO $ putTextLn $ printDoc souffleIR
pure ((), mempty)
-- Helper function for tasks that don't emit any errors.
noError :: Rock.Task Query a -> Rock.Task Query (a, [EclairError])
noError task =
(, mempty) <$> task
type CompilerM a = IO (Either [EclairError] a)
data Aborted = Aborted
deriving (Show, Exception)
runQuery :: Parameters -> Query a -> CompilerM a
runQuery params query = do
memoVar <- newIORef mempty
errRef <- newIORef mempty
let onError :: q -> [EclairError] -> Rock.Task Query ()
onError _ errs =
liftIO $ modifyIORef errRef (<> errs)
abortOnError = do
errs <- readIORef errRef
unless (null errs) $
liftIO $ throwIO Aborted
handleAbort =
handle $ \Aborted -> do
errs <- readIORef errRef
pure $ Left errs
task = Rock.fetch query
handleAbort $ do
result <- Rock.runTask (Rock.memoise memoVar $ Rock.writer onError $ rules abortOnError params) task
errs <- readIORef errRef
pure $ if null errs then Right result else Left errs
parse :: Parameters -> FilePath -> CompilerM (AST, SpanMap)
parse params =
map (map (\(ast, _, spanMap) -> (ast, spanMap))) . runQuery params . Parse
semanticAnalysis :: Parameters -> FilePath -> CompilerM SA.SemanticInfo
semanticAnalysis params =
runQuery params . RunSemanticAnalysis
typeCheck :: Parameters -> FilePath -> CompilerM TS.TypeInfo
typeCheck params =
runQuery params . Typecheck
emitDiagnostics :: Parameters -> FilePath -> IO [EclairError]
emitDiagnostics params = do
f <<$>> runQuery params . EmitDiagnostics
where
f = fromLeft mempty
emitTransformedAST :: Parameters -> FilePath -> CompilerM ()
emitTransformedAST params =
runQuery params . EmitTransformedAST
emitRA :: Parameters -> FilePath -> CompilerM ()
emitRA params =
runQuery params . EmitRA
emitTransformedRA :: Parameters -> FilePath -> CompilerM ()
emitTransformedRA params =
runQuery params . EmitTransformedRA
emitEIR :: Parameters -> FilePath -> CompilerM ()
emitEIR params =
runQuery params . EmitEIR
emitLLVM :: Parameters -> FilePath -> CompilerM ()
emitLLVM params =
runQuery params . EmitLLVM
emitSouffle :: Parameters -> FilePath -> CompilerM ()
emitSouffle params =
runQuery params . EmitSouffle
================================================
FILE: lib/Prelude.hs
================================================
module Prelude
( module Relude
, module Control.Arrow
, module Control.Monad.Writer.Strict
, module Control.Monad.RWS.Strict
, module Control.Monad.Except
, module Control.Monad.Fix
, module Control.Category
, module Control.Comonad
, module Data.Functor.Foldable
, module Data.Functor.Foldable.TH
, module GHC.TypeLits
, module GHC.Generics
, module GHC.Records
, IsString(..)
, map
, panic
, groupBy
, modifyMVar_
, uniqOrderPreserving
) where
import Relude hiding ( Type, Constraint, Op
, and, or, id, (.), map, first
, absurd
)
import Control.Arrow hiding (second, loop, (<+>))
import Control.Comonad
import Control.Category
import Control.Concurrent.MVar (modifyMVar_)
import Control.Monad.Writer.Strict hiding (pass)
import Control.Monad.RWS.Strict hiding (pass)
import Control.Monad.Except
import Control.Monad.Fix
import Data.Functor.Foldable hiding (fold, unfold, refold, hoist)
import Data.Functor.Foldable.TH
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import GHC.Generics (Rep, K1(..), U1(..), M1(..), (:*:)(..), from, to)
import GHC.Records (HasField(..))
import qualified Data.List.Extra as E
map :: Functor f => (a -> b) -> f a -> f b
map = fmap
{-# INLINABLE map #-}
panic :: Text -> a
panic = error
groupBy :: (a -> a -> Bool) -> [a] -> [NonEmpty a]
groupBy eq = \case
[] -> []
(x:xs) -> (x :| ys) : groupBy eq zs
where (ys,zs) = span (eq x) xs
uniqOrderPreserving :: Ord a => [a] -> [a]
uniqOrderPreserving =
map snd . sortWith fst . E.nubOrdOn snd . zip [0 :: Int ..]
================================================
FILE: src/eclair/Main.hs
================================================
module Main (main) where
import Eclair.ArgParser
import Eclair.LSP
import Eclair
import GHC.IO.Encoding
import System.Directory
import qualified Data.Text.IO as TIO
tryReadFile :: FilePath -> IO (Maybe Text)
tryReadFile file = do
fileExists <- doesFileExist file
if fileExists
then Just . decodeUtf8 <$> readFileBS file
else pure Nothing
main :: IO ()
main = do
setLocaleEncoding utf8
arguments <- getArgs
parseArgs arguments >>= \case
Compile cfg -> do
let file = mainFile cfg
fn = case emitKind cfg of
EmitTransformedAST -> emitTransformedAST
EmitRA -> emitRA
EmitTransformedRA -> emitTransformedRA
EmitEIR -> emitEIR
EmitLLVM -> emitLLVM
EmitSouffle -> emitSouffle
params = Parameters (numCores cfg) (cpuTarget cfg) tryReadFile
whenLeftM_ (fn params file) $ \errs -> do
let errActions =
errs & map handleErrorsCLI
& intersperse (TIO.hPutStr stderr "\n")
sequence_ errActions
LSP ->
lspMain
================================================
FILE: tests/.gitignore
================================================
/**/.lit_test_times.txt
Output/
================================================
FILE: tests/ast_transforms/constant_folding.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ast-transformed %t/program.eclair > %t/actual.out
// RUN: diff %t/expected.out %t/actual.out
//--- program.eclair
@def number(u32) input.
@def arithmetic(u32) output.
@def arithmetic2(u32, u32) output.
arithmetic(123 + 456).
arithmetic(456 - 123).
arithmetic(123 * 456).
arithmetic(123 / 456).
arithmetic(123 * 456 + 789).
arithmetic(x) :-
number(x),
x = 123 + (456 * 789).
arithmetic(x) :-
number(x),
number(y),
x = y + 1,
x = 1 + y,
x = y + y.
arithmetic2(x, y) :-
number(x),
number(y),
x = 1 + y,
y = x + 1.
//--- expected.out
@def number(u32) input.
@def arithmetic(u32) output.
@def arithmetic2(u32, u32) output.
arithmetic(579).
arithmetic(333).
arithmetic(56088).
arithmetic(0).
arithmetic(56877).
arithmetic(x) :-
number(x),
x = 359907.
arithmetic(x) :-
number(x),
number(y),
x = (y + 1),
x = (1 + y),
x = (y + y).
arithmetic2(x, y) :-
number(x),
number(y),
x = (1 + y),
y = (x + 1).
================================================
FILE: tests/ast_transforms/copy_propagation.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ast-transformed %t/program.eclair > %t/actual.out
// RUN: diff %t/expected.out %t/actual.out
//--- program.eclair
@def fact1(u32, u32) input.
@def fact2(u32) output.
@def fact3(u32) input.
@def fact4(u32, u32) output.
@def fact5(u32) output.
fact2(x) :-
x = y,
fact1(x, z),
y = z.
fact2(x) :-
x = y,
y = z,
fact1(x, z).
fact2(x) :-
z = x,
x = y,
y = z,
fact1(x, z).
fact2(x) :-
y = x,
y = z,
fact1(x, z).
fact2(x) :-
z = x,
fact1(x, z).
fact4(y, z) :-
fact3(x),
y = x + 3,
y = x - 1,
y = z + y,
z = y + x.
fact5(y) :-
fact3(x),
y = x + 3.
//--- expected.out
@def fact1(u32, u32) input.
@def fact2(u32) output.
@def fact3(u32) input.
@def fact4(u32, u32) output.
@def fact5(u32) output.
fact2(x) :-
fact1(x, z),
x = z.
fact2(x) :-
fact1(x, z),
x = z.
fact2(x) :-
fact1(x, z),
z = x,
x = z.
fact2(x) :-
fact1(x, z),
z = x.
fact2(x) :-
fact1(x, z),
z = x.
fact4((x - 1), ((x - 1) + x)) :-
fact3(x),
(x - 1) = (x + 3),
(x - 1) = (((x - 1) + x) + (x - 1)).
fact5((x + 3)) :-
fact3(x).
================================================
FILE: tests/ast_transforms/dead_code_elimination.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile %t/program1.eclair --emit ast-transformed > %t/actual1.out
// RUN: diff %t/expected1.out %t/actual1.out
//--- program1.eclair
@def empty_output(u32) output.
@def unused_input(u32) input.
@def unused_internal(u32).
@def unused_rule(u32).
@def another_input(u32) input.
unused_internal(1).
unused_rule(x) :-
another_input(x).
@def live1(u32) input output.
@def live2(u32) output.
@def live3(u32).
@def live4(u32) output.
@def live5(u32) input.
@def live6(u32).
@def live7(u32) output.
@def live8(u32) output.
@extern func(field1: u32) u32.
@extern func2(u32) u32.
@extern constraint(field1: u32).
live2(123).
live3(x) :-
live2(x).
live4(x) :-
live3(x).
live6(x) :-
live5(x).
live7(x) :-
live6(x),
x = func(123),
constraint(x).
live8(x) :-
live6(x),
func2(123) = x.
// NOTE: Rule with contradictions is tested in another file already.
//--- expected1.out
@def live1(u32) input output.
@def live2(u32) output.
@def live3(u32).
@def live4(u32) output.
@def live5(u32) input.
@def live6(u32).
@def live7(u32) output.
@def live8(u32) output.
@extern func(field1: u32) u32.
@extern func2(u32) u32.
@extern constraint(field1: u32).
live2(123).
live3(x) :-
live2(x).
live4(x) :-
live3(x).
live6(x) :-
live5(x).
live7(x) :-
live6(x),
constraint(x),
x = func(123).
live8(x) :-
live6(x),
func2(123) = x.
================================================
FILE: tests/ast_transforms/remove_contradictions.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ast-transformed %t/program.eclair > %t/actual.out
// RUN: diff %t/expected.out %t/actual.out
//--- program.eclair
@def fact1(u32) input.
@def fact2(u32) output.
fact2(x) :-
123 = 456,
fact1(x).
fact2(x) :-
"abc" = "def",
fact1(x).
fact2(x) :-
x = 123,
x = 456,
fact1(x).
fact2(x) :-
y = "abc",
y = "def",
fact1(x).
fact2(x) :-
x = 123,
x = y,
y = z,
fact1(x),
z = 456.
//--- expected.out
@def fact1(u32) input.
@def fact2(u32) output.
================================================
FILE: tests/ast_transforms/shift_assignments.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ast-transformed %t/program1.eclair > %t/actual1.out
// RUN: diff %t/expected1.out %t/actual1.out
// RUN: %eclair compile --emit ast-transformed %t/program2.eclair > %t/actual2.out
// RUN: diff %t/expected2.out %t/actual2.out
//--- program1.eclair
@def fact1(u32, u32) input.
@def fact2(u32, u32) output.
fact2(x, 1) :-
z = x,
fact1(x, z),
y = 123,
fact1(y, x).
fact2(x, y) :-
123 = x,
fact1(y, x).
//--- expected1.out
@def fact1(u32, u32) input.
@def fact2(u32, u32) output.
fact2(x, 1) :-
fact1(x, z),
fact1(y, x),
z = x,
y = 123.
fact2(x, y) :-
fact1(y, x),
123 = x.
//--- program2.eclair
@def edge(u32, u32) input.
@def path(u32, u32) output.
edge(1,2).
path(x, y) :-
edge(x, z),
path(z, y).
//--- expected2.out
@def edge(u32, u32) input.
@def path(u32, u32) output.
edge(1, 2).
path(x, y) :-
edge(x, z),
path(z, y).
================================================
FILE: tests/check.sh
================================================
#!/bin/bash
grep -rE "(fdescribe|fit)" tests/eclair
if [ "$?" == "0" ]; then
echo "Found disabled tests (marked with fdescribe / fit), aborting!"
exit 1
fi
grep -rE "(\sxit|pending)" tests/eclair/Test
if [ "$?" == "0" ]; then
echo "Found pending tests, aborting!"
exit 1
fi
echo "All tests are enabled!"
exit 0
================================================
FILE: tests/eclair/Test/Eclair/ArgParserSpec.hs
================================================
module Test.Eclair.ArgParserSpec
( module Test.Eclair.ArgParserSpec
) where
import Test.Hspec
import qualified Data.Text as T
import Eclair.ArgParser
import Control.Exception
import System.IO.Silently
import System.Exit
parseArgs' :: Text -> IO Config
parseArgs' args =
parseArgs (map toString $ T.split (== ' ') args)
shouldFail :: IO a -> IO ()
shouldFail m = hSilence [stderr] $ do
void m `catch` handler
where
handler = \case
ExitFailure 1 -> pass
e -> panic $ "Unknown error: " <> show e
spec :: Spec
spec = describe "argument parsing" $ do
describe "compile mode" $ parallel $ do
it "supports 'compile' as the command" $ do
cfg <- parseArgs' "compile test.dl"
cfg `shouldBe` Compile (CompileConfig "test.dl" EmitLLVM Nothing 1)
it "supports 'c' as the command" $ do
cfg <- parseArgs' "c test.dl"
cfg `shouldBe` Compile (CompileConfig "test.dl" EmitLLVM Nothing 1)
it "supports no other commands" $ do
shouldFail $ parseArgs' "unknown"
shouldFail $ parseArgs' "unknown arg1"
it "requires a main file" $ do
shouldFail $ parseArgs' "c"
it "supports emitting RA" $ do
for_ ["ra", "RA"] $ \ra -> do
cfg <- parseArgs' $ "c test.dl --emit " <> ra
cfg `shouldBe` Compile (CompileConfig "test.dl" EmitRA Nothing 1)
it "supports emitting EIR" $ do
for_ ["eir", "EIR"] $ \eir -> do
cfg <- parseArgs' $ "c test.dl --emit " <> eir
cfg `shouldBe` Compile (CompileConfig "test.dl" EmitEIR Nothing 1)
it "supports emitting LLVM IR" $ do
for_ ["llvm", "LLVM"] $ \llvm -> do
cfg <- parseArgs' $ "c test.dl --emit " <> llvm
cfg `shouldBe` Compile (CompileConfig "test.dl" EmitLLVM Nothing 1)
it "does not support emitting anything else" $ do
shouldFail $ parseArgs' "c test.dl --emit unknown-ir"
it "defaults to emitting LLVM IR" $ do
cfg <- parseArgs' "c test.dl"
cfg `shouldBe` Compile (CompileConfig "test.dl" EmitLLVM Nothing 1)
it "parses wasm32 as target architecture" $ do
cfg <- parseArgs' "c test.dl -t wasm32"
cfg `shouldBe` Compile (CompileConfig "test.dl" EmitLLVM (Just Wasm32) 1)
cfg2 <- parseArgs' "c test.dl --target wasm32"
cfg2 `shouldBe` Compile (CompileConfig "test.dl" EmitLLVM (Just Wasm32) 1)
it "defaults to using 1 job" $ do
cfg <- parseArgs' "c test.dl --emit llvm"
cfg `shouldBe` Compile (CompileConfig "test.dl" EmitLLVM Nothing 1)
it "is possible to configure number of jobs" $ do
cfg <- parseArgs' "c test.dl --emit llvm -j 8"
cfg `shouldBe` Compile (CompileConfig "test.dl" EmitLLVM Nothing 8)
================================================
FILE: tests/eclair/Test/Eclair/JSONSpec.hs
================================================
{-# LANGUAGE QuasiQuotes #-}
module Test.Eclair.JSONSpec
( module Test.Eclair.JSONSpec
) where
import Eclair.JSON
import Test.Hspec
import NeatInterpolation
spec :: Spec
spec = describe "JSON encoding" $ parallel $ do
it "can encode null" $ do
encodeJSON Null `shouldBe` "null"
it "can encode booleans" $ do
encodeJSON (Boolean True) `shouldBe` "true"
encodeJSON (Boolean False) `shouldBe` "false"
it "can encode strings" $ do
encodeJSON (String "abcdef") `shouldBe` [text|"abcdef"|]
encodeJSON (String "123") `shouldBe` [text|"123"|]
it "can encode integers" $ do
encodeJSON (Number 42) `shouldBe` "42"
encodeJSON (Number 123) `shouldBe` "123"
it "can encode objects" $ do
encodeJSON (Object [("line", Number 10), ("column", Number 33)]) `shouldBe` [text|
{"line":10,"column":33}
|]
encodeJSON (Object [("a", Null), ("b", Boolean True)]) `shouldBe` [text|
{"a":null,"b":true}
|]
it "can encode arrays" $ do
encodeJSON (Array []) `shouldBe` "[]"
encodeJSON (Array [Number 123, String "abc", Null]) `shouldBe` [text|
[123,"abc",null]
|]
================================================
FILE: tests/eclair/Test/Eclair/LLVM/Allocator/MallocSpec.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.Eclair.LLVM.Allocator.MallocSpec
( module Test.Eclair.LLVM.Allocator.MallocSpec
) where
import Prelude hiding (void)
import Eclair.LLVM.Allocator.Malloc
import Eclair.LLVM.Allocator.Common
import Eclair.LLVM.Codegen hiding (retVoid, nullPtr)
import System.Directory.Extra
import System.Posix.DynamicLinker
import Control.Exception
import Foreign.Ptr
import Foreign hiding (void)
import Test.Eclair.LLVM.Allocator.Utils
import Test.Hspec
data Mallocator
spec :: Spec
spec = describe "Mallocator" $ aroundAll (setupAndTeardown testDir) $ parallel $ do
it "can be initialized and destroyed" $ \bindings ->
withAlloc bindings $ \obj -> do
fnInit bindings obj
fnDestroy bindings obj
it "can allocate and free memory" $ \bindings -> do
let numBytes = 1
value = 42
withAlloc bindings $ \obj -> do
fnInit bindings obj
memory <- fnAlloc bindings obj numBytes
memory `shouldNotBe` nullPtr
poke memory value
value' <- peek memory
fnFree bindings obj memory numBytes
fnDestroy bindings obj
value' `shouldBe` value
setupAndTeardown :: FilePath -> ActionWith (Bindings Mallocator) -> IO ()
setupAndTeardown dir =
bracket (setup dir) teardown
setup :: FilePath -> IO (Bindings Mallocator)
setup dir = do
createDirectoryIfMissing False dir
compileAllocatorCode allocator prefix cgExternals cgTestCode dir
loadNativeCode prefix dir
teardown :: Bindings Mallocator -> IO ()
teardown =
dlclose . dynamicLib
cgExternals :: ModuleBuilderT IO Externals
cgExternals = do
mallocFn <- extern "malloc" [i32] (ptr i8)
freeFn <- extern "free" [ptr i8] void
pure $ Externals mallocFn freeFn notUsed notUsed notUsed notUsed notUsed
-- Helper test code for initializing and freeing a struct from native code:
cgTestCode :: Type -> Externals -> ModuleBuilderT IO ()
cgTestCode ty exts = do
let mallocFn = extMalloc exts
freeFn = extFree exts
_ <- function "mallocator_new" [] (ptr ty) $ \[] ->
ret =<< call mallocFn [int32 1]
_ <- function "mallocator_delete" [(ptr ty, "allocator")] void $ \[alloc] ->
call freeFn [alloc]
pass
prefix :: Text
prefix = "mallocator"
testDir :: FilePath
testDir = "/tmp/eclair-mallocator"
notUsed :: a
notUsed = panic "Not used"
================================================
FILE: tests/eclair/Test/Eclair/LLVM/Allocator/PageSpec.hs
================================================
{-# OPTIONS_GHC -Wno-deprecations -Wno-incomplete-uni-patterns #-}
module Test.Eclair.LLVM.Allocator.PageSpec
( module Test.Eclair.LLVM.Allocator.PageSpec
) where
import Prelude hiding (void)
import Control.Monad.Morph
import Eclair.LLVM.Allocator.Page
import Eclair.LLVM.Allocator.Common
import Test.Eclair.LLVM.Allocator.Utils
import Eclair.LLVM.Codegen hiding (retVoid)
import System.Directory.Extra
import System.Posix.DynamicLinker
import Test.Hspec
import Control.Exception (bracket)
import Foreign hiding (void)
import Foreign.LibFFI
data PageAllocator
spec :: Spec
spec = describe "PageAllocator" $
aroundAll (setupAndTeardown testDir) $ parallel $ do
it "can be initialized and destroyed" $ \bindings ->
withAlloc bindings $ \obj -> do
fnInit bindings obj
fnDestroy bindings obj
it "can allocate and free memory" $ \bindings -> do
let numBytes = 1
value = 42
withAlloc bindings $ \obj -> do
fnInit bindings obj
memory <- fnAlloc bindings obj numBytes
let memoryEnd = memory `plusPtr` 4095
poke memory value
poke memoryEnd value
value' <- peek memory
valueEnd <- peek memoryEnd
fnFree bindings obj memory numBytes
fnDestroy bindings obj
value' `shouldBe` value
valueEnd `shouldBe` value
it "rounds up to the nearest page size" $ \_ -> do
withNearestPageSize $ \roundFn -> do
result1 <- roundFn 1
result2 <- roundFn 4096
result3 <- roundFn 4097
result4 <- roundFn 0
result5 <- roundFn 12345678
result1 `shouldBe` 4096
result2 `shouldBe` 4096
result3 `shouldBe` (4096 * 2)
result4 `shouldBe` 0
result5 `shouldBe` 12349440
setupAndTeardown :: FilePath -> ActionWith (Bindings PageAllocator) -> IO ()
setupAndTeardown dir =
bracket (setup dir) teardown
setup :: FilePath -> IO (Bindings PageAllocator)
setup dir = do
createDirectoryIfMissing False dir
compileAllocatorCode allocator prefix cgExternals cgTestCode dir
loadNativeCode prefix dir
teardown :: Bindings PageAllocator -> IO ()
teardown =
dlclose . dynamicLib
cgExternals :: ModuleBuilderT IO Externals
cgExternals = do
-- Need malloc and free to allocate the allocator itself
mallocFn <- extern "malloc" [i32] (ptr i8)
freeFn <- extern "free" [ptr i8] void
-- mmap [hint, numBytes', prot, flags, noFd, offset]
mmapFn <- extern "mmap" [ptr void, i64, i32, i32, i32, i32] (ptr void)
-- munmap [memory, len']
munmapFn <- extern "munmap" [ptr void, i64] i32
pure $ Externals mallocFn freeFn notUsed notUsed notUsed mmapFn munmapFn
-- Helper test code for allocating and freeing a struct from native code:
cgTestCode :: Type -> Externals -> ModuleBuilderT IO ()
cgTestCode ty exts = do
let mallocFn = extMalloc exts
freeFn = extFree exts
_ <- function "pageallocator_new" [] (ptr ty) $ \[] ->
ret =<< call mallocFn [int32 1]
_ <- function "pageallocator_delete" [(ptr ty, "allocator")] void $ \[alloc] ->
call freeFn [alloc]
let roundToNearestInstructions numBytes =
hoist (hoist intoIO) $ hoist (`evalStateT` exts) $ roundToNearestPageSize numBytes
_ <- function "nearest_page_size" [(i32, "num_bytes")] i32 $ \[num] ->
ret =<< roundToNearestInstructions num
pass
withNearestPageSize :: ((Word32 -> IO Word32) -> IO ()) -> IO ()
withNearestPageSize f =
bracket open close (\(_, roundFn) -> f roundFn)
where
open = do
dl <- dlopen (soFile testDir) [RTLD_LAZY]
roundingFn <- dlsym dl "nearest_page_size"
let roundFn numBytes =
fromIntegral <$> callFFI roundingFn retCUInt [argCUInt $ fromIntegral numBytes]
pure (dl, roundFn)
close = dlclose . fst
prefix :: Text
prefix = "pageallocator"
testDir :: FilePath
testDir = "/tmp/eclair-pageallocator"
notUsed :: a
notUsed = panic "Not used"
intoIO :: Identity a -> IO a
intoIO = pure . runIdentity
================================================
FILE: tests/eclair/Test/Eclair/LLVM/Allocator/Utils.hs
================================================
{-# OPTIONS_GHC -Wno-deprecations #-}
module Test.Eclair.LLVM.Allocator.Utils
( Bindings(..)
, compileAllocatorCode
, loadNativeCode
, soFile
) where
import System.Process.Extra
import System.FilePath
import System.Posix.DynamicLinker
import Eclair.LLVM.Codegen hiding (retVoid, nullPtr)
import Eclair.LLVM.Allocator.Common
import Control.Monad.Morph
import Control.Exception
import Foreign.LibFFI
import Foreign.Ptr
import Foreign.C
type I8 = CUChar
data Bindings a
= Bindings
{ dynamicLib :: DL
, withAlloc :: (Ptr a -> IO ()) -> IO ()
, fnAlloc :: Ptr a -> CSize -> IO (Ptr I8)
, fnFree :: Ptr a -> Ptr I8 -> CSize -> IO ()
, fnInit :: Ptr a -> IO ()
, fnDestroy :: Ptr a -> IO ()
}
compileAllocatorCode
:: Allocator a
-> Text
-> ModuleBuilderT IO Externals
-> (Type -> Externals -> ModuleBuilderT IO ())
-> FilePath -> IO ()
compileAllocatorCode allocator prefix cgExts cgHelperCode dir = do
llvmIR <- runModuleBuilderT $ do
exts <- cgExts
let cgBlueprint = flip evalStateT exts $ cgAlloc prefix allocator
blueprint <- hoist intoIO cgBlueprint
cgHelperCode (bpType blueprint) exts
let llvmIRText = ppllvm llvmIR
writeFileText (llFile dir) llvmIRText
callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir]
intoIO :: Identity a -> IO a
intoIO = pure . runIdentity
llFile, soFile :: FilePath -> FilePath
llFile dir = dir "allocator.ll"
soFile dir = dir "allocator.so"
loadNativeCode :: Text -> FilePath -> IO (Bindings a)
loadNativeCode (toString -> pfx) dir = do
lib <- dlopen (soFile dir) [RTLD_LAZY]
newFn <- dlsym lib (pfx <> "_new")
deleteFn <- dlsym lib (pfx <> "_delete")
allocFn <- dlsym lib (pfx <> "_alloc")
freeFn <- dlsym lib (pfx <> "_free")
initFn <- dlsym lib (pfx <> "_init")
destroyFn <- dlsym lib (pfx <> "_destroy")
pure $ Bindings
{ dynamicLib = lib
, withAlloc = mkWithAlloc newFn deleteFn
, fnAlloc = mkAlloc allocFn
, fnFree = mkFree freeFn
, fnInit = mkInit initFn
, fnDestroy = mkDestroy destroyFn
}
where
mkAlloc fn mallocator numBytes =
callFFI fn (retPtr retCUChar)
[ argPtr mallocator
, argCUInt $ fromIntegral numBytes
]
mkFree fn mallocator memory numBytes =
callFFI fn retVoid
[ argPtr mallocator
, argPtr memory
, argCSize $ fromIntegral numBytes
]
mkInit fn mallocator =
callFFI fn retVoid [argPtr mallocator]
mkDestroy fn mallocator =
callFFI fn retVoid [argPtr mallocator]
mkNew fn =
callFFI fn (retPtr retVoid) []
mkDelete fn mallocator =
callFFI fn retVoid [argPtr mallocator]
mkWithAlloc newFn deleteFn =
bracket (castPtr <$> mkNew newFn) (mkDelete deleteFn)
================================================
FILE: tests/eclair/Test/Eclair/LLVM/BTreeSpec.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.Eclair.LLVM.BTreeSpec
( module Test.Eclair.LLVM.BTreeSpec
) where
import Prelude hiding (void)
import qualified Relude as R
import System.Directory.Extra
import System.Process.Extra
import System.Posix.DynamicLinker
import System.FilePath
import Control.Exception
import Control.Monad.Morph
import System.Random
import Data.Array.IO hiding (index)
import Foreign.LibFFI
import Foreign hiding (void, newArray)
import Eclair.LLVM.BTree
import Eclair.LLVM.Table
import Eclair.LLVM.Externals
import Eclair.LLVM.Codegen hiding (retVoid, nullPtr)
import qualified LLVM.C.API as LibLLVM
import Test.Hspec
data BTree
data Iter
type Value = Word32
data Bindings
= Bindings
{ dynamicLib :: DL
, withTree :: (Ptr BTree -> IO ()) -> IO ()
, withIter :: forall a. (Ptr Iter -> IO a) -> IO a
, withValue :: forall a. Value -> (Ptr Value -> IO a) -> IO a
, bInit :: Ptr BTree -> IO ()
, bDestroy :: Ptr BTree -> IO ()
, bPurge :: Ptr BTree -> IO ()
, bSwap :: Ptr BTree -> Ptr BTree -> IO ()
, bBegin :: Ptr BTree -> Ptr Iter -> IO ()
, bEnd :: Ptr BTree -> Ptr Iter -> IO ()
, bInsert :: Ptr BTree -> Ptr Value -> IO Bool
, bMerge :: Ptr BTree -> Ptr BTree -> IO ()
, bEmpty :: Ptr BTree -> IO Bool
, bSize :: Ptr BTree -> IO Word64
, bNodeCount :: Ptr BTree -> IO Word64
, bDepth :: Ptr BTree -> IO Word32
, bLowerBound :: forall a. Ptr BTree -> Ptr Value -> (Ptr Iter -> IO a) -> IO a
, bUpperBound :: forall a. Ptr BTree -> Ptr Value -> (Ptr Iter -> IO a) -> IO a
, bContains :: Ptr BTree -> Ptr Value -> IO Bool
, bIterCurrent :: Ptr Iter -> IO (Ptr Value)
, bIterNext :: Ptr Iter -> IO ()
, bIterIsEqual :: Ptr Iter -> Ptr Iter -> IO Bool
}
spec :: Spec
spec = describe "BTree" $ aroundAll (setupAndTeardown testDir) $ parallel $ do
it "can be initialized and destroyed" $ \bindings -> do
withTree bindings $ \tree -> do
bInit bindings tree
bDestroy bindings tree
it "is possible to remove all elements from the tree" $ \bindings ->
withTree bindings $ \tree -> do
bInit bindings tree
bPurge bindings tree -- empty trees
empty1 <- bEmpty bindings tree
bPurge bindings tree -- calling it again
empty2 <- bEmpty bindings tree
withValue bindings 1 $ R.void . bInsert bindings tree
empty3 <- bEmpty bindings tree
bPurge bindings tree -- non-empty tree
empty4 <- bEmpty bindings tree
bPurge bindings tree -- calling it again
empty5 <- bEmpty bindings tree
for_ [1..100] $ \i ->
withValue bindings i $ R.void . bInsert bindings tree
bPurge bindings tree -- calling it again
empty6 <- bEmpty bindings tree
bDestroy bindings tree
empty1 `shouldBe` True
empty2 `shouldBe` True
empty3 `shouldBe` False
empty4 `shouldBe` True
empty5 `shouldBe` True
empty6 `shouldBe` True
it "should be possible to merge one tree into another" $ \bindings ->
withTree bindings $ \tree1 -> do
withTree bindings $ \tree2 -> do
bInit bindings tree1
bInit bindings tree2
for_ [1..4] $ \i -> do
withValue bindings i $ bInsert bindings tree1
for_ [2, 4, 6] $ \i -> do
withValue bindings i $ bInsert bindings tree2
-- tree1 = "destination", tree2 = "source"
bMerge bindings tree1 tree2
list <- treeToList bindings tree1
bDestroy bindings tree1
bDestroy bindings tree2
list `shouldBe` [1, 2, 3, 4, 6]
it "is possible to swap two trees" $ \bindings -> do
withTree bindings $ \tree1 -> do
withTree bindings $ \tree2 -> do
bInit bindings tree1
bInit bindings tree2
for_ [1..100] $ \i -> do
withValue bindings i $ \value -> do
_ <- bInsert bindings tree1 value
pass
withValue bindings (i + 100) $ \value -> do
_ <- bInsert bindings tree2 value
pass
c1 <- withValue bindings 42 $ bContains bindings tree1
c2 <- withValue bindings 78 $ bContains bindings tree1
c3 <- withValue bindings 142 $ bContains bindings tree2
c4 <- withValue bindings 178 $ bContains bindings tree2
bSwap bindings tree1 tree2
c5 <- withValue bindings 42 $ bContains bindings tree2
c6 <- withValue bindings 78 $ bContains bindings tree2
c7 <- withValue bindings 142 $ bContains bindings tree1
c8 <- withValue bindings 178 $ bContains bindings tree1
bDestroy bindings tree1
bDestroy bindings tree2
let result = R.and [c1, c2, c3, c4, c5, c6, c7, c8]
result `shouldBe` True
it "is possible to get begin and end iterators" $ \bindings ->
withTree bindings $ \tree -> do
withIters bindings $ \beginIter endIter -> do
bInit bindings tree
bBegin bindings tree beginIter
bEnd bindings tree endIter
beginIter `shouldNotBe` nullPtr
endIter `shouldNotBe` nullPtr
bDestroy bindings tree
it "is possible to iterate over the tree" $ \bindings ->
withTree bindings $ \tree -> do
bInit bindings tree
withValue bindings 4 $ R.void . bInsert bindings tree
withValue bindings 2 $ R.void . bInsert bindings tree
withValue bindings 5 $ R.void . bInsert bindings tree
withValue bindings 1 $ R.void . bInsert bindings tree
withValue bindings 3 $ R.void . bInsert bindings tree
withIters bindings $ \beginIter endIter -> do
bBegin bindings tree beginIter
bEnd bindings tree endIter
isEqual <- bIterIsEqual bindings beginIter endIter
isEqual `shouldBe` False
values <- treeToList bindings tree
bDestroy bindings tree
values `shouldBe` [1, 2, 3, 4, 5]
it "should have equal begin and end iterators if tree is empty" $ \bindings ->
withTree bindings $ \tree -> do
withIters bindings $ \beginIter endIter -> do
bInit bindings tree
bBegin bindings tree beginIter
bEnd bindings tree endIter
isEqual <- bIterIsEqual bindings beginIter endIter
isEqual `shouldBe` True
bDestroy bindings tree
it "is possible to insert a value" $ \bindings ->
withTree bindings $ \tree -> do
withValue bindings 1 $ \value -> do
bInit bindings tree
didInsert <- bInsert bindings tree value
didInsert' <- bInsert bindings tree value
didInsert `shouldBe` True
didInsert' `shouldBe` False
bDestroy bindings tree
it "is possible to check if the tree is empty" $ \bindings ->
withTree bindings $ \tree -> do
bInit bindings tree
empty1 <- bEmpty bindings tree
withValue bindings 1 $ R.void . bInsert bindings tree
empty2 <- bEmpty bindings tree
withValue bindings 2 $ R.void . bInsert bindings tree
empty3 <- bEmpty bindings tree
bDestroy bindings tree
empty1 `shouldBe` True
empty2 `shouldBe` False
empty3 `shouldBe` False
it "is possible to lookup the size of the tree" $ \bindings ->
withTree bindings $ \tree -> do
bInit bindings tree
size1 <- bSize bindings tree
R.void $ withValue bindings 1 $ bInsert bindings tree
size2 <- bSize bindings tree
for_ [2..100] $ \i -> do
withValue bindings i $ bInsert bindings tree
size3 <- bSize bindings tree
bDestroy bindings tree
size1 `shouldBe` 0
size2 `shouldBe` 1
size3 `shouldBe` 100
it "is possible to check if the tree contains a certain value" $ \bindings ->
withTree bindings $ \tree -> do
bInit bindings tree
c1 <- withValue bindings 1000 $ bContains bindings tree
R.void $ withValue bindings 1000 $ bInsert bindings tree
c2 <- withValue bindings 1000 $ bContains bindings tree
for_ [1..100] $ \i ->
withValue bindings i $ \value -> do
_ <- bInsert bindings tree value
pass
c3 <- withValue bindings 42 $ bContains bindings tree
c4 <- withValue bindings 78 $ bContains bindings tree
c5 <- withValue bindings 132 $ bContains bindings tree
c1 `shouldBe` False
c2 `shouldBe` True
c3 `shouldBe` True
c4 `shouldBe` True
c5 `shouldBe` False
bDestroy bindings tree
-- Tests below are taken from Souffle's test suite
it "should support basic operations on the btree" $ \bindings ->
withTree bindings $ \tree -> do
bInit bindings tree
-- check initial conditions
bSize bindings tree >>= (`shouldBe` 0)
bNodeCount bindings tree >>= (`shouldBe` 0)
bDepth bindings tree >>= (`shouldBe` 0)
withValue bindings 10 (bContains bindings tree) >>= (`shouldBe` False)
withValue bindings 12 (bContains bindings tree) >>= (`shouldBe` False)
withValue bindings 14 (bContains bindings tree) >>= (`shouldBe` False)
-- add an element
R.void $ withValue bindings 12 (bInsert bindings tree)
bSize bindings tree >>= (`shouldBe` 1)
bNodeCount bindings tree >>= (`shouldBe` 1)
bDepth bindings tree >>= (`shouldBe` 1)
withValue bindings 10 (bContains bindings tree) >>= (`shouldBe` False)
withValue bindings 12 (bContains bindings tree) >>= (`shouldBe` True) -- TODO failing
withValue bindings 14 (bContains bindings tree) >>= (`shouldBe` False)
-- add a larger element
R.void $ withValue bindings 14 (bInsert bindings tree)
bSize bindings tree >>= (`shouldBe` 2)
bNodeCount bindings tree >>= (`shouldBe` 1)
bDepth bindings tree >>= (`shouldBe` 1)
withValue bindings 10 (bContains bindings tree) >>= (`shouldBe` False)
withValue bindings 12 (bContains bindings tree) >>= (`shouldBe` True)
withValue bindings 14 (bContains bindings tree) >>= (`shouldBe` True)
-- add a smaller element
R.void $ withValue bindings 10 (bInsert bindings tree)
bSize bindings tree >>= (`shouldBe` 3)
bNodeCount bindings tree >>= (`shouldBe` 1)
bDepth bindings tree >>= (`shouldBe` 1)
withValue bindings 10 (bContains bindings tree) >>= (`shouldBe` True)
withValue bindings 12 (bContains bindings tree) >>= (`shouldBe` True)
withValue bindings 14 (bContains bindings tree) >>= (`shouldBe` True)
-- cause a split
R.void $ withValue bindings 11 (bInsert bindings tree)
bSize bindings tree >>= (`shouldBe` 4)
withValue bindings 10 (bContains bindings tree) >>= (`shouldBe` True)
withValue bindings 11 (bContains bindings tree) >>= (`shouldBe` True)
withValue bindings 12 (bContains bindings tree) >>= (`shouldBe` True)
withValue bindings 14 (bContains bindings tree) >>= (`shouldBe` True)
-- adding duplicates
R.void $ withValue bindings 12 (bInsert bindings tree)
bSize bindings tree >>= (`shouldBe` 4)
R.void $ withValue bindings 12 (bInsert bindings tree)
bSize bindings tree >>= (`shouldBe` 4)
R.void $ withValue bindings 10 (bInsert bindings tree)
bSize bindings tree >>= (`shouldBe` 4)
R.void $ withValue bindings 15 (bInsert bindings tree)
bSize bindings tree >>= (`shouldBe` 5)
bNodeCount bindings tree >>= (`shouldBe` 3)
bDepth bindings tree >>= (`shouldBe` 2)
R.void $ withValue bindings 16 (bInsert bindings tree)
bSize bindings tree >>= (`shouldBe` 6)
bDestroy bindings tree
it "should automatically remove duplicates" $ \bindings ->
withTree bindings $ \tree -> do
bInit bindings tree
replicateM_ 10 $ withValue bindings 0 $ bInsert bindings tree
size <- bSize bindings tree
value <- withIter bindings $ \iter -> do
bBegin bindings tree iter
valuePtr <- bIterCurrent bindings iter
peek valuePtr
bDestroy bindings tree
size `shouldBe` 1
value `shouldBe` 0
it "should contain the value after it is inserted" $ \bindings ->
withTree bindings $ \tree -> do
bInit bindings tree
let n = 100
for_ [0..n] $ \i -> do
R.void $ withValue bindings i $ bInsert bindings tree
for_ [0..n] $ \j -> do
contains <- withValue bindings j $ bContains bindings tree
contains `shouldBe` (j <= i)
bDestroy bindings tree
it "should contain the value after it is inserted (reverse)" $ \bindings ->
withTree bindings $ \tree -> do
bInit bindings tree
let n = 100
for_ [n, (n - 1) .. 0] $ \i -> do
R.void $ withValue bindings i (bInsert bindings tree)
for_ [0..n] $ \j -> do
contains <- withValue bindings j (bContains bindings tree)
contains `shouldBe` (j >= i)
bDestroy bindings tree
it "should contain the value after is inserted (shuffled)" $ \bindings -> do
let list = [1..10000]
shuffled <- shuffle list
withTree bindings $ \tree -> do
bInit bindings tree
for_ shuffled $ \i -> do
R.void $ withValue bindings i (bInsert bindings tree)
for_ list $ \j -> do
contains <- withValue bindings j (bContains bindings tree)
contains `shouldBe` True
bDestroy bindings tree
it "should withstand iterator stress test" $ \bindings -> do
let isSorted xs = sort xs == xs
list = [1..300] -- for faster unit tests
-- list = [1..1000] -- for real stress test
shuffled <- shuffle list
withTree bindings $ \tree -> do
bInit bindings tree
for_ shuffled $ \i -> do
values <- treeToList bindings tree
-- this is the main check if iterators are working correctly:
isSorted values `shouldBe` True
R.void $ withValue bindings i (bInsert bindings tree)
bDestroy bindings tree
it "should calculate correct lower and upper bounds of a value" $ \bindings ->
withTree bindings $ \tree -> do
let getBound f = flip (f bindings tree) (peek <=< bIterCurrent bindings)
getLB = getBound bLowerBound
getUB = getBound bUpperBound
bInit bindings tree
for_ [0..10] $ \i -> do
R.void $ withValue bindings i (bInsert bindings tree)
lb1 <- withValue bindings 5 getLB
ub1 <- withValue bindings 5 getUB
lb1 `shouldBe` 5
ub1 `shouldBe` 6
-- add duplicates and check again
replicateM_ 3 $ R.void $ withValue bindings 5 $ bInsert bindings tree
lb2 <- withValue bindings 5 getLB
ub2 <- withValue bindings 5 getUB
lb2 `shouldBe` 5
ub2 `shouldBe` 6
bDestroy bindings tree
it "should calculate correct lower and upper bound for empty trees" $ \bindings ->
withTree bindings $ \tree ->
withIter bindings $ \endIter -> do
bInit bindings tree
bEnd bindings tree endIter
-- empty
lbIsEnd1 <- withValue bindings 5 $ flip (bLowerBound bindings tree) $
bIterIsEqual bindings endIter
ubIsEnd1 <- withValue bindings 5 $ flip (bUpperBound bindings tree) $
bIterIsEqual bindings endIter
lbIsEnd1 `shouldBe` True
ubIsEnd1 `shouldBe` True
let checkBounds expected3 expected5 = do
withValue bindings 3 $ flip (bLowerBound bindings tree) $ \lbIter ->
withValue bindings 3 $ flip (bUpperBound bindings tree) $ \ubIter -> do
isEqual <- bIterIsEqual bindings lbIter ubIter
isEqual `shouldBe` expected3
withValue bindings 5 $ flip (bLowerBound bindings tree) $ \lbIter ->
withValue bindings 5 $ flip (bUpperBound bindings tree) $ \ubIter -> do
isEqual <- bIterIsEqual bindings lbIter ubIter
isEqual `shouldBe` expected5
-- insert 4
R.void $ withValue bindings 4 (bInsert bindings tree)
checkBounds True True
-- insert 6
R.void $ withValue bindings 6 (bInsert bindings tree)
checkBounds True True
-- insert 5
R.void $ withValue bindings 5 (bInsert bindings tree)
checkBounds True False
bDestroy bindings tree
setupAndTeardown :: FilePath -> ActionWith Bindings -> IO ()
setupAndTeardown dir =
bracket (setup dir) teardown
setup :: FilePath -> IO Bindings
setup dir = do
createDirectoryIfMissing False dir
let meta = Meta
{ numColumns = 1
, index = [0]
, blockSize = 16
, searchType = Linear
}
cgBTree dir meta
loadNativeCode dir
teardown :: Bindings -> IO ()
teardown =
dlclose . dynamicLib
cgBTree :: FilePath -> Meta -> IO ()
cgBTree dir meta = do
ctx <- LibLLVM.mkContext
llvmMod <- LibLLVM.mkModule ctx "eclair"
td <- LibLLVM.getTargetData llvmMod
let cfg = Config Nothing ctx td
llvmIR <- runModuleBuilderT $ do
exts <- cgExternals
table <- instantiate "test" meta $ runConfigT cfg $ codegen exts
let iterParams = IteratorParams
{ ipIterCurrent = fnIterCurrent table
, ipIterNext = fnIterNext table
, ipIterIsEqual = fnIterIsEqual table
, ipTypeIter = typeIter table
}
R.void $ hoist intoIO $ instantiate "test" iterParams $
fnInsertRangeTemplate table
cgHelperCode table (extMalloc exts) (extFree exts)
let llvmIRText = ppllvm llvmIR
writeFileText (llFile dir) llvmIRText
-- Next line is a hack, because we can't access node types from the test:
appendFileText (llFile dir) helperCodeAppendix
callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir]
cgExternals :: ModuleBuilderT IO Externals
cgExternals = do
mallocFn <- extern "malloc" [i32] (ptr i8)
freeFn <- extern "free" [ptr i8] void
memsetFn <- extern "llvm.memset.p0i8.i64" [ptr i8, i8, i64, i1] void
pure $ Externals mallocFn freeFn memsetFn notUsed notUsed notUsed notUsed
-- Helper test code for initializing and freeing a struct from native code:
cgHelperCode :: Monad m => Table -> Operand -> Operand -> ModuleBuilderT m ()
cgHelperCode table mallocFn freeFn = do
let treeTy = typeObj table
iterTy = typeIter table
valueTy = typeValue table
_ <- function "eclair_btree_new" [] (ptr treeTy) $ \[] ->
ret =<< call mallocFn [int32 16]
_ <- function "eclair_btree_delete" [(ptr treeTy, "btree")] void $ \[btree] ->
call freeFn [btree]
_ <- function "eclair_iter_new" [] (ptr iterTy) $ \[] ->
ret =<< call mallocFn [int32 16]
_ <- function "eclair_iter_delete" [(ptr iterTy, "iter")] void $ \[iter] ->
call freeFn [iter]
_ <- function "eclair_value_new" [] (ptr valueTy) $ \[] ->
ret =<< call mallocFn [int32 4] -- Hardcoded for 1x i32
_ <- function "eclair_value_delete" [(ptr valueTy, "value")] void $ \[value] ->
call freeFn [value]
-- Next function is needed because returning i1 is not C ABI compatible
_ <- function "eclair_btree_contains_helper_test" [(ptr treeTy, "tree"), (ptr valueTy, "val")] i8 $ \[tree, val] -> do
result <- call (fnContains table) [tree, val] >>= (`zext` i8)
ret result
pass
helperCodeAppendix :: Text
helperCodeAppendix = unlines
[ ""
, "define external ccc i64 @node_count(ptr %node_0) {"
, "start:"
, " %stack.ptr_0 = alloca i64" -- count
, " store i64 1, ptr %stack.ptr_0"
, " %0 = getelementptr %node_t_test, ptr %node_0, i32 0, i32 0, i32 3"
, " %1 = load i1, ptr %0" -- node type
, " %2 = icmp eq i1 %1, 0" -- is leaf?
, " br i1 %2, label %if_0, label %end_if_0"
, "if_0:"
, " ret i64 1"
, "end_if_0:"
, " %3 = getelementptr %node_t_test, ptr %node_0, i32 0, i32 0, i32 2"
, " %4 = load i16, ptr %3"
, " br label %for_begin_0"
, "for_begin_0:"
, " %5 = phi i16 [0, %end_if_0], [%12, %for_body_0]"
, " %6 = icmp ule i16 %5, %4"
, " br i1 %6, label %for_body_0, label %for_end_0"
, "for_body_0:"
, " %7 = load i64, ptr %stack.ptr_0" -- count
, " %8 = getelementptr %inner_node_t_test, ptr %node_0, i32 0, i32 1, i16 %5" -- child ptr
, " %9 = load ptr, ptr %8" -- child
, " %10 = call ccc i64 @node_count(ptr %9)"
, " %11 = add i64 %7, %10"
, " store i64 %11, ptr %stack.ptr_0"
, " %12 = add i16 1, %5"
, " br label %for_begin_0"
, "for_end_0:"
, " %13 = load i64, ptr %stack.ptr_0"
, " ret i64 %13"
, "}"
, ""
, "define external ccc i64 @eclair_btree_node_count_test(ptr %tree_0) {"
, "start:"
, " %0 = getelementptr %btree_t_test, ptr %tree_0, i32 0, i32 0"
, " %1 = load ptr, ptr %0"
, " %2 = icmp eq ptr %1, zeroinitializer"
, " br i1 %2, label %null_0, label %not_null_0"
, "null_0:"
, " ret i64 0"
, "not_null_0:"
, " %3 = call ccc i64 @node_count(ptr %1)"
, " ret i64 %3"
, "}"
, ""
, "define external ccc i32 @node_depth(ptr %node_0) {"
, "start:"
, " %0 = getelementptr %node_t_test, ptr %node_0, i32 0, i32 0, i32 3"
, " %1 = load i1, ptr %0" -- node type
, " %2 = icmp eq i1 %1, 0" -- is leaf?
, " br i1 %2, label %if_0, label %end_if_0"
, "if_0:"
, " ret i32 1"
, "end_if_0:"
, " %3 = getelementptr %inner_node_t_test, ptr %node_0, i32 0, i32 1, i16 0" -- child ptr
, " %4 = load ptr, ptr %3" -- child
, " %5 = call ccc i32 @node_depth(ptr %4)"
, " %6 = add i32 %5, 1"
, " ret i32 %6"
, "}"
, ""
, "define external ccc i32 @eclair_btree_depth_test(ptr %tree_0) {"
, "start:"
, " %0 = getelementptr %btree_t_test, ptr %tree_0, i32 0, i32 0"
, " %1 = load ptr, ptr %0"
, " %2 = icmp eq ptr %1, zeroinitializer"
, " br i1 %2, label %null_0, label %not_null_0"
, "null_0:"
, " ret i32 0"
, "not_null_0:"
, " %3 = call ccc i32 @node_depth(ptr %1)"
, " ret i32 %3"
, "}"
]
loadNativeCode :: FilePath -> IO Bindings
loadNativeCode dir = do
lib <- dlopen (soFile dir) [RTLD_LAZY]
funcNewTree <- dlsym lib "eclair_btree_new"
funcDeleteTree <- dlsym lib "eclair_btree_delete"
funcNewIter <- dlsym lib "eclair_iter_new"
funcDeleteIter <- dlsym lib "eclair_iter_delete"
funcNewValue <- dlsym lib "eclair_value_new"
funcDeleteValue <- dlsym lib "eclair_value_delete"
funcInit <- dlsym lib "eclair_btree_init_empty_test"
funcDestroy <- dlsym lib "eclair_btree_destroy_test"
funcPurge <- dlsym lib "eclair_btree_clear_test"
funcSwap <- dlsym lib "eclair_btree_swap_test"
funcBegin <- dlsym lib "eclair_btree_begin_test"
funcEnd <- dlsym lib "eclair_btree_end_test"
funcInsert <- dlsym lib "eclair_btree_insert_value_test"
funcMerge <- dlsym lib "eclair_btree_insert_range_test"
funcEmpty <- dlsym lib "eclair_btree_is_empty_test"
funcSize <- dlsym lib "eclair_btree_size_test"
funcNodeCount <- dlsym lib "eclair_btree_node_count_test"
funcDepth <- dlsym lib "eclair_btree_depth_test"
funcContains <- dlsym lib "eclair_btree_contains_helper_test"
funcLB <- dlsym lib "eclair_btree_lower_bound_test"
funcUB <- dlsym lib "eclair_btree_upper_bound_test"
funcIterCurrent <- dlsym lib "eclair_btree_iterator_current_test"
funcIterNext <- dlsym lib "eclair_btree_iterator_next_test"
funcIterIsEqual <- dlsym lib "eclair_btree_iterator_is_equal_test"
let withIter' :: forall a. (Ptr Iter -> IO a) -> IO a
withIter' = mkWithX funcNewIter funcDeleteIter
iterCurrent = mkIterCurrent funcIterCurrent
begin' = mkBegin funcBegin
end' = mkEnd funcEnd
pure $ Bindings
{ dynamicLib = lib
, withTree = mkWithX funcNewTree funcDeleteTree
, withIter = withIter'
, withValue = \value f -> do
mkWithX funcNewValue funcDeleteValue $ \valuePtr -> do
poke valuePtr value
f valuePtr
, bInit = mkInit funcInit
, bDestroy = mkDestroy funcDestroy
, bPurge = mkPurge funcPurge
, bSwap = mkSwap funcSwap
, bBegin = begin'
, bEnd = end'
, bInsert = mkInsert funcInsert
, bMerge = mkMerge funcMerge withIter' begin' end'
, bEmpty = mkIsEmpty funcEmpty
, bSize = mkSize funcSize
, bNodeCount = mkNodeCount funcNodeCount
, bDepth = mkDepth funcDepth
, bContains = mkContains funcContains
, bIterCurrent = iterCurrent
, bIterNext = mkIterNext funcIterNext
, bIterIsEqual = mkIterIsEqual funcIterIsEqual
, bLowerBound = mkBound funcLB withIter'
, bUpperBound = mkBound funcUB withIter'
}
where
mkInit fn tree = callFFI fn retVoid [argPtr tree]
mkDestroy fn tree = callFFI fn retVoid [argPtr tree]
mkPurge fn tree = callFFI fn retVoid [argPtr tree]
mkSwap fn tree1 tree2 = callFFI fn retVoid [argPtr tree1, argPtr tree2]
mkBegin fn tree resultIter = callFFI fn retVoid [argPtr tree, argPtr resultIter]
mkEnd fn tree resultIter = callFFI fn retVoid [argPtr tree, argPtr resultIter]
mkInsert fn tree value = do
result <- callFFI fn retCUChar [argPtr tree, argPtr value]
pure $ result == 1
mkMerge fn withIter' begin' end' tree1 tree2 = do
withIter' $ \beginIter ->
withIter' $ \endIter -> do
R.void $ begin' tree2 beginIter
R.void $ end' tree2 endIter
callFFI fn retVoid [argPtr tree1, argPtr beginIter, argPtr endIter]
mkIsEmpty fn tree = do
result <- callFFI fn retCUChar [argPtr tree]
pure $ result == 1
mkSize fn tree = fromIntegral <$> callFFI fn retCULong [argPtr tree]
mkNodeCount fn tree = fromIntegral <$> callFFI fn retCULong [argPtr tree]
mkDepth fn tree = fromIntegral <$> callFFI fn retCUInt [argPtr tree]
mkContains fn tree value = do
result <- callFFI fn retCUChar [argPtr tree, argPtr value]
pure $ result == 1
mkNew fn = callFFI fn (retPtr retVoid) []
mkDelete fn obj = callFFI fn retVoid [argPtr obj]
mkWithX newFn deleteFn = bracket (castPtr <$> mkNew newFn) (mkDelete deleteFn)
mkIterCurrent fn iter = castPtr <$> callFFI fn (retPtr retVoid) [argPtr iter]
mkIterNext fn iter = callFFI fn retVoid [argPtr iter]
mkIterIsEqual fn beginIter endIter = do
result <- callFFI fn retCUChar [argPtr beginIter, argPtr endIter]
pure $ result == 1
mkBound fn withIter' tree value f = do
withIter' $ \iter -> do
callFFI fn retVoid [argPtr tree, argPtr value, argPtr iter]
f iter
withIters :: Bindings -> (Ptr Iter -> Ptr Iter -> IO a) -> IO a
withIters bindings f =
withIter bindings $ \beginIter ->
withIter bindings $ \endIter ->
f beginIter endIter
treeToList :: Bindings -> Ptr BTree -> IO [Value]
treeToList bindings tree =
withIters bindings $ \beginIter endIter -> do
bBegin bindings tree beginIter
bEnd bindings tree endIter
whileM (isNotEqualIter beginIter endIter) $ do
value <- bIterCurrent bindings beginIter
bIterNext bindings beginIter
peek value
where
isNotEqualIter beginIter endIter = do
not <$> bIterIsEqual bindings beginIter endIter
llFile, soFile :: FilePath -> FilePath
llFile dir = dir "btree.ll"
soFile dir = dir "btree.so"
testDir :: FilePath
testDir = "/tmp/eclair-btree"
notUsed :: a
notUsed = panic "Not used"
whileM :: Monad m => m Bool -> m a -> m [a]
whileM cond action = go
where
go = cond >>= \case
True -> do
x <- action
xs <- go
pure $ x:xs
False ->
pure []
shuffle :: [a] -> IO [a]
shuffle xs = do
array <- mkArray n xs
forM [1..n] $ \i -> do
j <- randomRIO (i,n)
vi <- readArray array i
vj <- readArray array j
writeArray array j vi
pure vj
where
n = length xs
mkArray :: Int -> [a] -> IO (IOArray Int a)
mkArray m = newListArray (1,m)
intoIO :: Identity a -> IO a
intoIO = pure . runIdentity
================================================
FILE: tests/eclair/Test/Eclair/LLVM/HashMapSpec.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.Eclair.LLVM.HashMapSpec
( module Test.Eclair.LLVM.HashMapSpec
) where
import Prelude hiding (void, HashMap, Symbol)
import Control.Exception
import Control.Monad.Morph
import qualified Test.Eclair.LLVM.SymbolUtils as S
import qualified LLVM.C.API as LibLLVM
import Eclair.LLVM.HashMap
import qualified Eclair.LLVM.Symbol as S
import Eclair.LLVM.Codegen hiding (retVoid, nullPtr)
import Eclair.LLVM.Externals
import Foreign.LibFFI
import Foreign hiding (void)
import System.Posix.DynamicLinker
import System.Directory.Extra
import System.Process.Extra
import System.FilePath
import Test.Hspec
type Value = Word32
data Bindings
= Bindings
{ dynamicLib :: DL
, symBindings :: S.Bindings
, withHashMap :: (Ptr HashMap -> IO ()) -> IO ()
, bInit :: Ptr HashMap -> IO ()
, bDestroy :: Ptr HashMap -> IO ()
, bGetOrPut :: Ptr HashMap -> Ptr S.Symbol -> Value -> IO Value
, bLookup :: Ptr HashMap -> Ptr S.Symbol -> IO Value
, bContains :: Ptr HashMap -> Ptr S.Symbol -> IO Bool
}
spec :: Spec
spec = describe "HashMap" $ aroundAll (setupAndTeardown testDir) $ parallel $ do
it "can be initialized and destroyed" $ \bindings ->
withHashMap bindings $ \hm -> do
bInit bindings hm
bDestroy bindings hm
it "stores a new value if the requested key was not found" $ \bindings -> do
let sBindings = symBindings bindings
withHashMap bindings $ \hm -> do
bInit bindings hm
withSym sBindings "abcd" $ \sym -> do
value1 <- bGetOrPut bindings hm sym 42
value1 `shouldBe` 42
-- different symbol -> separate entry in the hashmap
withSym sBindings "abcdef" $ \sym' -> do
value3 <- bGetOrPut bindings hm sym' 34
value3 `shouldBe` 34
pass
bDestroy bindings hm
it "retrieves the old value if the requested key was found" $ \bindings -> do
let sBindings = symBindings bindings
withHashMap bindings $ \hm -> do
bInit bindings hm
withSym sBindings "abcd" $ \sym -> do
value1 <- bGetOrPut bindings hm sym 42
value1 `shouldBe` 42
value2 <- bGetOrPut bindings hm sym 100
value2 `shouldBe` 42
-- same symbol -> same entry in the hashmap
withSym sBindings "abcd" $ \sym' -> do
value4 <- bGetOrPut bindings hm sym' 34
value4 `shouldBe` 42
bDestroy bindings hm
it "is possible to lookup keys in the hashmap" $ \bindings -> do
let sBindings = symBindings bindings
withHashMap bindings $ \hm -> do
bInit bindings hm
-- key found
withSym sBindings "abcd" $ \sym -> do
_ <- bGetOrPut bindings hm sym 42
value <- bLookup bindings hm sym
value `shouldBe` 42
-- key not found
withSym sBindings "123" $ \sym -> do
value <- bLookup bindings hm sym
value `shouldBe` 0xffffffff
bDestroy bindings hm
it "is possible to check if a hashmap contains a key" $ \bindings -> do
let sBindings = symBindings bindings
withHashMap bindings $ \hm -> do
bInit bindings hm
-- key found
withSym sBindings "abcd" $ \sym -> do
_ <- bGetOrPut bindings hm sym 42
value <- bContains bindings hm sym
value `shouldBe` True
-- key not found
withSym sBindings "123" $ \sym -> do
value <- bContains bindings hm sym
value `shouldBe` False
bDestroy bindings hm
-- TODO big hashmap test + test for colissions
setupAndTeardown :: FilePath -> ActionWith Bindings -> IO ()
setupAndTeardown dir =
bracket (setup dir) teardown
setup :: FilePath -> IO Bindings
setup dir = do
createDirectoryIfMissing False dir
compileCode cgExternals cgTestCode dir
loadNativeCode dir
teardown :: Bindings -> IO ()
teardown =
dlclose . dynamicLib
compileCode
:: ModuleBuilderT IO Externals
-> (S.Symbol -> HashMap -> Externals -> ModuleBuilderT IO ())
-> FilePath -> IO ()
compileCode cgExts cgHelperCode dir = do
ctx <- LibLLVM.mkContext
llvmMod <- LibLLVM.mkModule ctx "eclair"
td <- LibLLVM.getTargetData llvmMod
llvmIR <- runModuleBuilderT $ do
exts <- cgExts
let cfg = Config Nothing ctx td
sym <- hoist intoIO $ S.codegen exts
hm <- runConfigT cfg $ codegen sym exts
cgHelperCode sym hm exts
let llvmIRText = ppllvm llvmIR
writeFileText (llFile dir) llvmIRText
callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir]
intoIO :: Identity a -> IO a
intoIO = pure . runIdentity
cgExternals :: ModuleBuilderT IO Externals
cgExternals = do
mallocFn <- extern "malloc" [i32] (ptr i8)
freeFn <- extern "free" [ptr i8] void
memcpyFn <- extern "memcpy" [ptr i8, ptr i8, i64] (ptr i8)
memcmpFn <- extern "memcmp" [ptr i8, ptr i8, i64] i32
pure $ Externals mallocFn freeFn notUsed memcpyFn memcmpFn notUsed notUsed
cgTestCode :: S.Symbol -> HashMap -> Externals -> ModuleBuilderT IO ()
cgTestCode sym hm exts = do
let hmTypes = hashMapTypes hm
hmTy = tyHashMap hmTypes
tySym = tyKey hmTypes
mallocFn = extMalloc exts
freeFn = extFree exts
_ <- function "eclair_hashmap_new" [] (ptr hmTy) $ \[] ->
ret =<< call mallocFn [int32 $ 64 * 32] -- 64 vectors long
_ <- function "eclair_hashmap_delete" [(ptr hmTy, "hm")] void $ \[h] ->
call freeFn [h]
let args = [(ptr hmTy, "hashmap"), (ptr tySym, "symbol")]
_ <- function "eclair_hashmap_contains_helper" args i8 $ \[h, s] -> do
result <- call (hashMapContains hm) [h, s]
ret =<< result `zext` i8
S.cgTestCode sym exts
loadNativeCode :: FilePath -> IO Bindings
loadNativeCode dir = do
lib <- dlopen (soFile dir) [RTLD_LAZY]
sBindings <- S.loadNativeCode' lib
fnNew <- dlsym lib "eclair_hashmap_new"
fnDelete <- dlsym lib "eclair_hashmap_delete"
fnInit <- dlsym lib "eclair_hashmap_init"
fnDestroy <- dlsym lib "eclair_hashmap_destroy"
fnGetOrPut <- dlsym lib "eclair_hashmap_get_or_put_value"
fnContains <- dlsym lib "eclair_hashmap_contains_helper"
fnLookup <- dlsym lib "eclair_hashmap_lookup"
pure $ Bindings
{ dynamicLib = lib
, symBindings = sBindings
, withHashMap = mkWithHashMap fnNew fnDelete
, bInit = mkInit fnInit
, bDestroy = mkDestroy fnDestroy
, bGetOrPut = mkGetOrPut fnGetOrPut
, bContains = mkContains fnContains
, bLookup = mkLookup fnLookup
}
where
mkNew fn = callFFI fn (retPtr retVoid) []
mkDelete fn hm = callFFI fn retVoid [argPtr hm]
mkWithHashMap fnNew fnDelete =
bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete)
mkInit fn hm = callFFI fn retVoid [argPtr hm]
mkDestroy fn hm = callFFI fn retVoid [argPtr hm]
mkGetOrPut fn hm sym value =
fromIntegral <$> callFFI fn retCUInt [argPtr hm, argPtr sym, argCUInt $ fromIntegral value]
mkContains fn hm sym = do
result <- callFFI fn retCUChar [argPtr hm, argPtr sym]
pure $ result == 1
mkLookup fn hm sym =
fromIntegral <$> callFFI fn retCUInt [argPtr hm, argPtr sym]
testDir :: FilePath
testDir = "/tmp/eclair-hashmap"
llFile, soFile :: FilePath -> FilePath
llFile dir = dir "hashmap.ll"
soFile dir = dir "hashmap.so"
notUsed :: a
notUsed = panic "Not used"
withSym :: S.Bindings -> String -> (Ptr S.Symbol -> IO a) -> IO a
withSym bindings str f = do
S.withSymbol bindings $ \sym -> do
S.bInit bindings sym str
result <- f sym
S.bDestroy bindings sym
pure result
================================================
FILE: tests/eclair/Test/Eclair/LLVM/HashSpec.hs
================================================
module Test.Eclair.LLVM.HashSpec
( module Test.Eclair.LLVM.HashSpec
) where
import qualified Data.Set as Set
import Eclair.LLVM.Hash
import Test.Hspec
data MyOption = Option0 | Option1
deriving stock Enum
deriving ToHash via HashEnum MyOption
data Prefixed = Prefixed
deriving stock Generic
deriving ToHash via HashWithPrefix "prefix" Prefixed
data Config = Config Int Int Int MyOption
deriving stock Generic
deriving ToHash via HashWithPrefix "config" Config
data OnlyInt
= OnlyInt
{ getInt :: Int
, getText :: Text
, getMyOption :: MyOption
}
deriving ToHash via HashOnly "getInt" OnlyInt
spec :: Spec
spec = describe "Hashing data" $ parallel $ do
it "can hash ints" $ do
unHash (getHash (1234 :: Int)) `shouldBe` "1234"
it "can hash texts" $ do
unHash (getHash ("12345" :: Text)) `shouldBe` "12345"
it "can hash lists" $ do
unHash (getHash (["123", "45", "6"] :: [Text])) `shouldBe` "123_45_6"
it "can hash non empty lists" $ do
let nonEmptyList = "123" :| ["45", "6"] :: NonEmpty Text
unHash (getHash nonEmptyList) `shouldBe` "123_45_6"
it "can hash sets" $ do
let set = Set.fromList [123, 45, 6] :: Set Int
-- NOTE: set is sorted => different ordering!
unHash (getHash set) `shouldBe` "6_45_123"
it "can hash sum types as enums" $ do
unHash (getHash Option0) `shouldBe` "0"
unHash (getHash Option1) `shouldBe` "1"
it "can hash with a prefix" $ do
unHash (getHash Prefixed) `shouldBe` "prefix__0"
it "can hash generic product types" $ do
let cfg = Config 1 2 3 Option1
unHash (getHash cfg) `shouldBe` "config__1__2__3__1"
it "can hash only a specific field of a record" $ do
let onlyInt = OnlyInt 123 "abc" Option1
unHash (getHash onlyInt) `shouldBe` "123"
it "can combine hashes" $ do
let x, y :: Int
x = 42
y = 1000
unHash (getHash x <> getHash y) `shouldBe` "42__1000"
================================================
FILE: tests/eclair/Test/Eclair/LLVM/SymbolSpec.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.Eclair.LLVM.SymbolSpec
( module Test.Eclair.LLVM.SymbolSpec
) where
import Prelude hiding (void, Symbol)
import Test.Eclair.LLVM.SymbolUtils
import Control.Monad.Morph
import Control.Exception
import Eclair.LLVM.Symbol
import Eclair.LLVM.Codegen hiding (retVoid, nullPtr)
import Eclair.LLVM.Externals
import System.Posix.DynamicLinker
import System.Directory.Extra
import System.Process.Extra
import Test.Hspec
spec :: Spec
spec = describe "Symbol" $ aroundAll (setupAndTeardown testDir) $ parallel $ do
it "can be initialized and destroyed" $ \bindings ->
withSymbol bindings $ \s -> do
let str = "my example string"
len = fromIntegral $ length str
bInit bindings s str
bLength bindings s >>= (`shouldBe` len)
bData bindings s >>= (`shouldBe` str)
bDestroy bindings s
it "is possible to compare 2 symbols" $ \bindings ->
withSymbol bindings $ \s1 -> do
withSymbol bindings $ \s2 -> do
bInit bindings s1 "abc"
bInit bindings s2 "1234"
isEq1 <- bIsEqual bindings s1 s2
isEq2 <- bIsEqual bindings s1 s1
isEq3 <- bIsEqual bindings s2 s2
bDestroy bindings s1
bDestroy bindings s2
isEq1 `shouldBe` False
isEq2 `shouldBe` True
isEq3 `shouldBe` True
setupAndTeardown :: FilePath -> ActionWith Bindings -> IO ()
setupAndTeardown dir =
bracket (setup dir) teardown
setup :: FilePath -> IO Bindings
setup dir = do
createDirectoryIfMissing False dir
compileCode cgExternals cgTestCode dir
loadNativeCode dir
teardown :: Bindings -> IO ()
teardown =
dlclose . dynamicLib
compileCode
:: ModuleBuilderT IO Externals
-> (Symbol -> Externals -> ModuleBuilderT IO ())
-> FilePath -> IO ()
compileCode cgExts cgHelperCode dir = do
llvmIR <- runModuleBuilderT $ do
exts <- cgExts
symbol <- hoist intoIO $ codegen exts
cgHelperCode symbol exts
let llvmIRText = ppllvm llvmIR
writeFileText (llFile dir) llvmIRText
callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir]
cgExternals :: ModuleBuilderT IO Externals
cgExternals = do
mallocFn <- extern "malloc" [i32] (ptr i8)
freeFn <- extern "free" [ptr i8] void
memcpyFn <- extern "memcpy" [ptr i8, ptr i8, i64] (ptr i8)
memcmpFn <- extern "memcmp" [ptr i8, ptr i8, i64] i32
pure $ Externals mallocFn freeFn notUsed memcpyFn memcmpFn notUsed notUsed
testDir :: FilePath
testDir = "/tmp/eclair-symbol"
notUsed :: a
notUsed = panic "Not used"
intoIO :: Identity a -> IO a
intoIO = pure . runIdentity
================================================
FILE: tests/eclair/Test/Eclair/LLVM/SymbolTableSpec.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.Eclair.LLVM.SymbolTableSpec
( module Test.Eclair.LLVM.SymbolTableSpec
) where
import Prelude hiding (void, Symbol)
import qualified LLVM.C.API as LibLLVM
import qualified Test.Eclair.LLVM.SymbolUtils as S
import Control.Monad.Morph
import Control.Exception
import Eclair.LLVM.SymbolTable
import qualified Eclair.LLVM.Symbol as S
import qualified Eclair.LLVM.Vector as V
import qualified Eclair.LLVM.HashMap as HM
import Eclair.LLVM.Codegen hiding (retVoid, nullPtr)
import Eclair.LLVM.Externals
import System.Posix.DynamicLinker
import System.Directory.Extra
import System.Process.Extra
import System.FilePath
import Foreign hiding (void)
import Foreign.LibFFI
import Test.Hspec
type Symbol = S.Symbol
type Value = Word32
data Bindings
= Bindings
{ dynamicLib :: DL
, symBindings :: S.Bindings
, withSymTab :: (Ptr SymbolTable -> IO ()) -> IO ()
, bInit :: Ptr SymbolTable -> IO ()
, bDestroy :: Ptr SymbolTable -> IO ()
, bFindOrInsert :: Ptr SymbolTable -> Ptr Symbol -> IO Value
-- NOTE: no need to free returned symbol after lookup
, bLookupSymbol :: Ptr SymbolTable -> Value -> IO (Ptr Symbol)
, bContainsSymbol :: Ptr SymbolTable -> Ptr Symbol -> IO Bool
, bLookupIndex :: Ptr SymbolTable -> Ptr Symbol -> IO Value
, bContainsIndex :: Ptr SymbolTable -> Value -> IO Bool
}
spec :: Spec
spec = describe "Symbol table" $ aroundAll (setupAndTeardown testDir) $ parallel $ do
it "can be initialized and destroyed" $ \bindings ->
withSymTab bindings $ \st -> do
bInit bindings st
bDestroy bindings st
it "is possible to add symbols to the table" $ \bindings -> do
let sBindings = symBindings bindings
withSymTab bindings $ \st -> do
bInit bindings st
_ <- S.withSymbol sBindings $ \sym -> do
S.bInit sBindings sym "abcd"
idx <- bFindOrInsert bindings st sym
idx `shouldBe` 0
idx' <- bFindOrInsert bindings st sym
idx' `shouldBe` 0
-- Owned by symbol table now:
-- S.bDestroy sBindings sym
_ <- S.withSymbol sBindings $ \sym -> do
S.bInit sBindings sym "123"
idx <- bFindOrInsert bindings st sym
idx `shouldBe` 1
-- Owned by symbol table now:
-- S.bDestroy sBindings sym
bDestroy bindings st
it "is possible to check if the table contains a key" $ \bindings -> do
let sBindings = symBindings bindings
withSymTab bindings $ \st -> do
bInit bindings st
_ <- S.withSymbol sBindings $ \sym -> do
S.bInit sBindings sym "abcd"
result1 <- bContainsSymbol bindings st sym
_ <- bFindOrInsert bindings st sym
result2 <- bContainsSymbol bindings st sym
S.bDestroy sBindings sym
result1 `shouldBe` False
result2 `shouldBe` True
pass
it "is possible to check if the table contains a value" $ \bindings -> do
let sBindings = symBindings bindings
withSymTab bindings $ \st -> do
bInit bindings st
_ <- S.withSymbol sBindings $ \sym -> do
S.bInit sBindings sym "abcd"
result1 <- bContainsIndex bindings st 0
_ <- bFindOrInsert bindings st sym
result2 <- bContainsIndex bindings st 0
S.bDestroy sBindings sym
result1 `shouldBe` False
result2 `shouldBe` True
pass
it "is possible to lookup a key corresponding to a value" $ \bindings -> do
let sBindings = symBindings bindings
withSymTab bindings $ \st -> do
bInit bindings st
_ <- S.withSymbol sBindings $ \sym -> do
S.bInit sBindings sym "abcd"
-- NOTE: unsafe lookup, don't use it before symbol is inserted
-- sym1 <- bLookupSymbol bindings st 0
idx <- bFindOrInsert bindings st sym
idx `shouldBe` 0
print =<< bContainsSymbol bindings st sym
sym' <- bLookupSymbol bindings st idx
-- Owned by symbol table now:
-- S.bDestroy sBindings sym
result <- S.bIsEqual sBindings sym sym'
result `shouldBe` True
pass
pass
it "is possible to lookup a value corresponding to a key" $ \bindings -> do
let sBindings = symBindings bindings
withSymTab bindings $ \st -> do
bInit bindings st
_ <- S.withSymbol sBindings $ \sym -> do
S.bInit sBindings sym "abcd"
-- NOTE: unsafe lookup, don't use it before symbol is inserted
idx1 <- bLookupIndex bindings st sym
_ <- bFindOrInsert bindings st sym
idx2 <- bLookupIndex bindings st sym
S.bDestroy sBindings sym
idx1 `shouldBe` 0xffffffff
idx2 `shouldBe` 0
pass
setupAndTeardown :: FilePath -> ActionWith Bindings -> IO ()
setupAndTeardown dir =
bracket (setup dir) teardown
setup :: FilePath -> IO Bindings
setup dir = do
createDirectoryIfMissing False dir
compileCode cgExternals cgTestCode dir
loadNativeCode dir
teardown :: Bindings -> IO ()
teardown =
dlclose . dynamicLib
compileCode
:: ModuleBuilderT IO Externals
-> (Symbol -> SymbolTable -> Externals -> ModuleBuilderT IO ())
-> FilePath -> IO ()
compileCode cgExts cgHelperCode dir = do
ctx <- LibLLVM.mkContext
llvmMod <- LibLLVM.mkModule ctx "eclair"
td <- LibLLVM.getTargetData llvmMod
llvmIR <- runModuleBuilderT $ do
exts <- cgExts
symbol <- hoist intoIO $ S.codegen exts
let cfg = Config Nothing ctx td
symbolDestructor iterPtr = do
_ <- call (S.symbolDestroy symbol) [iterPtr]
pass
vec <- instantiate "test" (S.tySymbol symbol) $ runConfigT cfg $ V.codegen exts (Just symbolDestructor)
hm <- runConfigT cfg $ HM.codegen symbol exts
symTab <- hoist intoIO $ codegen (S.tySymbol symbol) vec hm
cgHelperCode symbol symTab exts
let llvmIRText = ppllvm llvmIR
writeFileText (llFile dir) llvmIRText
callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir]
cgExternals :: ModuleBuilderT IO Externals
cgExternals = do
mallocFn <- extern "malloc" [i32] (ptr i8)
freeFn <- extern "free" [ptr i8] void
memcpyFn <- extern "memcpy" [ptr i8, ptr i8, i64] (ptr i8)
memcmpFn <- extern "memcmp" [ptr i8, ptr i8, i64] i32
pure $ Externals mallocFn freeFn notUsed memcpyFn memcmpFn notUsed notUsed
cgTestCode :: S.Symbol -> SymbolTable -> Externals -> ModuleBuilderT IO ()
cgTestCode sym symTab exts = do
let mallocFn = extMalloc exts
freeFn = extFree exts
tySym = S.tySymbol sym
symTabTy = tySymbolTable symTab
_ <- function "eclair_symbol_table_new" [] (ptr symTabTy) $ \[] ->
ret =<< call mallocFn [int32 4096]
_ <- function "eclair_symbol_table_delete" [(ptr symTabTy, "hm")] void $ \[h] ->
call freeFn [h]
let args = [(ptr symTabTy, "symbol_table"), (ptr tySym, "symbol")]
_ <- function "eclair_symbol_table_contains_symbol_helper" args i8 $ \[st, s] -> do
result <- call (symbolTableContainsSymbol symTab) [st, s]
ret =<< result `zext` i8
let args' = [(ptr symTabTy, "symbol_table"), (i32, "value")]
_ <- function "eclair_symbol_table_contains_index_helper" args' i8 $ \[st, v] -> do
result <- call (symbolTableContainsIndex symTab) [st, v]
ret =<< result `zext` i8
S.cgTestCode sym exts
loadNativeCode :: FilePath -> IO Bindings
loadNativeCode dir = do
lib <- dlopen (soFile dir) [RTLD_LAZY]
sBindings <- S.loadNativeCode' lib
fnNew <- dlsym lib "eclair_symbol_table_new"
fnDelete <- dlsym lib "eclair_symbol_table_delete"
fnInit <- dlsym lib "eclair_symbol_table_init"
fnDestroy <- dlsym lib "eclair_symbol_table_destroy"
fnFindOrInsert <- dlsym lib "eclair_symbol_table_find_or_insert"
fnLookupSymbol <- dlsym lib "eclair_symbol_table_lookup_symbol"
fnContainsSymbol <- dlsym lib "eclair_symbol_table_contains_symbol_helper"
fnLookupIndex <- dlsym lib "eclair_symbol_table_lookup_index"
fnContainsIndex <- dlsym lib "eclair_symbol_table_contains_index_helper"
pure $ Bindings
{ dynamicLib = lib
, symBindings = sBindings
, withSymTab = mkWithSymTab fnNew fnDelete
, bInit = mkInit fnInit
, bDestroy = mkDestroy fnDestroy
, bFindOrInsert = mkFindOrInsert fnFindOrInsert
, bLookupSymbol = mkLookupSymbol fnLookupSymbol
, bLookupIndex = mkLookupIndex fnLookupIndex
, bContainsSymbol = mkContainsSymbol fnContainsSymbol
, bContainsIndex = mkContainsIndex fnContainsIndex
}
where
mkNew fn = callFFI fn (retPtr retVoid) []
mkDelete fn st = callFFI fn retVoid [argPtr st]
mkWithSymTab fnNew fnDelete =
bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete)
mkInit fn st = callFFI fn retVoid [argPtr st]
mkDestroy fn st = callFFI fn retVoid [argPtr st]
mkFindOrInsert fn st sym =
fromIntegral <$> callFFI fn retCUInt [argPtr st, argPtr sym]
mkLookupSymbol fn st value =
castPtr <$> callFFI fn (retPtr retVoid) [argPtr st, argCUInt $ fromIntegral value]
mkLookupIndex fn st sym =
fromIntegral <$> callFFI fn retCUInt [argPtr st, argPtr sym]
mkContainsSymbol fn st sym = do
result <- callFFI fn retCUChar [argPtr st, argPtr sym]
pure $ result == 1
mkContainsIndex fn st value = do
result <- callFFI fn retCUChar [argPtr st, argCUInt $ fromIntegral value]
pure $ result == 1
testDir :: FilePath
testDir = "/tmp/eclair-symbol-table"
notUsed :: a
notUsed = panic "Not used"
intoIO :: Identity a -> IO a
intoIO = pure . runIdentity
llFile, soFile :: FilePath -> FilePath
llFile dir = dir "symbol-table.ll"
soFile dir = dir "symbol-table.so"
================================================
FILE: tests/eclair/Test/Eclair/LLVM/SymbolUtils.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.Eclair.LLVM.SymbolUtils
( Bindings(..)
, Symbol(..)
, cgTestCode
, loadNativeCode
, loadNativeCode'
, soFile
, llFile
) where
import Prelude hiding (void, Symbol)
import Control.Exception
import Eclair.LLVM.Symbol
import Eclair.LLVM.Codegen hiding (retVoid, nullPtr)
import Eclair.LLVM.Externals
import Foreign.LibFFI
import Foreign hiding (void, bit)
import System.Posix.DynamicLinker
import System.FilePath
import Foreign.C
data Bindings
= Bindings
{ dynamicLib :: DL
, withSymbol :: forall a. (Ptr Symbol -> IO a) -> IO a
, bInit :: Ptr Symbol -> String -> IO ()
, bDestroy :: Ptr Symbol -> IO ()
, bIsEqual :: Ptr Symbol -> Ptr Symbol -> IO Bool
, bLength :: Ptr Symbol -> IO Word32
, bData :: Ptr Symbol -> IO String
}
cgTestCode :: Symbol -> Externals -> ModuleBuilderT IO ()
cgTestCode sym exts = do
let mallocFn = extMalloc exts
freeFn = extFree exts
memcpyFn = extMemcpy exts
symTy = tySymbol sym
_ <- function "eclair_symbol_new" [] (ptr symTy) $ \[] ->
ret =<< call mallocFn [int32 16]
_ <- function "eclair_symbol_delete" [(ptr symTy, "sym")] void $ \[s] ->
call freeFn [s]
let initArgs = [(ptr symTy, "sym"), (i32, "length"), (ptr i8, "data")]
_ <- function "eclair_symbol_init_helper" initArgs void $ \[s, len, str] -> do
-- Needed because "str" is freed afterwards
memory <- call mallocFn [len]
_ <- call memcpyFn [memory, str, len, bit 0]
_ <- call (symbolInit sym) [s, len, memory]
pass
let isEqArgs = [(ptr symTy, "sym1"), (ptr symTy, "sym2")]
_ <- function "eclair_symbol_is_equal_helper" isEqArgs i8 $ \[sym1, sym2] -> do
isEq <- call (symbolIsEqual sym) [sym1, sym2]
ret =<< isEq `zext` i8
_ <- function "eclair_symbol_length" [(ptr symTy, "sym")] i32 $ \[s] -> do
lenPtr <- gep s [int32 0, int32 0]
ret =<< load lenPtr 0
_ <- function "eclair_symbol_data" [(ptr symTy, "sym")] (ptr i8) $ \[s] -> do
lenPtr <- gep s [int32 0, int32 1]
ret =<< load lenPtr 0
pass
loadNativeCode :: FilePath -> IO Bindings
loadNativeCode dir = do
lib <- dlopen (soFile dir) [RTLD_LAZY]
loadNativeCode' lib
loadNativeCode' :: DL -> IO Bindings
loadNativeCode' lib = do
fnNew <- dlsym lib "eclair_symbol_new"
fnDelete <- dlsym lib "eclair_symbol_delete"
fnInit <- dlsym lib "eclair_symbol_init_helper"
fnDestroy <- dlsym lib "eclair_symbol_destroy"
fnIsEqual <- dlsym lib "eclair_symbol_is_equal_helper"
fnLength <- dlsym lib "eclair_symbol_length"
fnData <- dlsym lib "eclair_symbol_data"
let getLength = mkLength fnLength
pure $ Bindings
{ dynamicLib = lib
, withSymbol = mkWithSymbol fnNew fnDelete
, bInit = mkInit fnInit
, bDestroy = mkDestroy fnDestroy
, bIsEqual = mkIsEqual fnIsEqual
, bLength = getLength
, bData = mkData fnData getLength
}
where
mkNew fn = callFFI fn (retPtr retVoid) []
mkDelete fn sym = callFFI fn retVoid [argPtr sym]
mkWithSymbol fnNew fnDelete =
bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete)
mkInit fn sym str = do
let len = fromIntegral $ length str
callFFI fn retVoid [argPtr sym, argCUInt len, argString str]
mkDestroy fn sym = callFFI fn retVoid [argPtr sym]
mkIsEqual fn sym1 sym2 = do
result <- callFFI fn retCUChar [argPtr sym1, argPtr sym2]
pure $ result == 1
mkLength fn sym = do
fromIntegral <$> callFFI fn retCUInt [argPtr sym]
mkData fn getLength sym = do
len <- fromIntegral <$> getLength sym
strPtr <- callFFI fn (retPtr retCChar) [argPtr sym]
peekCAStringLen (strPtr, len)
soFile :: FilePath -> FilePath
soFile dir = dir "symbol.so"
llFile :: FilePath -> FilePath
llFile dir = dir "symbol.ll"
================================================
FILE: tests/eclair/Test/Eclair/LLVM/VectorSpec.hs
================================================
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.Eclair.LLVM.VectorSpec
( module Test.Eclair.LLVM.VectorSpec
) where
import Prelude hiding (void)
import qualified LLVM.C.API as LibLLVM
import Eclair.LLVM.Vector
import Eclair.LLVM.Codegen hiding (retVoid, nullPtr)
import Eclair.LLVM.Externals
import Foreign.LibFFI
import Foreign hiding (void)
import System.Posix.DynamicLinker
import Control.Exception
import System.Directory.Extra
import System.Process.Extra
import System.FilePath
import Test.Hspec
type Value = Int
data Bindings
= Bindings
{ dynamicLib :: DL
, withVec :: (Ptr Vector -> IO ()) -> IO ()
, bInit :: Ptr Vector -> IO ()
, bDestroy :: Ptr Vector -> IO ()
, bPush :: Ptr Vector -> Value -> IO Word32
, bSize :: Ptr Vector -> IO Word64
, bCapacity :: Ptr Vector -> IO Word64
, bGetValue :: Ptr Vector -> Int -> IO Value
}
spec :: Spec
spec = describe "Vector" $ aroundAll (setupAndTeardown testDir) $ parallel $ do
it "can be initialized and destroyed" $ \bindings ->
withVec bindings $ \v -> do
bInit bindings v
bDestroy bindings v
it "can store multiple elements" $ \bindings -> do
withVec bindings $ \v -> do
bInit bindings v
idx1 <- bPush bindings v 42
idx2 <- bPush bindings v 123
value2 <- bGetValue bindings v 1
value1 <- bGetValue bindings v 0
bDestroy bindings v
idx1 `shouldBe` 0
idx2 `shouldBe` 1
value1 `shouldBe` 42
value2 `shouldBe` 123
it "can store duplicate values" $ \bindings -> do
withVec bindings $ \v -> do
bInit bindings v
idx1 <- bPush bindings v 42
idx2 <- bPush bindings v 42
value1 <- bGetValue bindings v 0
value2 <- bGetValue bindings v 1
bDestroy bindings v
idx1 `shouldBe` 0
idx2 `shouldBe` 1
value1 `shouldBe` 42
value2 `shouldBe` 42
it "keeps track of the number of elements inside" $ \bindings ->
withVec bindings $ \v -> do
bInit bindings v
bSize bindings v >>= (`shouldBe` 0)
-- This vector allocates on initialization
bCapacity bindings v >>= (`shouldBe` 16)
_ <- bPush bindings v 1
bSize bindings v >>= (`shouldBe` 1)
bCapacity bindings v >>= (`shouldBe` 16)
_ <- bPush bindings v 2
bSize bindings v >>= (`shouldBe` 2)
bCapacity bindings v >>= (`shouldBe` 16)
for_ [0..13] $ bPush bindings v
bSize bindings v >>= (`shouldBe` 16)
bCapacity bindings v >>= (`shouldBe` 16)
_ <- bPush bindings v 42
bSize bindings v >>= (`shouldBe` 17)
bCapacity bindings v >>= (`shouldBe` 32)
for_ [0..15] $ bPush bindings v
bSize bindings v >>= (`shouldBe` 33)
bCapacity bindings v >>= (`shouldBe` 64)
bDestroy bindings v
it "always keeps order of elements, even after resizing" $ \bindings ->
withVec bindings $ \v -> do
bInit bindings v
-- This does several reallocations
for_ [0..99] $ bPush bindings v
bSize bindings v >>= (`shouldBe` 100)
bCapacity bindings v >>= (`shouldBe` 128)
for_ [0..99] $ \i -> do
bGetValue bindings v i >>= (`shouldBe` i)
bDestroy bindings v
setupAndTeardown :: FilePath -> ActionWith Bindings -> IO ()
setupAndTeardown dir =
bracket (setup dir) teardown
setup :: FilePath -> IO Bindings
setup dir = do
createDirectoryIfMissing False dir
compileCode cgExternals cgTestCode dir
loadNativeCode dir
teardown :: Bindings -> IO ()
teardown =
dlclose . dynamicLib
compileCode
:: ModuleBuilderT IO Externals
-> (Vector -> Operand -> Operand -> ModuleBuilderT IO ())
-> FilePath -> IO ()
compileCode cgExts cgHelperCode dir = do
ctx <- LibLLVM.mkContext
llvmMod <- LibLLVM.mkModule ctx "eclair"
td <- LibLLVM.getTargetData llvmMod
llvmIR <- runModuleBuilderT $ do
exts <- cgExts
let cfg = Config Nothing ctx td
vec <- instantiate "test" i32 $ runConfigT cfg $
codegen exts Nothing -- TODO destructor
cgHelperCode vec (extMalloc exts) (extFree exts)
let llvmIRText = ppllvm llvmIR
writeFileText (llFile dir) llvmIRText
callProcess "clang" ["-fPIC", "-shared", "-O0", "-o", soFile dir, llFile dir]
cgExternals :: ModuleBuilderT IO Externals
cgExternals = do
mallocFn <- extern "malloc" [i32] (ptr i8)
freeFn <- extern "free" [ptr i8] void
memcpyFn <- extern "llvm.memcpy.p0i8.p0i8.i64" [ptr i8, ptr i8, i64, i1] void
pure $ Externals mallocFn freeFn notUsed memcpyFn notUsed notUsed notUsed
cgTestCode :: Vector -> Operand -> Operand -> ModuleBuilderT IO ()
cgTestCode vec mallocFn freeFn = do
let vecTypes = vectorTypes vec
vecTy = tyVector vecTypes
valueTy = tyElement vecTypes
_ <- function "eclair_vector_new_test" [] (ptr vecTy) $ \[] ->
ret =<< call mallocFn [int32 24]
_ <- function "eclair_vector_delete_test" [(ptr vecTy, "vec")] void $ \[v] ->
call freeFn [v]
_ <- function "eclair_vector_capacity_test" [(ptr vecTy, "vec")] i32 $ \[v] -> do
capPtr <- gep v [int32 0, int32 2]
ret =<< load capPtr 0
_ <- function "eclair_value_new_test" [(i32, "value")] (ptr valueTy) $ \[v] -> do
vPtr <- call mallocFn [int32 4]
store vPtr 0 v
ret vPtr
_ <- function "eclair_value_delete_test" [(ptr valueTy, "value")] void $ \[v] ->
call freeFn [v]
pass
loadNativeCode :: FilePath -> IO Bindings
loadNativeCode dir = do
lib <- dlopen (soFile dir) [RTLD_LAZY]
fnNew <- dlsym lib "eclair_vector_new_test"
fnDelete <- dlsym lib "eclair_vector_delete_test"
fnValueNew <- dlsym lib "eclair_value_new_test"
fnValueDelete <- dlsym lib "eclair_value_delete_test"
fnInit <- dlsym lib "eclair_vector_init_test"
fnDestroy <- dlsym lib "eclair_vector_destroy_test"
fnPush <- dlsym lib "eclair_vector_push_test"
fnSize <- dlsym lib "eclair_vector_size_test"
fnCapacity <- dlsym lib "eclair_vector_capacity_test"
fnGetValue <- dlsym lib "eclair_vector_get_value_test"
pure $ Bindings
{ dynamicLib = lib
, withVec = mkWithVec fnNew fnDelete
, bInit = mkInit fnInit
, bDestroy = mkDestroy fnDestroy
, bPush = mkPush fnValueNew fnValueDelete fnPush
, bSize = mkSize fnSize
, bCapacity = mkCapacity fnCapacity
, bGetValue = mkGetValue fnGetValue
}
where
mkNew fn = callFFI fn (retPtr retVoid) []
mkDelete fn vec = callFFI fn retVoid [argPtr vec]
mkWithVec fnNew fnDelete =
bracket (castPtr <$> mkNew fnNew) (mkDelete fnDelete)
mkInit fn vec = callFFI fn retVoid [argPtr vec]
mkDestroy fn vec = callFFI fn retVoid [argPtr vec]
mkPush fnValueNew fnValueDelete fn vec value =
withValue fnValueNew fnValueDelete value $ \valuePtr ->
fromIntegral <$> callFFI fn retCUInt [argPtr vec, argPtr valuePtr]
mkSize fn vec =
fromIntegral <$> callFFI fn retCULong [argPtr vec]
mkCapacity fn vec =
fromIntegral <$> callFFI fn retCULong [argPtr vec]
mkGetValue fn vec idx = do
resultPtr <- callFFI fn (retPtr retCUInt) [argPtr vec, argCUInt $ fromIntegral idx]
fromIntegral <$> peek resultPtr
withValue fnNew fnDelete value =
bracket
(castPtr <$> callFFI fnNew (retPtr retCUChar) [argCUInt $ fromIntegral value])
(\valuePtr -> callFFI fnDelete retVoid [argPtr valuePtr])
testDir :: FilePath
testDir = "/tmp/eclair-vector"
llFile, soFile :: FilePath -> FilePath
llFile dir = dir "vector.ll"
soFile dir = dir "vector.so"
notUsed :: a
notUsed = panic "Not used"
================================================
FILE: tests/eclair/Test/Eclair/LSP/HandlersSpec.hs
================================================
module Test.Eclair.LSP.HandlersSpec
( module Test.Eclair.LSP.HandlersSpec
) where
import Eclair
import Eclair.TypeSystem
import Eclair.Common.Location
import Eclair.LSP.Monad
import Eclair.LSP.Handlers
import qualified Data.Map as M
import Test.Hspec
spec :: Spec
spec = describe "LSP handlers" $ parallel $ do
hoverSpec
documentHighlightSpec
diagnosticsSpec
hoverSpec :: Spec
hoverSpec = describe "Hover action" $ do
it "reports types on hover" $ do
let file = fixture "hover.eclair"
srcPos1 = SourcePos 5 7 -- 0-indexed!
srcPos2 = SourcePos 11 9
(result1, result2) <- withLSP (Just file) $ do
(,) <$> hoverHandler file srcPos1
<*> hoverHandler file srcPos2
result1 `shouldBe`
HoverOk (SourceSpan file (SourcePos 5 7) (SourcePos 5 8)) U32
result2 `shouldBe`
HoverOk (SourceSpan file (SourcePos 11 8) (SourcePos 11 13)) Str
it "returns an error if file not found in vfs" $ do
let file = "not_found.eclair"
srcPos = SourcePos 11 10
result <- withLSP Nothing $ hoverHandler file srcPos
result `shouldBe` HoverError file (SourcePos 11 10) "File not found in VFS!"
it "returns an error if no hover information available for position" $ do
let file = fixture "hover.eclair"
srcPos1 = SourcePos 4 1 -- whitespace
srcPos2 = SourcePos 14 10 -- outside of file bounds
(result1, result2) <- withLSP (Just file) $ do
(,) <$> hoverHandler file srcPos1
<*> hoverHandler file srcPos2
result1 `shouldBe`
HoverError file srcPos1 "No type information for this position!"
result2 `shouldBe`
HoverError file srcPos2 "Error computing location offset in file!"
it "returns an error if file failed to parse" $ do
let file = fixture "unparsable.eclair"
srcPos = SourcePos 4 1
result <- withLSP (Just file) $ hoverHandler file srcPos
result `shouldBe` HoverError file srcPos "File contains errors!"
it "returns an error if file failed to typecheck" $ do
let file = fixture "type_errors.eclair"
srcPos = SourcePos 4 1
result <- withLSP (Just file) $ hoverHandler file srcPos
result `shouldBe` HoverError file srcPos "File contains errors!"
documentHighlightSpec :: Spec
documentHighlightSpec = describe "Document highlight action" $ do
it "highlights the same identifiers in scope" $ do
let file = fixture "document_highlight.eclair"
srcPos1 = SourcePos 6 10 -- x
srcPos2 = SourcePos 6 13 -- y
srcPos3 = SourcePos 7 10 -- z
(result1, result2, result3) <- withLSP (Just file) $ do
(,,) <$> documentHighlightHandler file srcPos1
<*> documentHighlightHandler file srcPos2
<*> documentHighlightHandler file srcPos3
result1 `shouldBe` DocHLOk
[ SourceSpan file (SourcePos 6 10) (SourcePos 6 11)
, SourceSpan file (SourcePos 7 7) (SourcePos 7 8)
]
result2 `shouldBe` DocHLOk
[ SourceSpan file (SourcePos 6 13) (SourcePos 6 14)
, SourceSpan file (SourcePos 8 15) (SourcePos 8 16)
]
result3 `shouldBe` DocHLOk
[ SourceSpan file (SourcePos 7 10) (SourcePos 7 11)
, SourceSpan file (SourcePos 8 12) (SourcePos 8 13)
]
it "returns an error if file not found in vfs" $ do
let file = "not_found.eclair"
srcPos = SourcePos 11 10
result <- withLSP Nothing $ documentHighlightHandler file srcPos
result `shouldBe` DocHLError file (SourcePos 11 10) "File not found in VFS!"
it "returns an error if file failed to parse" $ do
let file = fixture "unparsable.eclair"
srcPos = SourcePos 4 1
result <- withLSP (Just file) $ documentHighlightHandler file srcPos
result `shouldBe` DocHLError file srcPos "Failed to get highlight information!"
diagnosticsSpec :: Spec
diagnosticsSpec = describe "Diagnostics action" $ parallel $ do
it "reports nothing if file is OK" $ do
let file = fixture "hover.eclair"
DiagnosticsOk diags <- withLSP (Just file) $ diagnosticsHandler file
length diags `shouldBe` 0
it "reports invalid syntax" $ do
let file = fixture "invalid_syntax.eclair"
DiagnosticsOk diags <- withLSP (Just file) $ diagnosticsHandler file
length diags `shouldBe` 2
it "returns an error if file not found in vfs" $ do
let file = "not_found.eclair"
result <- withLSP Nothing $ diagnosticsHandler file
result `shouldBe` DiagnosticsError file Nothing "File not found in VFS!"
it "reports semantic errors" $ do
let file = fixture "semantic_errors.eclair"
DiagnosticsOk [diag] <- withLSP (Just file) $ diagnosticsHandler file
let (Diagnostic _ _ _ msg) = diag
toString msg `shouldContain` "Wildcard in top level fact"
it "reports type errors" $ do
let file = fixture "type_errors.eclair"
DiagnosticsOk (_:_:diag:_) <- withLSP (Just file) $ diagnosticsHandler file
let (Diagnostic _ _ _ msg) = diag
toString msg `shouldContain` "Type mismatch"
fixture :: FilePath -> FilePath
fixture file =
"./tests/eclair/fixtures/lsp/" <> file
withLSP :: Maybe FilePath -> LspM a -> IO a
withLSP mFile m = runLSP $ do
case mFile of
Nothing -> pass
Just file -> do
fileContents <- decodeUtf8 <$> readFileBS file
lift $ vfsSetFile file fileContents
vfsVar <- lift getVfsVar
let readVFS path = do
vfs <- readMVar vfsVar
pure $! M.lookup path vfs
let params = Parameters 1 Nothing readVFS
local (const params) m
================================================
FILE: tests/eclair/Test/Eclair/LSP/JSONSpec.hs
================================================
{-# LANGUAGE QuasiQuotes #-}
module Test.Eclair.LSP.JSONSpec
( module Test.Eclair.LSP.JSONSpec
) where
import qualified Data.Hermes as H
import Eclair.Common.Location
import Eclair.LSP.Types
import Eclair.LSP.JSON
import Eclair.LSP.Handlers
import Eclair.JSON
import Eclair.TypeSystem
import Test.Hspec
import NeatInterpolation
decodesAs :: (Eq a, Show a) => H.Decoder a -> Text -> a -> IO ()
decodesAs decoder txt expected =
H.decodeEither decoder (encodeUtf8 txt)
`shouldBe` Right expected
spec :: Spec
spec = describe "LSP JSON processing" $ parallel $ do
describe "JSON encoding" $ parallel $ do
it "can encode response to JSON" $ do
encodeJSON (responseToJSON (HoverResponse (HoverOk (SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)) U32)))
`shouldBe` [text|
{"type":"success","hover":{"location":{"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}},"type":"u32"}}
|]
encodeJSON (responseToJSON (HoverResponse (HoverError "/etc/passwd" (SourcePos 11 13) "sample hover error message")))
`shouldBe` [text|
{"type":"error","error":{"file":"/etc/passwd","position":{"line":11,"column":13},"message":"sample hover error message"}}
|]
encodeJSON (responseToJSON (DocumentHighlightResponse (DocHLOk [SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)])))
`shouldBe` [text|
{"type":"success","highlights":[{"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}}]}
|]
encodeJSON (responseToJSON (DocumentHighlightResponse (DocHLError "/etc/passwd" (SourcePos 11 13) "sample highlight error message")))
`shouldBe` [text|
{"type":"error","error":{"file":"/etc/passwd","position":{"line":11,"column":13},"message":"sample highlight error message"}}
|]
encodeJSON (responseToJSON (DiagnosticsResponse (DiagnosticsOk [Diagnostic Parser (SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)) Error "sample diagnostic message"])))
`shouldBe` [text|
{"type":"success","diagnostics":[{"location":{"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}},"source":"Parser","severity":"error","message":"sample diagnostic message"}]}
|]
encodeJSON (responseToJSON (DiagnosticsResponse (DiagnosticsError "/etc/passwd" (Just (SourcePos 11 13)) "sample diagnostic error message")))
`shouldBe` [text|
{"type":"error","error":{"file":"/etc/passwd","position":{"line":11,"column":13},"message":"sample diagnostic error message"}}
|]
encodeJSON (responseToJSON (DiagnosticsResponse (DiagnosticsError "/etc/passwd" Nothing "sample diagnostic error message")))
`shouldBe` [text|
{"type":"error","error":{"file":"/etc/passwd","position":{"line":0,"column":0},"message":"sample diagnostic error message"}}
|]
encodeJSON (responseToJSON SuccessResponse)
`shouldBe` [text|
{"success":true}
|]
encodeJSON (responseToJSON ShuttingDown)
`shouldBe` [text|
{"shutdown":true}
|]
it "can encode diagnostic to JSON" $ do
encodeJSON (diagnosticToJSON (Diagnostic Parser (SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)) Error "sample diagnostic message"))
`shouldBe` [text|
{"location":{"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}},"source":"Parser","severity":"error","message":"sample diagnostic message"}
|]
it "can encode diagnostic source to JSON" $ do
encodeJSON (diagnosticSourceToJSON Parser)
`shouldBe` [text|
"Parser"
|]
encodeJSON (diagnosticSourceToJSON Typesystem)
`shouldBe` [text|
"Typesystem"
|]
encodeJSON (diagnosticSourceToJSON SemanticAnalysis)
`shouldBe` [text|
"SemanticAnalysis"
|]
encodeJSON (diagnosticSourceToJSON Transpiler)
`shouldBe` [text|
"Transpiler"
|]
it "can encode severity to JSON" $ do
encodeJSON (severityToJSON Error)
`shouldBe` [text|
"error"
|]
it "can encode source span to JSON" $ do
encodeJSON (srcSpanToJSON (SourceSpan "/etc/passwd" (SourcePos 11 13) (SourcePos 17 19)))
`shouldBe` [text|
{"file":"/etc/passwd","start":{"line":11,"column":13},"end":{"line":17,"column":19}}
|]
it "can encode source position to JSON" $ do
encodeJSON (srcPosToJSON (SourcePos 32 58))
`shouldBe` [text|
{"line":32,"column":58}
|]
it "can encode type to JSON" $ do
encodeJSON (typeToJSON U32) `shouldBe` [text|
"u32"
|]
encodeJSON (typeToJSON Str) `shouldBe` [text|
"string"
|]
describe "JSON decoding" $ parallel $ do
it "can decode hover command from JSON" $ do
decodesAs
commandDecoder
[text|
{
"type": "hover",
"command": {
"position": {"line": 100, "column": 22},
"file": "/tmp/file.eclair"
}
}
|]
(Hover "/tmp/file.eclair" (SourcePos 100 22))
it "can decode document-highlight command from JSON" $ do
decodesAs
commandDecoder
[text|
{
"type": "document-highlight",
"command": {
"position": {"line": 100, "column": 22},
"file": "/tmp/file.eclair"
}
}
|]
(DocumentHighlight "/tmp/file.eclair" (SourcePos 100 22))
it "can decode diagnostics command from JSON" $ do
decodesAs
commandDecoder
[text|
{
"type": "diagnostics",
"command": {
"file": "/tmp/file.eclair"
}
}
|]
(Diagnostics "/tmp/file.eclair")
it "can decode update-vfs command from JSON" $ do
decodesAs
commandDecoder
[text|
{
"type": "update-vfs",
"command": {
"file": "/etc/passwd",
"contents": "root:*:0:0:System Administrator:/var/root:/bin/sh"
}
}
|]
(UpdateVFS "/etc/passwd" "root:*:0:0:System Administrator:/var/root:/bin/sh")
it "can decode a hover command from JSON" $ do
decodesAs
hoverDecoder
[text|
{
"position": {"line": 100, "column": 22},
"file": "/tmp/file.eclair"
}
|]
(Hover "/tmp/file.eclair" (SourcePos 100 22))
it "can decode a document highlight command from JSON" $ do
decodesAs
referencesDecoder
[text|
{
"position": {"line": 100, "column": 22},
"file": "/tmp/file.eclair"
}
|]
(DocumentHighlight "/tmp/file.eclair" (SourcePos 100 22))
it "can decode a diagnostics command from JSON" $ do
decodesAs
diagnosticsDecoder
[text|
{
"file": "/etc/passwd"
}
|]
(Diagnostics "/etc/passwd")
it "can decode a update-vfs command from JSON" $ do
decodesAs
updateVfsDecoder
[text|
{
"file": "/etc/passwd",
"contents": "root:*:0:0:System Administrator:/var/root:/bin/sh"
}
|]
(UpdateVFS "/etc/passwd" "root:*:0:0:System Administrator:/var/root:/bin/sh")
it "can decode a source position from JSON" $ do
decodesAs
srcPosDecoder
[text|{"line": 42, "column": 10}|]
(SourcePos 42 10)
================================================
FILE: tests/eclair/Test/Eclair/RA/IndexSelectionSpec.hs
================================================
{-# LANGUAGE QuasiQuotes #-}
module Test.Eclair.RA.IndexSelectionSpec
( module Test.Eclair.RA.IndexSelectionSpec
) where
import qualified Data.Map as Map
import qualified Data.Set as Set
import Test.Hspec
import System.FilePath
import Eclair.Common.Id
import Eclair.Parser
import Eclair.AST.Lower
import Eclair.RA.IndexSelection
import Eclair.RA.Transforms
import qualified Eclair.TypeSystem as TS
import qualified Data.Text as T
import NeatInterpolation
idxSel :: FilePath -> Text -> IndexMap
idxSel path text' = do
let file = "tests/fixtures" path <.> "eclair"
ast = (\(parsed, _, _, _) -> parsed) $ parseText file text'
in case TS.typeCheck ast of
Left _ -> panic $ "Failed to typecheck " <> toText file <> "!"
Right typeInfo -> do
let ra = simplify $ compileToRA [] ast
(indexMap, _) = runIndexSelection (TS.infoTypedefs typeInfo) ra
in indexMap
toSelection :: [(T.Text, [[Column]])] -> IndexMap
toSelection info = idxMap
where
(texts, colss) = unzip info
f text' cols = (Id text', Set.fromList $ map Index cols)
idxMap = Map.fromList $ zipWith f texts colss
spec :: Spec
spec = describe "Index selection" $ parallel $ do
it "creates indexes for a single fact" $ do
idxSel "single_fact" [text|
@def edge(u32, u32).
@def another(u32, u32, u32).
edge(1, 2).
edge(2, 3).
another(1,2,3).
|] `shouldBe`
toSelection [("another", [[0,1,2]]), ("edge", [[0,1]])]
it "creates indexes for a single non-recursive rule" $ do
idxSel "single_nonrecursive_rule" [text|
@def edge(u32, u32).
@def path(u32, u32).
edge(1,2).
path(x,y) :- edge(x,y).
|] `shouldBe`
toSelection [("edge", [[0,1]]), ("path", [[0,1]])]
it "creates indexes for nested searches correctly" $ do
idxSel "multiple_rule_clauses" [text|
@def first(u32).
@def second(u32, u32).
@def third(u32, u32).
first(1).
second(2, 3).
third(x, y) :-
first(y),
second(x, y).
|] `shouldBe`
toSelection [ ("first", [[0]])
, ("second", [[1,0]])
, ("third", [[0,1]])
]
it "creates indexes for rules with equal columns correctly" $ do
idxSel "rule_equal_columns" [text|
@def a(u32).
@def b(u32, u32).
@def c(u32, u32, u32).
@def d(u32, u32, u32, u32).
@def other(u32).
a(1).
b(2, 3).
c(4, 5, 6).
d(7, 8, 9, 10).
other(11).
a(x) :-
b(x, x),
other(x).
a(y) :-
c(y, y, y),
other(y).
a(z) :-
d(z, z, 12, z),
other(z).
|] `shouldBe`
toSelection [ ("a", [[0]])
, ("b", [[0,1]])
, ("c", [[0,1,2]])
, ("d", [[2,0,1,3]])
, ("other", [[0]])
]
it "handles multiple indexes on 1 rule correctly" $ do
idxSel "index_selection" [text|
@def a(u32).
@def b(u32).
@def c(u32, u32, u32).
@def d(u32).
@def triple(u32, u32, u32).
a(1).
b(1).
c(1, 2, 3).
d(1).
triple(4, 5, 6).
a(y) :-
// [2]
triple(x, y, 123).
b(x) :-
// [0,1] => [0,1,2]
triple(123, 456, x).
c(x, y, z) :-
// [0,1,2]
triple(x, y, z).
d(x) :-
// [0, 2]
triple(123, x, 456).
|] `shouldBe`
toSelection [ ("a", [[0]])
, ("b", [[0]])
, ("c", [[0,1,2]])
, ("d", [[0]])
, ("triple", [[0,1,2], [2,0]])
]
it "selects a minimal set of indexes for a rule" $ do
idxSel "minimal_index_selection" [text|
@def first(u32, u32, u32).
@def second(u32).
@def third(u32).
@def fourth(u32).
@def fifth(u32).
// [1,0,2] ([0,1,2] re-ordered)
first(1, 2, 3).
second(1).
third(1).
fourth(1).
fifth(1).
second(x) :-
// [0,1] => [1,0,2]
first(123, 456, x).
third(x) :-
// [2,1]
first(x, 123, 456).
fourth(x) :-
// [2] => [2,1]
first(x, a, 123).
fifth(x) :-
// [1] => [1,0,2]
first(x, 123, a).
|] `shouldBe`
toSelection [ ("first", [[1,0,2], [2,1]])
, ("second", [[0]])
, ("third", [[0]])
, ("fourth", [[0]])
, ("fifth", [[0]])
]
it "creates indexes for a rule with 2 clauses of same name" $ do
idxSel "multiple_clauses_same_name" [text|
@def link(u32, u32).
@def chain(u32, u32, u32).
link(1,2).
chain(x, y, z) :-
link(x, y),
link(y, z).
|] `shouldBe`
toSelection [ ("link", [[0,1]])
, ("chain", [[0,1,2]])
]
it "creates indexes for a single recursive rule" $ do
idxSel "single_recursive_rule" [text|
@def edge(u32, u32).
@def path(u32, u32).
edge(1,2).
path(x, y) :-
edge(x, z),
path(z, y).
|] `shouldBe`
toSelection [ ("delta_path", [[0,1]])
, ("new_path", [[0,1]])
, ("path", [[0,1]])
, ("edge", [[0,1]])
]
-- TODO variant where one is recursive
it "creates indexes for mutually recursive rules" $ do
idxSel "mutually_recursive_rules" [text|
@def a(u32).
@def b(u32).
@def c(u32).
@def d(u32).
a(x) :- b(x), c(x).
b(1).
b(x) :- c(x), d(x).
c(2).
c(x) :- b(x), d(x).
d(3).
|] `shouldBe`
toSelection [ ("a", [[0]])
, ("b", [[0]])
, ("new_b", [[0]])
, ("delta_b", [[0]])
, ("c", [[0]])
, ("new_c", [[0]])
, ("delta_c", [[0]])
, ("d", [[0]])
]
-- TODO tests for rules with >2 clauses, ...
it "calculates index correctly for multiple columns at once" $ do
idxSel "index_for_chain" [text|
@def a(u32, u32, u32, u32, u32).
@def b(u32).
a(1,2,3,4,5).
b(1).
b(x) :-
// [0,1]
a(123, 123, x, y, z).
b(x) :-
// [2,3,4]
a(x, y, 123, 123, 123).
b(x) :-
// [4] => [4,2,3]
a(x, y, z, a, 123).
|] `shouldBe`
toSelection [ ("a", [[0,1,2,3,4], [4,2,3]])
, ("b", [[0]])
]
it "calculates indexes correctly for programs with no top level facts" $ do
idxSel "no_top_level_facts" [text|
@def edge(u32, u32).
@def path(u32, u32).
path(x, y) :-
edge(x, y).
path(x, z) :-
edge(x, y),
path(y, z).
|] `shouldBe`
toSelection [ ("delta_path", [[0,1]])
, ("new_path", [[0,1]])
, ("path", [[0,1]])
, ("edge", [[0,1]])
]
it "does not use 'NoElem' constraints to compute indexes" $ do
idxSel "index_selection_should_only_check_for_equalities" [text|
@def edge(u32, u32).
@def reachable(u32, u32).
reachable(x, y) :-
edge(x, y).
reachable(x, z) :-
edge(x, _),
reachable(_, z).
|] `shouldBe`
toSelection [ ("delta_reachable", [[0,1]])
, ("new_reachable", [[0,1]])
, ("reachable", [[0,1]])
, ("edge", [[0,1]])
]
it "creates indexes for a rule with arithmetic" $ do
idxSel "multiple_clauses_same_name" [text|
@def first(u32).
@def second(u32, u32).
@def third(u32, u32).
first(1).
second(2, 3).
third(x + 1, y) :-
first(y),
second(x, y + 1).
|] `shouldBe`
toSelection [ ("first", [[0]])
, ("second", [[1,0]])
, ("third", [[0,1]])
]
it "creates indexes for negations with wildcards correctly" $ do
idxSel "multiple_rule_clauses" [text|
@def first(u32).
@def second(u32, u32).
@def third(u32, u32).
first(1).
second(2, 3).
third(x, x) :-
first(x),
!second(_, x).
|] `shouldBe`
toSelection [ ("first", [[0]])
, ("second", [[1,0]])
, ("third", [[0,1]])
]
idxSel "multiple_rule_clauses" [text|
@def first(u32).
@def second(u32, u32).
@def third(u32, u32).
@def fourth(u32).
first(1).
second(2, 3).
third(x, x) :-
first(x),
!second(_, x).
fourth(x) :-
first(x),
!second(x, _).
|] `shouldBe`
toSelection [ ("first", [[0]])
, ("second", [[0,1], [1]])
, ("third", [[0,1]])
, ("fourth", [[0]])
]
================================================
FILE: tests/eclair/fixtures/lsp/document_highlight.eclair
================================================
@def edge(u32, u32).
@def reachable(u32, u32).
reachable(x, y) :-
edge(x, y).
reachable(x, y) :-
edge(x, z),
reachable(z, y).
================================================
FILE: tests/eclair/fixtures/lsp/hover.eclair
================================================
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
@def literal(string) output.
reachable(x, y) :-
edge(x, y).
reachable(x, z) :-
edge(x, y),
reachable(y, z).
literal("abc").
================================================
FILE: tests/eclair/fixtures/lsp/invalid_syntax.eclair
================================================
@def number(u32) output.
number(123, ).
number(456).
number(789, ).
================================================
FILE: tests/eclair/fixtures/lsp/semantic_errors.eclair
================================================
@def wildcard_in_fact(u32) output.
wildcard_in_fact(_).
================================================
FILE: tests/eclair/fixtures/lsp/type_errors.eclair
================================================
@def edge(u32, u32).
@def reachable(string, u32).
@def literal(u32).
reachable(x, y) :-
edge(x, y).
reachable(x, z) :-
edge(x, y),
reachable(y, z).
literal("abc").
================================================
FILE: tests/eclair/fixtures/lsp/unparsable.eclair
================================================
@def edge(u32, u32).
@def reachable(u32, u32).
@def literal(string).
reachable(x, y) :-
reachable(x, z) :-
1.
literal("abc")
================================================
FILE: tests/eclair/test.hs
================================================
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
================================================
FILE: tests/end_to_end/compile_and_run_native.eclair
================================================
// This checks if eclair can be correctly compiled and linked with C code.
// RUN: split-file %s %t
// RUN: %eclair compile %t/program.eclair > %t/program.ll
// RUN: %clang -o %t/program -O0 %t/main.c %t/program.ll
// RUN: %t/program | FileCheck %s
// CHECK: (1, 2)
// CHECK-NEXT: (1, 3)
// CHECK-NEXT: (2, 3)
//--- program.eclair
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
reachable(x, y) :-
edge(x, y).
reachable(x, y) :-
edge(x, z),
reachable(z, y).
//--- main.c
#include
#include
#include
#include
struct program;
extern struct program* eclair_program_init();
extern void eclair_program_destroy(struct program*);
extern void eclair_program_run(struct program*);
extern void eclair_add_facts(struct program*, uint32_t fact_type, uint32_t* data, size_t fact_count);
extern void eclair_add_fact(struct program*, uint32_t fact_type, uint32_t* data);
extern uint32_t* eclair_get_facts(struct program*, uint32_t fact_type);
extern void eclair_free_buffer(uint32_t* data);
int main(int argc, char** argv)
{
struct program* prog = eclair_program_init();
// edge(1,2), edge(2,3)
uint32_t data[] = {
1, 2,
2, 3
};
eclair_add_facts(prog, 0, data, 2);
eclair_program_run(prog);
// NOTE: normally you call btree_size here to figure out the size
uint32_t* data_out = eclair_get_facts(prog, 1);
printf("REACHABLE: (%d, %d)\n", data_out[0], data_out[1]); // (1,2)
printf("REACHABLE: (%d, %d)\n", data_out[2], data_out[3]); // (2,3)
printf("REACHABLE: (%d, %d)\n", data_out[4], data_out[5]); // (1,3)
eclair_free_buffer(data_out);
eclair_program_destroy(prog);
return 0;
}
================================================
FILE: tests/end_to_end/compile_and_run_wasm.eclair
================================================
// This checks if eclair can be correctly compiled to WASM and used from JS.
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// TODO: we really need to have our own WASM allocator..
// RUN: test -e %t/walloc.c || wget https://raw.githubusercontent.com/wingo/walloc/master/walloc.c -O %t/walloc.c
// RUN: %clang -O0 --target=wasm32 -mbulk-memory -nostdlib -c -o %t/walloc.o %t/walloc.c
// RUN: %eclair compile --target wasm32 %t/program.eclair > %t/program.ll
// RUN: %clang -O0 --target=wasm32 -mbulk-memory -nostdlib -c -o %t/program.o %t/program.ll
// RUN: %wasm-ld --no-entry --import-memory -o %t/program.wasm %t/program.o %t/walloc.o
// RUN: node %t/program.js | FileCheck %s
// CHECK: [ 1, 2 ]
// CHECK-NEXT: [ 1, 3 ]
// CHECK-NEXT: [ 1, 4 ]
// CHECK-NEXT: [ 2, 3 ]
// CHECK-NEXT: [ 2, 4 ]
// CHECK-NEXT: [ 3, 4 ]
//--- program.eclair
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
reachable(x, y) :-
edge(x, y).
reachable(x, y) :-
edge(x, z),
reachable(z, y).
//--- program.js
const fs = require("fs");
const addFact = (
instance,
memory,
program,
factType,
factArray,
columnCount
) => {
const byteCount = columnCount * Uint32Array.BYTES_PER_ELEMENT;
const address = instance.exports.eclair_malloc(byteCount);
const array = new Uint32Array(memory.buffer, address, byteCount);
array.set(factArray);
instance.exports.eclair_add_fact(program, factType, address);
instance.exports.eclair_free(address);
};
const addFacts = (
instance,
memory,
program,
factType,
factsArray,
columnCount
) => {
const byteCount =
factsArray.length * columnCount * Uint32Array.BYTES_PER_ELEMENT;
const address = instance.exports.eclair_malloc(byteCount);
const array = new Uint32Array(memory.buffer, address, byteCount);
array.set(factsArray.flat());
instance.exports.eclair_add_facts(
program,
factType,
address,
factsArray.length
);
instance.exports.eclair_free(address);
};
const EDGE = 0;
const REACHABLE = 1;
const NUM_COLUMNS = 2;
const main = () => {
const bytes = fs.readFileSync("TEST_DIR/program.wasm");
const mod = new WebAssembly.Module(bytes);
const memory = new WebAssembly.Memory({ initial: 3, maximum: 3 });
const imports = { env: { memory } };
const instance = new WebAssembly.Instance(mod, imports);
const program = instance.exports.eclair_program_init();
addFact(instance, memory, program, EDGE, [1, 2], NUM_COLUMNS);
addFacts(instance, memory, program, EDGE, [[2, 3], [3, 4]], NUM_COLUMNS);
instance.exports.eclair_program_run(program);
const resultAddress = instance.exports.eclair_get_facts(program, REACHABLE);
const factCount = instance.exports.eclair_fact_count(program, REACHABLE);
const resultArray = new Uint32Array(
memory.buffer,
resultAddress,
factCount * NUM_COLUMNS
);
const results = Array.from(resultArray);
for (let i = 0; i < results.length; i += NUM_COLUMNS) {
const fact = results.slice(i, i + NUM_COLUMNS);
console.log(fact);
}
instance.exports.eclair_free_buffer(resultAddress);
instance.exports.eclair_program_destroy(program);
};
main();
================================================
FILE: tests/end_to_end/compile_and_run_with_extern.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile %t/program.eclair > %t/program.ll
// RUN: %clang -o %t/program -O0 %t/main.c %t/program.ll
// RUN: %t/program | FileCheck %s
// No output, since it never matches
// CHECK: func triggered with: 456
// CHECK: func triggered with: 123
// CHECK-NEXT: COUNT: 1
// CHECK-NEXT: RESULT: 123
//--- program.eclair
@def edge(u32, u32) input.
@def test_externs(u32) output.
@extern func(u32) u32.
test_externs(func(123)).
test_externs(x) :-
edge(x, _),
x = func(456).
//--- main.c
#include
#include
#include
#include
struct program;
struct symbol_table;
extern struct program* eclair_program_init();
extern void eclair_program_destroy(struct program*);
extern void eclair_program_run(struct program*);
extern void eclair_add_facts(struct program*, uint32_t fact_type, uint32_t* data, size_t fact_count);
extern void eclair_add_fact(struct program*, uint32_t fact_type, uint32_t* data);
extern uint32_t* eclair_get_facts(struct program*, uint32_t fact_type);
extern uint32_t eclair_fact_count(struct program*, uint32_t fact_type);
extern void eclair_free_buffer(uint32_t* data);
uint32_t func(struct symbol_table*, uint32_t value) {
printf("func triggered with: %d\n", value);
return value;
}
int main(int argc, char** argv)
{
struct program* prog = eclair_program_init();
// edge(1,2), edge(2,3)
uint32_t data[] = {
1, 2,
2, 3
};
eclair_add_facts(prog, 0, data, 2);
eclair_program_run(prog);
uint32_t fact_count = eclair_fact_count(prog, 1);
uint32_t* data_out = eclair_get_facts(prog, 1);
printf("COUNT: %d\n", fact_count);
printf("RESULT: %d\n", data_out[0]);
eclair_free_buffer(data_out);
eclair_program_destroy(prog);
return 0;
}
================================================
FILE: tests/hello.eclair
================================================
// This is mostly a sanity check that the test-suite works
// (and that LLVM can compile to LLVM correctly).
// RUN: %eclair compile %s | FileCheck %s
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
reachable(x, y) :-
edge(x, y).
reachable(x, y) :-
edge(x, z),
reachable(z, y).
// CHECK: eclair_program_run
================================================
FILE: tests/lit.cfg
================================================
import subprocess
import lit.formats
from lit.llvm.subst import ToolSubst
config.name = "Eclair integration tests"
config.test_format = lit.formats.ShTest(False) # 1 test per file
config.suffixes = ['.eclair']
config.excludes = ['Test', 'lsp'] # Don't look in the directory for Haskell tests
test_dir = os.path.dirname(__file__)
config.test_source_root = test_dir
config.test_exec_root = test_dir
analysis_dir = test_dir + '/../cbits/'
config.environment['DATALOG_DIR'] = analysis_dir
config.environment['ECLAIR_USE_COLOR'] = '0'
eclair = subprocess.check_output('which eclair 2> /dev/null || cabal list-bin eclair', shell=True).decode().rstrip('\n')
config.substitutions.append(('%eclair', eclair))
util_dir = test_dir + '/utils/'
config.substitutions.append(('%extract_snippet', util_dir + 'extract_snippet'))
clang = subprocess.check_output('which clang-17 2> /dev/null || which clang', shell=True).decode().rstrip('\n')
wasm_ld = subprocess.check_output('which wasm-ld-17 2> /dev/null || which wasm-ld', shell=True).decode().rstrip('\n')
config.substitutions.append(('%clang', clang))
config.substitutions.append(('%wasm-ld', wasm_ld))
================================================
FILE: tests/lowering/arithmetic.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: %extract_snippet %t/actual_eir.out "fn.*eclair_program_run" > %t/actual_eir_snippet.out
// RUN: diff %t/expected_eir.out %t/actual_eir_snippet.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_program_run" > %t/actual_llvm_snippet.out
// RUN: diff %t/expected_llvm.out %t/actual_llvm_snippet.out
//--- program.eclair
@def fact1(u32) input.
@def fact2(u32) output.
fact2(y) :-
fact1(x),
y = x + 3.
fact2(x + 3) :-
fact1(x).
fact2((x + 1) + 2 * x) :-
fact1(x).
fact2(x) :-
fact1(x),
fact1(x + 4),
fact1(x + 4).
fact2((8 - x) / x) :-
fact1(x).
//--- expected_ra.out
search fact1 as fact10 do
project (((8 - fact10[0]) / fact10[0])) into fact2
search fact1 as fact10 do
search fact1 as fact11 where (fact11[0] = (fact10[0] + 4)) do
search fact1 as fact12 where (fact12[0] = (fact10[0] + 4)) do
project (fact10[0]) into fact2
search fact1 as fact10 do
project (((fact10[0] + 1) + (2 * fact10[0]))) into fact2
search fact1 as fact10 do
project ((fact10[0] + 3)) into fact2
search fact1 as fact10 do
project ((fact10[0] + 3)) into fact2
//--- expected_eir.out
export fn eclair_program_run(*Program) -> Void
{
lower_bound_value = fact1.stack_allocate Value
upper_bound_value = fact1.stack_allocate Value
lower_bound_value.0 = 0
upper_bound_value.0 = 4294967295
begin_iter = fact1.stack_allocate Iter
end_iter = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value, begin_iter)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value, end_iter)
loop
{
condition = fact1.iter_is_equal(begin_iter, end_iter)
if (condition)
{
goto range_query.end
}
current = fact1.iter_current(begin_iter)
value = fact2.stack_allocate Value
value.0 = ((8 - current.0) / current.0)
fact2.insert(FN_ARG[0].2, value)
fact1.iter_next(begin_iter)
}
range_query.end:
lower_bound_value_1 = fact1.stack_allocate Value
upper_bound_value_1 = fact1.stack_allocate Value
lower_bound_value_1.0 = 0
upper_bound_value_1.0 = 4294967295
begin_iter_1 = fact1.stack_allocate Iter
end_iter_1 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_1, begin_iter_1)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_1, end_iter_1)
loop
{
condition_1 = fact1.iter_is_equal(begin_iter_1, end_iter_1)
if (condition_1)
{
goto range_query.end_1
}
current_1 = fact1.iter_current(begin_iter_1)
lower_bound_value_2 = fact1.stack_allocate Value
upper_bound_value_2 = fact1.stack_allocate Value
lower_bound_value_2.0 = (current_1.0 + 4)
upper_bound_value_2.0 = (current_1.0 + 4)
begin_iter_2 = fact1.stack_allocate Iter
end_iter_2 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_2, begin_iter_2)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_2, end_iter_2)
loop
{
condition_2 = fact1.iter_is_equal(begin_iter_2, end_iter_2)
if (condition_2)
{
goto range_query.end_2
}
current_2 = fact1.iter_current(begin_iter_2)
lower_bound_value_3 = fact1.stack_allocate Value
upper_bound_value_3 = fact1.stack_allocate Value
lower_bound_value_3.0 = (current_1.0 + 4)
upper_bound_value_3.0 = (current_1.0 + 4)
begin_iter_3 = fact1.stack_allocate Iter
end_iter_3 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_3, begin_iter_3)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_3, end_iter_3)
loop
{
condition_3 = fact1.iter_is_equal(begin_iter_3, end_iter_3)
if (condition_3)
{
goto range_query.end_3
}
current_3 = fact1.iter_current(begin_iter_3)
value_1 = fact2.stack_allocate Value
value_1.0 = current_1.0
fact2.insert(FN_ARG[0].2, value_1)
fact1.iter_next(begin_iter_3)
}
range_query.end_3:
fact1.iter_next(begin_iter_2)
}
range_query.end_2:
fact1.iter_next(begin_iter_1)
}
range_query.end_1:
lower_bound_value_4 = fact1.stack_allocate Value
upper_bound_value_4 = fact1.stack_allocate Value
lower_bound_value_4.0 = 0
upper_bound_value_4.0 = 4294967295
begin_iter_4 = fact1.stack_allocate Iter
end_iter_4 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_4, begin_iter_4)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_4, end_iter_4)
loop
{
condition_4 = fact1.iter_is_equal(begin_iter_4, end_iter_4)
if (condition_4)
{
goto range_query.end_4
}
current_4 = fact1.iter_current(begin_iter_4)
value_2 = fact2.stack_allocate Value
value_2.0 = ((current_4.0 + 1) + (2 * current_4.0))
fact2.insert(FN_ARG[0].2, value_2)
fact1.iter_next(begin_iter_4)
}
range_query.end_4:
lower_bound_value_5 = fact1.stack_allocate Value
upper_bound_value_5 = fact1.stack_allocate Value
lower_bound_value_5.0 = 0
upper_bound_value_5.0 = 4294967295
begin_iter_5 = fact1.stack_allocate Iter
end_iter_5 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_5, begin_iter_5)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_5, end_iter_5)
loop
{
condition_5 = fact1.iter_is_equal(begin_iter_5, end_iter_5)
if (condition_5)
{
goto range_query.end_5
}
current_5 = fact1.iter_current(begin_iter_5)
value_3 = fact2.stack_allocate Value
value_3.0 = (current_5.0 + 3)
fact2.insert(FN_ARG[0].2, value_3)
fact1.iter_next(begin_iter_5)
}
range_query.end_5:
lower_bound_value_6 = fact1.stack_allocate Value
upper_bound_value_6 = fact1.stack_allocate Value
lower_bound_value_6.0 = 0
upper_bound_value_6.0 = 4294967295
begin_iter_6 = fact1.stack_allocate Iter
end_iter_6 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_6, begin_iter_6)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_6, end_iter_6)
loop
{
condition_6 = fact1.iter_is_equal(begin_iter_6, end_iter_6)
if (condition_6)
{
goto range_query.end_6
}
current_6 = fact1.iter_current(begin_iter_6)
value_4 = fact2.stack_allocate Value
value_4.0 = (current_6.0 + 3)
fact2.insert(FN_ARG[0].2, value_4)
fact1.iter_next(begin_iter_6)
}
range_query.end_6:
}
//--- expected_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [1 x i32], i32 1
%stack.ptr_1 = alloca [1 x i32], i32 1
%stack.ptr_2 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_3 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_4 = alloca [1 x i32], i32 1
%stack.ptr_5 = alloca [1 x i32], i32 1
%stack.ptr_6 = alloca [1 x i32], i32 1
%stack.ptr_7 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_8 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_9 = alloca [1 x i32], i32 1
%stack.ptr_10 = alloca [1 x i32], i32 1
%stack.ptr_11 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_12 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_13 = alloca [1 x i32], i32 1
%stack.ptr_14 = alloca [1 x i32], i32 1
%stack.ptr_15 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_16 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_17 = alloca [1 x i32], i32 1
%stack.ptr_18 = alloca [1 x i32], i32 1
%stack.ptr_19 = alloca [1 x i32], i32 1
%stack.ptr_20 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_21 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_22 = alloca [1 x i32], i32 1
%stack.ptr_23 = alloca [1 x i32], i32 1
%stack.ptr_24 = alloca [1 x i32], i32 1
%stack.ptr_25 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_26 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_27 = alloca [1 x i32], i32 1
%stack.ptr_28 = alloca [1 x i32], i32 1
%stack.ptr_29 = alloca [1 x i32], i32 1
%stack.ptr_30 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_31 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_32 = alloca [1 x i32], i32 1
%0 = getelementptr [1 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 0, ptr %0
%1 = getelementptr [1 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 4294967295, ptr %1
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %2, ptr %stack.ptr_0, ptr %stack.ptr_2)
%3 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %3, ptr %stack.ptr_1, ptr %stack.ptr_3)
br label %loop_0
loop_0:
%4 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_2, ptr %stack.ptr_3)
br i1 %4, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%5 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_2)
%6 = getelementptr [1 x i32], ptr %stack.ptr_4, i32 0, i32 0
%7 = getelementptr [1 x i32], ptr %5, i32 0, i32 0
%8 = load i32, ptr %7
%9 = sub i32 8, %8
%10 = getelementptr [1 x i32], ptr %5, i32 0, i32 0
%11 = load i32, ptr %10
%12 = udiv i32 %9, %11
store i32 %12, ptr %6
%13 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%14 = call ccc i1 @eclair_btree_insert_value_0(ptr %13, ptr %stack.ptr_4)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_2)
br label %loop_0
range_query.end:
%15 = getelementptr [1 x i32], ptr %stack.ptr_5, i32 0, i32 0
store i32 0, ptr %15
%16 = getelementptr [1 x i32], ptr %stack.ptr_6, i32 0, i32 0
store i32 4294967295, ptr %16
%17 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %17, ptr %stack.ptr_5, ptr %stack.ptr_7)
%18 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %18, ptr %stack.ptr_6, ptr %stack.ptr_8)
br label %loop_1
loop_1:
%19 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_7, ptr %stack.ptr_8)
br i1 %19, label %if_1, label %end_if_1
if_1:
br label %range_query.end_1
end_if_1:
%20 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_7)
%21 = getelementptr [1 x i32], ptr %stack.ptr_9, i32 0, i32 0
%22 = getelementptr [1 x i32], ptr %20, i32 0, i32 0
%23 = load i32, ptr %22
%24 = add i32 %23, 4
store i32 %24, ptr %21
%25 = getelementptr [1 x i32], ptr %stack.ptr_10, i32 0, i32 0
%26 = getelementptr [1 x i32], ptr %20, i32 0, i32 0
%27 = load i32, ptr %26
%28 = add i32 %27, 4
store i32 %28, ptr %25
%29 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %29, ptr %stack.ptr_9, ptr %stack.ptr_11)
%30 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %30, ptr %stack.ptr_10, ptr %stack.ptr_12)
br label %loop_2
loop_2:
%31 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_11, ptr %stack.ptr_12)
br i1 %31, label %if_2, label %end_if_2
if_2:
br label %range_query.end_2
end_if_2:
%32 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_11)
%33 = getelementptr [1 x i32], ptr %stack.ptr_13, i32 0, i32 0
%34 = getelementptr [1 x i32], ptr %20, i32 0, i32 0
%35 = load i32, ptr %34
%36 = add i32 %35, 4
store i32 %36, ptr %33
%37 = getelementptr [1 x i32], ptr %stack.ptr_14, i32 0, i32 0
%38 = getelementptr [1 x i32], ptr %20, i32 0, i32 0
%39 = load i32, ptr %38
%40 = add i32 %39, 4
store i32 %40, ptr %37
%41 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %41, ptr %stack.ptr_13, ptr %stack.ptr_15)
%42 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %42, ptr %stack.ptr_14, ptr %stack.ptr_16)
br label %loop_3
loop_3:
%43 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_15, ptr %stack.ptr_16)
br i1 %43, label %if_3, label %end_if_3
if_3:
br label %range_query.end_3
end_if_3:
%44 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_15)
%45 = getelementptr [1 x i32], ptr %stack.ptr_17, i32 0, i32 0
%46 = getelementptr [1 x i32], ptr %20, i32 0, i32 0
%47 = load i32, ptr %46
store i32 %47, ptr %45
%48 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%49 = call ccc i1 @eclair_btree_insert_value_0(ptr %48, ptr %stack.ptr_17)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_15)
br label %loop_3
range_query.end_3:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_11)
br label %loop_2
range_query.end_2:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_7)
br label %loop_1
range_query.end_1:
%50 = getelementptr [1 x i32], ptr %stack.ptr_18, i32 0, i32 0
store i32 0, ptr %50
%51 = getelementptr [1 x i32], ptr %stack.ptr_19, i32 0, i32 0
store i32 4294967295, ptr %51
%52 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %52, ptr %stack.ptr_18, ptr %stack.ptr_20)
%53 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %53, ptr %stack.ptr_19, ptr %stack.ptr_21)
br label %loop_4
loop_4:
%54 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_20, ptr %stack.ptr_21)
br i1 %54, label %if_4, label %end_if_4
if_4:
br label %range_query.end_4
end_if_4:
%55 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_20)
%56 = getelementptr [1 x i32], ptr %stack.ptr_22, i32 0, i32 0
%57 = getelementptr [1 x i32], ptr %55, i32 0, i32 0
%58 = load i32, ptr %57
%59 = add i32 %58, 1
%60 = getelementptr [1 x i32], ptr %55, i32 0, i32 0
%61 = load i32, ptr %60
%62 = mul i32 2, %61
%63 = add i32 %59, %62
store i32 %63, ptr %56
%64 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%65 = call ccc i1 @eclair_btree_insert_value_0(ptr %64, ptr %stack.ptr_22)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_20)
br label %loop_4
range_query.end_4:
%66 = getelementptr [1 x i32], ptr %stack.ptr_23, i32 0, i32 0
store i32 0, ptr %66
%67 = getelementptr [1 x i32], ptr %stack.ptr_24, i32 0, i32 0
store i32 4294967295, ptr %67
%68 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %68, ptr %stack.ptr_23, ptr %stack.ptr_25)
%69 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %69, ptr %stack.ptr_24, ptr %stack.ptr_26)
br label %loop_5
loop_5:
%70 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_25, ptr %stack.ptr_26)
br i1 %70, label %if_5, label %end_if_5
if_5:
br label %range_query.end_5
end_if_5:
%71 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_25)
%72 = getelementptr [1 x i32], ptr %stack.ptr_27, i32 0, i32 0
%73 = getelementptr [1 x i32], ptr %71, i32 0, i32 0
%74 = load i32, ptr %73
%75 = add i32 %74, 3
store i32 %75, ptr %72
%76 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%77 = call ccc i1 @eclair_btree_insert_value_0(ptr %76, ptr %stack.ptr_27)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_25)
br label %loop_5
range_query.end_5:
%78 = getelementptr [1 x i32], ptr %stack.ptr_28, i32 0, i32 0
store i32 0, ptr %78
%79 = getelementptr [1 x i32], ptr %stack.ptr_29, i32 0, i32 0
store i32 4294967295, ptr %79
%80 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %80, ptr %stack.ptr_28, ptr %stack.ptr_30)
%81 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %81, ptr %stack.ptr_29, ptr %stack.ptr_31)
br label %loop_6
loop_6:
%82 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_30, ptr %stack.ptr_31)
br i1 %82, label %if_6, label %end_if_6
if_6:
br label %range_query.end_6
end_if_6:
%83 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_30)
%84 = getelementptr [1 x i32], ptr %stack.ptr_32, i32 0, i32 0
%85 = getelementptr [1 x i32], ptr %83, i32 0, i32 0
%86 = load i32, ptr %85
%87 = add i32 %86, 3
store i32 %87, ptr %84
%88 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%89 = call ccc i1 @eclair_btree_insert_value_0(ptr %88, ptr %stack.ptr_32)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_30)
br label %loop_6
range_query.end_6:
ret void
}
================================================
FILE: tests/lowering/clause_with_same_vars.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: %extract_snippet %t/actual_eir.out "fn eclair_program_run" > %t/actual_eclair_program_run.out
// RUN: diff %t/expected_eclair_program_run.out %t/actual_eclair_program_run.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_program_run" > %t/actual_eclair_program_run_llvm.out
// RUN: diff %t/expected_eclair_program_run_llvm.out %t/actual_eclair_program_run_llvm.out
//--- program.eclair
@def a(u32) output.
@def b(u32, u32) input.
@def c(u32, u32, u32, u32, u32) input.
@def other(u32) input.
a(x) :-
b(x, x),
other(x).
a(y) :-
c(y, y, 42, _, y),
other(y).
//--- expected_ra.out
search c as c0 where (c0[2] = 42) do
if c0[0] = c0[1] do
if c0[0] = c0[4] do
search other as other1 where (c0[0] = other1[0]) do
project (c0[0]) into a
search b as b0 do
if b0[0] = b0[1] do
search other as other1 where (b0[0] = other1[0]) do
project (b0[0]) into a
//--- expected_eclair_program_run.out
export fn eclair_program_run(*Program) -> Void
{
lower_bound_value = c.stack_allocate Value
upper_bound_value = c.stack_allocate Value
lower_bound_value.0 = 0
lower_bound_value.1 = 0
lower_bound_value.2 = 42
lower_bound_value.3 = 0
lower_bound_value.4 = 0
upper_bound_value.0 = 4294967295
upper_bound_value.1 = 4294967295
upper_bound_value.2 = 42
upper_bound_value.3 = 4294967295
upper_bound_value.4 = 4294967295
begin_iter = c.stack_allocate Iter
end_iter = c.stack_allocate Iter
c.iter_lower_bound(FN_ARG[0].3, lower_bound_value, begin_iter)
c.iter_upper_bound(FN_ARG[0].3, upper_bound_value, end_iter)
loop
{
condition = c.iter_is_equal(begin_iter, end_iter)
if (condition)
{
goto range_query.end
}
current = c.iter_current(begin_iter)
condition_1 = (current.0 == current.1)
if (condition_1)
{
condition_2 = (current.0 == current.4)
if (condition_2)
{
lower_bound_value_1 = other.stack_allocate Value
upper_bound_value_1 = other.stack_allocate Value
lower_bound_value_1.0 = current.0
upper_bound_value_1.0 = current.0
begin_iter_1 = other.stack_allocate Iter
end_iter_1 = other.stack_allocate Iter
other.iter_lower_bound(FN_ARG[0].4, lower_bound_value_1, begin_iter_1)
other.iter_upper_bound(FN_ARG[0].4, upper_bound_value_1, end_iter_1)
loop
{
condition_3 = other.iter_is_equal(begin_iter_1, end_iter_1)
if (condition_3)
{
goto range_query.end_1
}
current_1 = other.iter_current(begin_iter_1)
value = a.stack_allocate Value
value.0 = current.0
a.insert(FN_ARG[0].1, value)
other.iter_next(begin_iter_1)
}
range_query.end_1:
}
}
c.iter_next(begin_iter)
}
range_query.end:
lower_bound_value_2 = b.stack_allocate Value
upper_bound_value_2 = b.stack_allocate Value
lower_bound_value_2.0 = 0
lower_bound_value_2.1 = 0
upper_bound_value_2.0 = 4294967295
upper_bound_value_2.1 = 4294967295
begin_iter_2 = b.stack_allocate Iter
end_iter_2 = b.stack_allocate Iter
b.iter_lower_bound(FN_ARG[0].2, lower_bound_value_2, begin_iter_2)
b.iter_upper_bound(FN_ARG[0].2, upper_bound_value_2, end_iter_2)
loop
{
condition_4 = b.iter_is_equal(begin_iter_2, end_iter_2)
if (condition_4)
{
goto range_query.end_2
}
current_2 = b.iter_current(begin_iter_2)
condition_5 = (current_2.0 == current_2.1)
if (condition_5)
{
lower_bound_value_3 = other.stack_allocate Value
upper_bound_value_3 = other.stack_allocate Value
lower_bound_value_3.0 = current_2.0
upper_bound_value_3.0 = current_2.0
begin_iter_3 = other.stack_allocate Iter
end_iter_3 = other.stack_allocate Iter
other.iter_lower_bound(FN_ARG[0].4, lower_bound_value_3, begin_iter_3)
other.iter_upper_bound(FN_ARG[0].4, upper_bound_value_3, end_iter_3)
loop
{
condition_6 = other.iter_is_equal(begin_iter_3, end_iter_3)
if (condition_6)
{
goto range_query.end_3
}
current_3 = other.iter_current(begin_iter_3)
value_1 = a.stack_allocate Value
value_1.0 = current_2.0
a.insert(FN_ARG[0].1, value_1)
other.iter_next(begin_iter_3)
}
range_query.end_3:
}
b.iter_next(begin_iter_2)
}
range_query.end_2:
}
//--- expected_eclair_program_run_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [5 x i32], i32 1
%stack.ptr_1 = alloca [5 x i32], i32 1
%stack.ptr_2 = alloca %btree_iterator_t_2, i32 1
%stack.ptr_3 = alloca %btree_iterator_t_2, i32 1
%stack.ptr_4 = alloca [1 x i32], i32 1
%stack.ptr_5 = alloca [1 x i32], i32 1
%stack.ptr_6 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_7 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_8 = alloca [1 x i32], i32 1
%stack.ptr_9 = alloca [2 x i32], i32 1
%stack.ptr_10 = alloca [2 x i32], i32 1
%stack.ptr_11 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_12 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_13 = alloca [1 x i32], i32 1
%stack.ptr_14 = alloca [1 x i32], i32 1
%stack.ptr_15 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_16 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_17 = alloca [1 x i32], i32 1
%0 = getelementptr [5 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 0, ptr %0
%1 = getelementptr [5 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 0, ptr %1
%2 = getelementptr [5 x i32], ptr %stack.ptr_0, i32 0, i32 2
store i32 42, ptr %2
%3 = getelementptr [5 x i32], ptr %stack.ptr_0, i32 0, i32 3
store i32 0, ptr %3
%4 = getelementptr [5 x i32], ptr %stack.ptr_0, i32 0, i32 4
store i32 0, ptr %4
%5 = getelementptr [5 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 4294967295, ptr %5
%6 = getelementptr [5 x i32], ptr %stack.ptr_1, i32 0, i32 1
store i32 4294967295, ptr %6
%7 = getelementptr [5 x i32], ptr %stack.ptr_1, i32 0, i32 2
store i32 42, ptr %7
%8 = getelementptr [5 x i32], ptr %stack.ptr_1, i32 0, i32 3
store i32 4294967295, ptr %8
%9 = getelementptr [5 x i32], ptr %stack.ptr_1, i32 0, i32 4
store i32 4294967295, ptr %9
%10 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_lower_bound_2(ptr %10, ptr %stack.ptr_0, ptr %stack.ptr_2)
%11 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_upper_bound_2(ptr %11, ptr %stack.ptr_1, ptr %stack.ptr_3)
br label %loop_0
loop_0:
%12 = call ccc i1 @eclair_btree_iterator_is_equal_2(ptr %stack.ptr_2, ptr %stack.ptr_3)
br i1 %12, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%13 = call ccc ptr @eclair_btree_iterator_current_2(ptr %stack.ptr_2)
%14 = getelementptr [5 x i32], ptr %13, i32 0, i32 0
%15 = load i32, ptr %14
%16 = getelementptr [5 x i32], ptr %13, i32 0, i32 1
%17 = load i32, ptr %16
%18 = icmp eq i32 %15, %17
br i1 %18, label %if_1, label %end_if_3
if_1:
%19 = getelementptr [5 x i32], ptr %13, i32 0, i32 0
%20 = load i32, ptr %19
%21 = getelementptr [5 x i32], ptr %13, i32 0, i32 4
%22 = load i32, ptr %21
%23 = icmp eq i32 %20, %22
br i1 %23, label %if_2, label %end_if_2
if_2:
%24 = getelementptr [1 x i32], ptr %stack.ptr_4, i32 0, i32 0
%25 = getelementptr [5 x i32], ptr %13, i32 0, i32 0
%26 = load i32, ptr %25
store i32 %26, ptr %24
%27 = getelementptr [1 x i32], ptr %stack.ptr_5, i32 0, i32 0
%28 = getelementptr [5 x i32], ptr %13, i32 0, i32 0
%29 = load i32, ptr %28
store i32 %29, ptr %27
%30 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_lower_bound_0(ptr %30, ptr %stack.ptr_4, ptr %stack.ptr_6)
%31 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_upper_bound_0(ptr %31, ptr %stack.ptr_5, ptr %stack.ptr_7)
br label %loop_1
loop_1:
%32 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_6, ptr %stack.ptr_7)
br i1 %32, label %if_3, label %end_if_1
if_3:
br label %range_query.end_1
end_if_1:
%33 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_6)
%34 = getelementptr [1 x i32], ptr %stack.ptr_8, i32 0, i32 0
%35 = getelementptr [5 x i32], ptr %13, i32 0, i32 0
%36 = load i32, ptr %35
store i32 %36, ptr %34
%37 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%38 = call ccc i1 @eclair_btree_insert_value_0(ptr %37, ptr %stack.ptr_8)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_6)
br label %loop_1
range_query.end_1:
br label %end_if_2
end_if_2:
br label %end_if_3
end_if_3:
call ccc void @eclair_btree_iterator_next_2(ptr %stack.ptr_2)
br label %loop_0
range_query.end:
%39 = getelementptr [2 x i32], ptr %stack.ptr_9, i32 0, i32 0
store i32 0, ptr %39
%40 = getelementptr [2 x i32], ptr %stack.ptr_9, i32 0, i32 1
store i32 0, ptr %40
%41 = getelementptr [2 x i32], ptr %stack.ptr_10, i32 0, i32 0
store i32 4294967295, ptr %41
%42 = getelementptr [2 x i32], ptr %stack.ptr_10, i32 0, i32 1
store i32 4294967295, ptr %42
%43 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_1(ptr %43, ptr %stack.ptr_9, ptr %stack.ptr_11)
%44 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_1(ptr %44, ptr %stack.ptr_10, ptr %stack.ptr_12)
br label %loop_2
loop_2:
%45 = call ccc i1 @eclair_btree_iterator_is_equal_1(ptr %stack.ptr_11, ptr %stack.ptr_12)
br i1 %45, label %if_4, label %end_if_4
if_4:
br label %range_query.end_2
end_if_4:
%46 = call ccc ptr @eclair_btree_iterator_current_1(ptr %stack.ptr_11)
%47 = getelementptr [2 x i32], ptr %46, i32 0, i32 0
%48 = load i32, ptr %47
%49 = getelementptr [2 x i32], ptr %46, i32 0, i32 1
%50 = load i32, ptr %49
%51 = icmp eq i32 %48, %50
br i1 %51, label %if_5, label %end_if_6
if_5:
%52 = getelementptr [1 x i32], ptr %stack.ptr_13, i32 0, i32 0
%53 = getelementptr [2 x i32], ptr %46, i32 0, i32 0
%54 = load i32, ptr %53
store i32 %54, ptr %52
%55 = getelementptr [1 x i32], ptr %stack.ptr_14, i32 0, i32 0
%56 = getelementptr [2 x i32], ptr %46, i32 0, i32 0
%57 = load i32, ptr %56
store i32 %57, ptr %55
%58 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_lower_bound_0(ptr %58, ptr %stack.ptr_13, ptr %stack.ptr_15)
%59 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_upper_bound_0(ptr %59, ptr %stack.ptr_14, ptr %stack.ptr_16)
br label %loop_3
loop_3:
%60 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_15, ptr %stack.ptr_16)
br i1 %60, label %if_6, label %end_if_5
if_6:
br label %range_query.end_3
end_if_5:
%61 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_15)
%62 = getelementptr [1 x i32], ptr %stack.ptr_17, i32 0, i32 0
%63 = getelementptr [2 x i32], ptr %46, i32 0, i32 0
%64 = load i32, ptr %63
store i32 %64, ptr %62
%65 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%66 = call ccc i1 @eclair_btree_insert_value_0(ptr %65, ptr %stack.ptr_17)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_15)
br label %loop_3
range_query.end_3:
br label %end_if_6
end_if_6:
call ccc void @eclair_btree_iterator_next_1(ptr %stack.ptr_11)
br label %loop_2
range_query.end_2:
ret void
}
================================================
FILE: tests/lowering/comparisons.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: diff %t/expected_eir.out %t/actual_eir.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_program_run" > %t/actual_llvm_snippet.out
// RUN: diff %t/expected_llvm.out %t/actual_llvm_snippet.out
//--- program.eclair
@def fact1(u32, u32) input.
@def fact2(u32, u32) output.
fact2(x, 1) :-
z = x,
fact1(x, z),
y = 123,
fact1(y, x).
fact2(x, y) :-
123 = x,
fact1(y, x).
fact2(x, y) :-
123 < x,
123 <= x,
123 > x,
123 >= x,
123 != x,
fact1(y, x).
//--- expected_ra.out
search fact1 as fact10 do
if 123 < fact10[1] do
if 123 <= fact10[1] do
if 123 > fact10[1] do
if 123 >= fact10[1] do
if 123 != fact10[1] do
project (fact10[1], fact10[0]) into fact2
search fact1 as fact10 where (123 = fact10[1]) do
project (fact10[1], fact10[0]) into fact2
search fact1 as fact10 do
if fact10[1] = fact10[0] do
search fact1 as fact11 where (fact11[0] = 123 and fact10[0] = fact11[1]) do
project (fact10[0], 1) into fact2
//--- expected_eir.out
declare_type Program
{
symbol_table
fact1 btree(num_columns=2, index=[1,0], block_size=256, search_type=linear)
fact2 btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
}
export fn eclair_program_init() -> *Program
{
program = heap_allocate_program
symbol_table.init(program.0)
fact1.init_empty(program.1)
fact2.init_empty(program.2)
symbol_table.insert(program.0, "fact1")
symbol_table.insert(program.0, "fact2")
return program
}
export fn eclair_program_destroy(*Program) -> Void
{
symbol_table.destroy(FN_ARG[0].0)
fact1.destroy(FN_ARG[0].1)
fact2.destroy(FN_ARG[0].2)
free_program(FN_ARG[0])
}
export fn eclair_program_run(*Program) -> Void
{
lower_bound_value = fact1.stack_allocate Value
upper_bound_value = fact1.stack_allocate Value
lower_bound_value.0 = 0
lower_bound_value.1 = 0
upper_bound_value.0 = 4294967295
upper_bound_value.1 = 4294967295
begin_iter = fact1.stack_allocate Iter
end_iter = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value, begin_iter)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value, end_iter)
loop
{
condition = fact1.iter_is_equal(begin_iter, end_iter)
if (condition)
{
goto range_query.end
}
current = fact1.iter_current(begin_iter)
condition_1 = (123 < current.1)
if (condition_1)
{
condition_2 = (123 <= current.1)
if (condition_2)
{
condition_3 = (123 > current.1)
if (condition_3)
{
condition_4 = (123 >= current.1)
if (condition_4)
{
condition_5 = (123 != current.1)
if (condition_5)
{
value = fact2.stack_allocate Value
value.0 = current.1
value.1 = current.0
fact2.insert(FN_ARG[0].2, value)
}
}
}
}
}
fact1.iter_next(begin_iter)
}
range_query.end:
lower_bound_value_1 = fact1.stack_allocate Value
upper_bound_value_1 = fact1.stack_allocate Value
lower_bound_value_1.0 = 0
lower_bound_value_1.1 = 123
upper_bound_value_1.0 = 4294967295
upper_bound_value_1.1 = 123
begin_iter_1 = fact1.stack_allocate Iter
end_iter_1 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_1, begin_iter_1)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_1, end_iter_1)
loop
{
condition_6 = fact1.iter_is_equal(begin_iter_1, end_iter_1)
if (condition_6)
{
goto range_query.end_1
}
current_1 = fact1.iter_current(begin_iter_1)
value_1 = fact2.stack_allocate Value
value_1.0 = current_1.1
value_1.1 = current_1.0
fact2.insert(FN_ARG[0].2, value_1)
fact1.iter_next(begin_iter_1)
}
range_query.end_1:
lower_bound_value_2 = fact1.stack_allocate Value
upper_bound_value_2 = fact1.stack_allocate Value
lower_bound_value_2.0 = 0
lower_bound_value_2.1 = 0
upper_bound_value_2.0 = 4294967295
upper_bound_value_2.1 = 4294967295
begin_iter_2 = fact1.stack_allocate Iter
end_iter_2 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_2, begin_iter_2)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_2, end_iter_2)
loop
{
condition_7 = fact1.iter_is_equal(begin_iter_2, end_iter_2)
if (condition_7)
{
goto range_query.end_2
}
current_2 = fact1.iter_current(begin_iter_2)
condition_8 = (current_2.1 == current_2.0)
if (condition_8)
{
lower_bound_value_3 = fact1.stack_allocate Value
upper_bound_value_3 = fact1.stack_allocate Value
lower_bound_value_3.0 = 123
lower_bound_value_3.1 = current_2.0
upper_bound_value_3.0 = 123
upper_bound_value_3.1 = current_2.0
begin_iter_3 = fact1.stack_allocate Iter
end_iter_3 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_3, begin_iter_3)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_3, end_iter_3)
loop
{
condition_9 = fact1.iter_is_equal(begin_iter_3, end_iter_3)
if (condition_9)
{
goto range_query.end_3
}
current_3 = fact1.iter_current(begin_iter_3)
value_2 = fact2.stack_allocate Value
value_2.0 = current_2.0
value_2.1 = 1
fact2.insert(FN_ARG[0].2, value_2)
fact1.iter_next(begin_iter_3)
}
range_query.end_3:
}
fact1.iter_next(begin_iter_2)
}
range_query.end_2:
}
//--- expected_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [2 x i32], i32 1
%stack.ptr_1 = alloca [2 x i32], i32 1
%stack.ptr_2 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_3 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_4 = alloca [2 x i32], i32 1
%stack.ptr_5 = alloca [2 x i32], i32 1
%stack.ptr_6 = alloca [2 x i32], i32 1
%stack.ptr_7 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_8 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_9 = alloca [2 x i32], i32 1
%stack.ptr_10 = alloca [2 x i32], i32 1
%stack.ptr_11 = alloca [2 x i32], i32 1
%stack.ptr_12 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_13 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_14 = alloca [2 x i32], i32 1
%stack.ptr_15 = alloca [2 x i32], i32 1
%stack.ptr_16 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_17 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_18 = alloca [2 x i32], i32 1
%0 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 0, ptr %0
%1 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 0, ptr %1
%2 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 4294967295, ptr %2
%3 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 1
store i32 4294967295, ptr %3
%4 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %4, ptr %stack.ptr_0, ptr %stack.ptr_2)
%5 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %5, ptr %stack.ptr_1, ptr %stack.ptr_3)
br label %loop_0
loop_0:
%6 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_2, ptr %stack.ptr_3)
br i1 %6, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%7 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_2)
%8 = getelementptr [2 x i32], ptr %7, i32 0, i32 1
%9 = load i32, ptr %8
%10 = icmp ult i32 123, %9
br i1 %10, label %if_1, label %end_if_5
if_1:
%11 = getelementptr [2 x i32], ptr %7, i32 0, i32 1
%12 = load i32, ptr %11
%13 = icmp ule i32 123, %12
br i1 %13, label %if_2, label %end_if_4
if_2:
%14 = getelementptr [2 x i32], ptr %7, i32 0, i32 1
%15 = load i32, ptr %14
%16 = icmp ugt i32 123, %15
br i1 %16, label %if_3, label %end_if_3
if_3:
%17 = getelementptr [2 x i32], ptr %7, i32 0, i32 1
%18 = load i32, ptr %17
%19 = icmp uge i32 123, %18
br i1 %19, label %if_4, label %end_if_2
if_4:
%20 = getelementptr [2 x i32], ptr %7, i32 0, i32 1
%21 = load i32, ptr %20
%22 = icmp ne i32 123, %21
br i1 %22, label %if_5, label %end_if_1
if_5:
%23 = getelementptr [2 x i32], ptr %stack.ptr_4, i32 0, i32 0
%24 = getelementptr [2 x i32], ptr %7, i32 0, i32 1
%25 = load i32, ptr %24
store i32 %25, ptr %23
%26 = getelementptr [2 x i32], ptr %stack.ptr_4, i32 0, i32 1
%27 = getelementptr [2 x i32], ptr %7, i32 0, i32 0
%28 = load i32, ptr %27
store i32 %28, ptr %26
%29 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%30 = call ccc i1 @eclair_btree_insert_value_1(ptr %29, ptr %stack.ptr_4)
br label %end_if_1
end_if_1:
br label %end_if_2
end_if_2:
br label %end_if_3
end_if_3:
br label %end_if_4
end_if_4:
br label %end_if_5
end_if_5:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_2)
br label %loop_0
range_query.end:
%31 = getelementptr [2 x i32], ptr %stack.ptr_5, i32 0, i32 0
store i32 0, ptr %31
%32 = getelementptr [2 x i32], ptr %stack.ptr_5, i32 0, i32 1
store i32 123, ptr %32
%33 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 0
store i32 4294967295, ptr %33
%34 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 1
store i32 123, ptr %34
%35 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %35, ptr %stack.ptr_5, ptr %stack.ptr_7)
%36 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %36, ptr %stack.ptr_6, ptr %stack.ptr_8)
br label %loop_1
loop_1:
%37 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_7, ptr %stack.ptr_8)
br i1 %37, label %if_6, label %end_if_6
if_6:
br label %range_query.end_1
end_if_6:
%38 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_7)
%39 = getelementptr [2 x i32], ptr %stack.ptr_9, i32 0, i32 0
%40 = getelementptr [2 x i32], ptr %38, i32 0, i32 1
%41 = load i32, ptr %40
store i32 %41, ptr %39
%42 = getelementptr [2 x i32], ptr %stack.ptr_9, i32 0, i32 1
%43 = getelementptr [2 x i32], ptr %38, i32 0, i32 0
%44 = load i32, ptr %43
store i32 %44, ptr %42
%45 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%46 = call ccc i1 @eclair_btree_insert_value_1(ptr %45, ptr %stack.ptr_9)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_7)
br label %loop_1
range_query.end_1:
%47 = getelementptr [2 x i32], ptr %stack.ptr_10, i32 0, i32 0
store i32 0, ptr %47
%48 = getelementptr [2 x i32], ptr %stack.ptr_10, i32 0, i32 1
store i32 0, ptr %48
%49 = getelementptr [2 x i32], ptr %stack.ptr_11, i32 0, i32 0
store i32 4294967295, ptr %49
%50 = getelementptr [2 x i32], ptr %stack.ptr_11, i32 0, i32 1
store i32 4294967295, ptr %50
%51 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %51, ptr %stack.ptr_10, ptr %stack.ptr_12)
%52 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %52, ptr %stack.ptr_11, ptr %stack.ptr_13)
br label %loop_2
loop_2:
%53 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_12, ptr %stack.ptr_13)
br i1 %53, label %if_7, label %end_if_7
if_7:
br label %range_query.end_2
end_if_7:
%54 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_12)
%55 = getelementptr [2 x i32], ptr %54, i32 0, i32 1
%56 = load i32, ptr %55
%57 = getelementptr [2 x i32], ptr %54, i32 0, i32 0
%58 = load i32, ptr %57
%59 = icmp eq i32 %56, %58
br i1 %59, label %if_8, label %end_if_9
if_8:
%60 = getelementptr [2 x i32], ptr %stack.ptr_14, i32 0, i32 0
store i32 123, ptr %60
%61 = getelementptr [2 x i32], ptr %stack.ptr_14, i32 0, i32 1
%62 = getelementptr [2 x i32], ptr %54, i32 0, i32 0
%63 = load i32, ptr %62
store i32 %63, ptr %61
%64 = getelementptr [2 x i32], ptr %stack.ptr_15, i32 0, i32 0
store i32 123, ptr %64
%65 = getelementptr [2 x i32], ptr %stack.ptr_15, i32 0, i32 1
%66 = getelementptr [2 x i32], ptr %54, i32 0, i32 0
%67 = load i32, ptr %66
store i32 %67, ptr %65
%68 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %68, ptr %stack.ptr_14, ptr %stack.ptr_16)
%69 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %69, ptr %stack.ptr_15, ptr %stack.ptr_17)
br label %loop_3
loop_3:
%70 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_16, ptr %stack.ptr_17)
br i1 %70, label %if_9, label %end_if_8
if_9:
br label %range_query.end_3
end_if_8:
%71 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_16)
%72 = getelementptr [2 x i32], ptr %stack.ptr_18, i32 0, i32 0
%73 = getelementptr [2 x i32], ptr %54, i32 0, i32 0
%74 = load i32, ptr %73
store i32 %74, ptr %72
%75 = getelementptr [2 x i32], ptr %stack.ptr_18, i32 0, i32 1
store i32 1, ptr %75
%76 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%77 = call ccc i1 @eclair_btree_insert_value_1(ptr %76, ptr %stack.ptr_18)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_16)
br label %loop_3
range_query.end_3:
br label %end_if_9
end_if_9:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_12)
br label %loop_2
range_query.end_2:
ret void
}
================================================
FILE: tests/lowering/different_types.eclair
================================================
// TODO add tests for caching mechanism (e.g. single_nonrecursive_rule test)
// RUN: split-file %s %t
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_add_facts" > %t/actual_eclair_add_facts_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_get_facts" > %t/actual_eclair_get_facts_llvm.out
// RUN: diff %t/expected_eclair_add_facts_llvm.out %t/actual_eclair_add_facts_llvm.out
// RUN: diff %t/expected_eclair_get_facts_llvm.out %t/actual_eclair_get_facts_llvm.out
//--- program.eclair
@def a(u32) input output.
@def b(u32, u32, u32) input output.
//--- expected_eclair_add_facts_llvm.out
define external ccc void @eclair_add_facts(ptr %eclair_program_0, i32 %fact_type_0, ptr %memory_0, i32 %fact_count_0) "wasm-export-name"="eclair_add_facts" {
start:
switch i32 %fact_type_0, label %switch.default_0 [i32 0, label %a_0 i32 1, label %b_0]
a_0:
%0 = getelementptr %program, ptr %eclair_program_0, i32 0, i32 1
br label %for_begin_0
for_begin_0:
%1 = phi i32 [0, %a_0], [%5, %for_body_0]
%2 = icmp ult i32 %1, %fact_count_0
br i1 %2, label %for_body_0, label %for_end_0
for_body_0:
%3 = getelementptr [1 x i32], ptr %memory_0, i32 %1
%4 = call ccc i1 @eclair_btree_insert_value_0(ptr %0, ptr %3)
%5 = add i32 1, %1
br label %for_begin_0
for_end_0:
br label %end_0
b_0:
%6 = getelementptr %program, ptr %eclair_program_0, i32 0, i32 2
br label %for_begin_1
for_begin_1:
%7 = phi i32 [0, %b_0], [%11, %for_body_1]
%8 = icmp ult i32 %7, %fact_count_0
br i1 %8, label %for_body_1, label %for_end_1
for_body_1:
%9 = getelementptr [3 x i32], ptr %memory_0, i32 %7
%10 = call ccc i1 @eclair_btree_insert_value_1(ptr %6, ptr %9)
%11 = add i32 1, %7
br label %for_begin_1
for_end_1:
br label %end_0
switch.default_0:
ret void
end_0:
ret void
}
//--- expected_eclair_get_facts_llvm.out
define external ccc ptr @eclair_get_facts(ptr %eclair_program_0, i32 %fact_type_0) "wasm-export-name"="eclair_get_facts" {
start:
%stack.ptr_0 = alloca i32, i32 1
%stack.ptr_1 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_2 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_3 = alloca i32, i32 1
%stack.ptr_4 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_5 = alloca %btree_iterator_t_1, i32 1
switch i32 %fact_type_0, label %switch.default_0 [i32 0, label %a_0 i32 1, label %b_0]
a_0:
%0 = getelementptr %program, ptr %eclair_program_0, i32 0, i32 1
%1 = call ccc i64 @eclair_btree_size_0(ptr %0)
%2 = trunc i64 %1 to i32
%3 = mul i32 %2, 4
%4 = call ccc ptr @malloc(i32 %3)
store i32 0, ptr %stack.ptr_0
call ccc void @eclair_btree_begin_0(ptr %0, ptr %stack.ptr_1)
call ccc void @eclair_btree_end_0(ptr %0, ptr %stack.ptr_2)
br label %while_begin_0
while_begin_0:
%5 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_1, ptr %stack.ptr_2)
%6 = select i1 %5, i1 0, i1 1
br i1 %6, label %while_body_0, label %while_end_0
while_body_0:
%7 = load i32, ptr %stack.ptr_0
%8 = getelementptr [1 x i32], ptr %4, i32 %7
%9 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_1)
%10 = getelementptr [1 x i32], ptr %9, i32 0
%11 = load [1 x i32], ptr %10
%12 = getelementptr [1 x i32], ptr %8, i32 0
store [1 x i32] %11, ptr %12
%13 = add i32 %7, 1
store i32 %13, ptr %stack.ptr_0
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_1)
br label %while_begin_0
while_end_0:
ret ptr %4
b_0:
%14 = getelementptr %program, ptr %eclair_program_0, i32 0, i32 2
%15 = call ccc i64 @eclair_btree_size_1(ptr %14)
%16 = trunc i64 %15 to i32
%17 = mul i32 %16, 12
%18 = call ccc ptr @malloc(i32 %17)
store i32 0, ptr %stack.ptr_3
call ccc void @eclair_btree_begin_1(ptr %14, ptr %stack.ptr_4)
call ccc void @eclair_btree_end_1(ptr %14, ptr %stack.ptr_5)
br label %while_begin_1
while_begin_1:
%19 = call ccc i1 @eclair_btree_iterator_is_equal_1(ptr %stack.ptr_4, ptr %stack.ptr_5)
%20 = select i1 %19, i1 0, i1 1
br i1 %20, label %while_body_1, label %while_end_1
while_body_1:
%21 = load i32, ptr %stack.ptr_3
%22 = getelementptr [3 x i32], ptr %18, i32 %21
%23 = call ccc ptr @eclair_btree_iterator_current_1(ptr %stack.ptr_4)
%24 = getelementptr [3 x i32], ptr %23, i32 0
%25 = load [3 x i32], ptr %24
%26 = getelementptr [3 x i32], ptr %22, i32 0
store [3 x i32] %25, ptr %26
%27 = add i32 %21, 1
store i32 %27, ptr %stack.ptr_3
call ccc void @eclair_btree_iterator_next_1(ptr %stack.ptr_4)
br label %while_begin_1
while_end_1:
ret ptr %18
switch.default_0:
ret ptr zeroinitializer
}
================================================
FILE: tests/lowering/extern_definitions.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: %extract_snippet %t/actual_eir.out "fn.*eclair_program_run" > %t/actual_eir_snippet.out
// RUN: diff %t/expected_eir.out %t/actual_eir_snippet.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_program_run" > %t/actual_llvm_snippet.out
// RUN: diff %t/expected_llvm.out %t/actual_llvm_snippet.out
//--- program.eclair
@def edge(u32, u32) input.
@def test_externs(u32) output.
@extern constraint(string).
@extern func(u32) u32.
@extern func2(u32, u32) string.
test_externs(func(123)).
test_externs(x) :-
edge(x, _),
constraint("abc"),
constraint(func2(123, 456)).
test_externs(x) :-
edge(x, y),
x = func(123), // This can be indexed on
x = func(y), // This can't, x and y defined in same relation
"abc" = func2(456, 789).
//--- expected_ra.out
if 2 = func2(456, 789) do
search edge as edge0 where (edge0[0] = func(123)) do
if edge0[0] = func(edge0[1]) do
project (edge0[0]) into test_externs
if constraint(2) != 0 do
if constraint(func2(123, 456)) != 0 do
search edge as edge0 do
project (edge0[0]) into test_externs
project (func(123)) into test_externs
//--- expected_eir.out
export fn eclair_program_run(*Program) -> Void
{
condition = (2 == func2(FN_ARG[0].0, 456, 789))
if (condition)
{
lower_bound_value = edge.stack_allocate Value
upper_bound_value = edge.stack_allocate Value
lower_bound_value.0 = func(FN_ARG[0].0, 123)
lower_bound_value.1 = 0
upper_bound_value.0 = func(FN_ARG[0].0, 123)
upper_bound_value.1 = 4294967295
begin_iter = edge.stack_allocate Iter
end_iter = edge.stack_allocate Iter
edge.iter_lower_bound(FN_ARG[0].1, lower_bound_value, begin_iter)
edge.iter_upper_bound(FN_ARG[0].1, upper_bound_value, end_iter)
loop
{
condition_1 = edge.iter_is_equal(begin_iter, end_iter)
if (condition_1)
{
goto range_query.end
}
current = edge.iter_current(begin_iter)
condition_2 = (current.0 == func(FN_ARG[0].0, current.1))
if (condition_2)
{
value = test_externs.stack_allocate Value
value.0 = current.0
test_externs.insert(FN_ARG[0].2, value)
}
edge.iter_next(begin_iter)
}
range_query.end:
}
condition_3 = (constraint(FN_ARG[0].0, 2) != 0)
if (condition_3)
{
condition_4 = (constraint(FN_ARG[0].0, func2(FN_ARG[0].0, 123, 456)) != 0)
if (condition_4)
{
lower_bound_value_1 = edge.stack_allocate Value
upper_bound_value_1 = edge.stack_allocate Value
lower_bound_value_1.0 = 0
lower_bound_value_1.1 = 0
upper_bound_value_1.0 = 4294967295
upper_bound_value_1.1 = 4294967295
begin_iter_1 = edge.stack_allocate Iter
end_iter_1 = edge.stack_allocate Iter
edge.iter_lower_bound(FN_ARG[0].1, lower_bound_value_1, begin_iter_1)
edge.iter_upper_bound(FN_ARG[0].1, upper_bound_value_1, end_iter_1)
loop
{
condition_5 = edge.iter_is_equal(begin_iter_1, end_iter_1)
if (condition_5)
{
goto range_query.end_1
}
current_1 = edge.iter_current(begin_iter_1)
value_1 = test_externs.stack_allocate Value
value_1.0 = current_1.0
test_externs.insert(FN_ARG[0].2, value_1)
edge.iter_next(begin_iter_1)
}
range_query.end_1:
}
}
value_2 = test_externs.stack_allocate Value
value_2.0 = func(FN_ARG[0].0, 123)
test_externs.insert(FN_ARG[0].2, value_2)
}
//--- expected_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [2 x i32], i32 1
%stack.ptr_1 = alloca [2 x i32], i32 1
%stack.ptr_2 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_3 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_4 = alloca [1 x i32], i32 1
%stack.ptr_5 = alloca [2 x i32], i32 1
%stack.ptr_6 = alloca [2 x i32], i32 1
%stack.ptr_7 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_8 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_9 = alloca [1 x i32], i32 1
%stack.ptr_10 = alloca [1 x i32], i32 1
%0 = getelementptr %program, ptr %arg_0, i32 0, i32 0
%1 = call ccc i32 @func2(ptr %0, i32 456, i32 789)
%2 = icmp eq i32 2, %1
br i1 %2, label %if_0, label %end_if_2
if_0:
%3 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 0
%4 = getelementptr %program, ptr %arg_0, i32 0, i32 0
%5 = call ccc i32 @func(ptr %4, i32 123)
store i32 %5, ptr %3
%6 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 0, ptr %6
%7 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 0
%8 = getelementptr %program, ptr %arg_0, i32 0, i32 0
%9 = call ccc i32 @func(ptr %8, i32 123)
store i32 %9, ptr %7
%10 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 1
store i32 4294967295, ptr %10
%11 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %11, ptr %stack.ptr_0, ptr %stack.ptr_2)
%12 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %12, ptr %stack.ptr_1, ptr %stack.ptr_3)
br label %loop_0
loop_0:
%13 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_2, ptr %stack.ptr_3)
br i1 %13, label %if_1, label %end_if_0
if_1:
br label %range_query.end
end_if_0:
%14 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_2)
%15 = getelementptr [2 x i32], ptr %14, i32 0, i32 0
%16 = load i32, ptr %15
%17 = getelementptr %program, ptr %arg_0, i32 0, i32 0
%18 = getelementptr [2 x i32], ptr %14, i32 0, i32 1
%19 = call ccc i32 @func(ptr %17, ptr %18)
%20 = icmp eq i32 %16, %19
br i1 %20, label %if_2, label %end_if_1
if_2:
%21 = getelementptr [1 x i32], ptr %stack.ptr_4, i32 0, i32 0
%22 = getelementptr [2 x i32], ptr %14, i32 0, i32 0
%23 = load i32, ptr %22
store i32 %23, ptr %21
%24 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%25 = call ccc i1 @eclair_btree_insert_value_1(ptr %24, ptr %stack.ptr_4)
br label %end_if_1
end_if_1:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_2)
br label %loop_0
range_query.end:
br label %end_if_2
end_if_2:
%26 = getelementptr %program, ptr %arg_0, i32 0, i32 0
%27 = call ccc i1 @constraint(ptr %26, i32 2)
%28 = icmp ne i1 %27, 0
br i1 %28, label %if_3, label %end_if_5
if_3:
%29 = getelementptr %program, ptr %arg_0, i32 0, i32 0
%30 = getelementptr %program, ptr %arg_0, i32 0, i32 0
%31 = call ccc i32 @func2(ptr %30, i32 123, i32 456)
%32 = call ccc i1 @constraint(ptr %29, i32 %31)
%33 = icmp ne i1 %32, 0
br i1 %33, label %if_4, label %end_if_4
if_4:
%34 = getelementptr [2 x i32], ptr %stack.ptr_5, i32 0, i32 0
store i32 0, ptr %34
%35 = getelementptr [2 x i32], ptr %stack.ptr_5, i32 0, i32 1
store i32 0, ptr %35
%36 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 0
store i32 4294967295, ptr %36
%37 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 1
store i32 4294967295, ptr %37
%38 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %38, ptr %stack.ptr_5, ptr %stack.ptr_7)
%39 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %39, ptr %stack.ptr_6, ptr %stack.ptr_8)
br label %loop_1
loop_1:
%40 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_7, ptr %stack.ptr_8)
br i1 %40, label %if_5, label %end_if_3
if_5:
br label %range_query.end_1
end_if_3:
%41 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_7)
%42 = getelementptr [1 x i32], ptr %stack.ptr_9, i32 0, i32 0
%43 = getelementptr [2 x i32], ptr %41, i32 0, i32 0
%44 = load i32, ptr %43
store i32 %44, ptr %42
%45 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%46 = call ccc i1 @eclair_btree_insert_value_1(ptr %45, ptr %stack.ptr_9)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_7)
br label %loop_1
range_query.end_1:
br label %end_if_4
end_if_4:
br label %end_if_5
end_if_5:
%47 = getelementptr [1 x i32], ptr %stack.ptr_10, i32 0, i32 0
%48 = getelementptr %program, ptr %arg_0, i32 0, i32 0
%49 = call ccc i32 @func(ptr %48, i32 123)
store i32 %49, ptr %47
%50 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%51 = call ccc i1 @eclair_btree_insert_value_1(ptr %50, ptr %stack.ptr_10)
ret void
}
================================================
FILE: tests/lowering/multiple_clauses_same_name.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: diff %t/expected_eir.out %t/actual_eir.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "program = " > %t/actual_eclair_program_type.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_init" > %t/actual_eclair_program_init_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_destroy" > %t/actual_eclair_program_destroy_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_run" > %t/actual_eclair_program_run_llvm.out
// RUN: diff %t/expected_eclair_program_type.out %t/actual_eclair_program_type.out
// RUN: diff %t/expected_eclair_program_init_llvm.out %t/actual_eclair_program_init_llvm.out
// RUN: diff %t/expected_eclair_program_destroy_llvm.out %t/actual_eclair_program_destroy_llvm.out
// RUN: diff %t/expected_eclair_program_run_llvm.out %t/actual_eclair_program_run_llvm.out
//--- program.eclair
@def link(u32, u32).
@def chain(u32, u32, u32) output.
link(1,2).
chain(x, y, z) :-
link(x, y),
link(y, z).
//--- expected_ra.out
project (1, 2) into link
search link as link0 do
search link as link1 where (link0[1] = link1[0]) do
project (link0[0], link0[1], link1[1]) into chain
//--- expected_eir.out
declare_type Program
{
symbol_table
chain btree(num_columns=3, index=[0,1,2], block_size=256, search_type=linear)
link btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
}
export fn eclair_program_init() -> *Program
{
program = heap_allocate_program
symbol_table.init(program.0)
chain.init_empty(program.1)
link.init_empty(program.2)
symbol_table.insert(program.0, "link")
symbol_table.insert(program.0, "chain")
return program
}
export fn eclair_program_destroy(*Program) -> Void
{
symbol_table.destroy(FN_ARG[0].0)
chain.destroy(FN_ARG[0].1)
link.destroy(FN_ARG[0].2)
free_program(FN_ARG[0])
}
export fn eclair_program_run(*Program) -> Void
{
value = link.stack_allocate Value
value.0 = 1
value.1 = 2
link.insert(FN_ARG[0].2, value)
lower_bound_value = link.stack_allocate Value
upper_bound_value = link.stack_allocate Value
lower_bound_value.0 = 0
lower_bound_value.1 = 0
upper_bound_value.0 = 4294967295
upper_bound_value.1 = 4294967295
begin_iter = link.stack_allocate Iter
end_iter = link.stack_allocate Iter
link.iter_lower_bound(FN_ARG[0].2, lower_bound_value, begin_iter)
link.iter_upper_bound(FN_ARG[0].2, upper_bound_value, end_iter)
loop
{
condition = link.iter_is_equal(begin_iter, end_iter)
if (condition)
{
goto range_query.end
}
current = link.iter_current(begin_iter)
lower_bound_value_1 = link.stack_allocate Value
upper_bound_value_1 = link.stack_allocate Value
lower_bound_value_1.0 = current.1
lower_bound_value_1.1 = 0
upper_bound_value_1.0 = current.1
upper_bound_value_1.1 = 4294967295
begin_iter_1 = link.stack_allocate Iter
end_iter_1 = link.stack_allocate Iter
link.iter_lower_bound(FN_ARG[0].2, lower_bound_value_1, begin_iter_1)
link.iter_upper_bound(FN_ARG[0].2, upper_bound_value_1, end_iter_1)
loop
{
condition_1 = link.iter_is_equal(begin_iter_1, end_iter_1)
if (condition_1)
{
goto range_query.end_1
}
current_1 = link.iter_current(begin_iter_1)
value_1 = chain.stack_allocate Value
value_1.0 = current.0
value_1.1 = current.1
value_1.2 = current_1.1
chain.insert(FN_ARG[0].1, value_1)
link.iter_next(begin_iter_1)
}
range_query.end_1:
link.iter_next(begin_iter)
}
range_query.end:
}
//--- expected_eclair_program_type.out
%program = type {%symbol_table, %btree_t_0, %btree_t_1}
//--- expected_eclair_program_init_llvm.out
define external ccc ptr @eclair_program_init() "wasm-export-name"="eclair_program_init" {
start:
%stack.ptr_0 = alloca %symbol_t, i32 1
%stack.ptr_1 = alloca %symbol_t, i32 1
%0 = call ccc ptr @malloc(i32 1592)
%1 = getelementptr %program, ptr %0, i32 0, i32 0
call ccc void @eclair_symbol_table_init(ptr %1)
%2 = getelementptr %program, ptr %0, i32 0, i32 1
call ccc void @eclair_btree_init_empty_0(ptr %2)
%3 = getelementptr %program, ptr %0, i32 0, i32 2
call ccc void @eclair_btree_init_empty_1(ptr %3)
%4 = getelementptr %program, ptr %0, i32 0, i32 0
%5 = getelementptr inbounds [5 x i8], ptr @string_literal_0, i32 0, i32 0
%6 = zext i32 4 to i64
%7 = call ccc ptr @malloc(i32 4)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %7, ptr %5, i64 %6, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_0, i32 4, ptr %7)
%8 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %4, ptr %stack.ptr_0)
%9 = getelementptr %program, ptr %0, i32 0, i32 0
%10 = getelementptr inbounds [6 x i8], ptr @string_literal_1, i32 0, i32 0
%11 = zext i32 5 to i64
%12 = call ccc ptr @malloc(i32 5)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %12, ptr %10, i64 %11, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_1, i32 5, ptr %12)
%13 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %9, ptr %stack.ptr_1)
ret ptr %0
}
//--- expected_eclair_program_destroy_llvm.out
define external ccc void @eclair_program_destroy(ptr %arg_0) "wasm-export-name"="eclair_program_destroy" {
start:
%0 = getelementptr %program, ptr %arg_0, i32 0, i32 0
call ccc void @eclair_symbol_table_destroy(ptr %0)
%1 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_destroy_0(ptr %1)
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_destroy_1(ptr %2)
call ccc void @free(ptr %arg_0)
ret void
}
//--- expected_eclair_program_run_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [2 x i32], i32 1
%stack.ptr_1 = alloca [2 x i32], i32 1
%stack.ptr_2 = alloca [2 x i32], i32 1
%stack.ptr_3 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_4 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_5 = alloca [2 x i32], i32 1
%stack.ptr_6 = alloca [2 x i32], i32 1
%stack.ptr_7 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_8 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_9 = alloca [3 x i32], i32 1
%0 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 1, ptr %0
%1 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 2, ptr %1
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%3 = call ccc i1 @eclair_btree_insert_value_1(ptr %2, ptr %stack.ptr_0)
%4 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 0, ptr %4
%5 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 1
store i32 0, ptr %5
%6 = getelementptr [2 x i32], ptr %stack.ptr_2, i32 0, i32 0
store i32 4294967295, ptr %6
%7 = getelementptr [2 x i32], ptr %stack.ptr_2, i32 0, i32 1
store i32 4294967295, ptr %7
%8 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_1(ptr %8, ptr %stack.ptr_1, ptr %stack.ptr_3)
%9 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_1(ptr %9, ptr %stack.ptr_2, ptr %stack.ptr_4)
br label %loop_0
loop_0:
%10 = call ccc i1 @eclair_btree_iterator_is_equal_1(ptr %stack.ptr_3, ptr %stack.ptr_4)
br i1 %10, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%11 = call ccc ptr @eclair_btree_iterator_current_1(ptr %stack.ptr_3)
%12 = getelementptr [2 x i32], ptr %stack.ptr_5, i32 0, i32 0
%13 = getelementptr [2 x i32], ptr %11, i32 0, i32 1
%14 = load i32, ptr %13
store i32 %14, ptr %12
%15 = getelementptr [2 x i32], ptr %stack.ptr_5, i32 0, i32 1
store i32 0, ptr %15
%16 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 0
%17 = getelementptr [2 x i32], ptr %11, i32 0, i32 1
%18 = load i32, ptr %17
store i32 %18, ptr %16
%19 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 1
store i32 4294967295, ptr %19
%20 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_1(ptr %20, ptr %stack.ptr_5, ptr %stack.ptr_7)
%21 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_1(ptr %21, ptr %stack.ptr_6, ptr %stack.ptr_8)
br label %loop_1
loop_1:
%22 = call ccc i1 @eclair_btree_iterator_is_equal_1(ptr %stack.ptr_7, ptr %stack.ptr_8)
br i1 %22, label %if_1, label %end_if_1
if_1:
br label %range_query.end_1
end_if_1:
%23 = call ccc ptr @eclair_btree_iterator_current_1(ptr %stack.ptr_7)
%24 = getelementptr [3 x i32], ptr %stack.ptr_9, i32 0, i32 0
%25 = getelementptr [2 x i32], ptr %11, i32 0, i32 0
%26 = load i32, ptr %25
store i32 %26, ptr %24
%27 = getelementptr [3 x i32], ptr %stack.ptr_9, i32 0, i32 1
%28 = getelementptr [2 x i32], ptr %11, i32 0, i32 1
%29 = load i32, ptr %28
store i32 %29, ptr %27
%30 = getelementptr [3 x i32], ptr %stack.ptr_9, i32 0, i32 2
%31 = getelementptr [2 x i32], ptr %23, i32 0, i32 1
%32 = load i32, ptr %31
store i32 %32, ptr %30
%33 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%34 = call ccc i1 @eclair_btree_insert_value_0(ptr %33, ptr %stack.ptr_9)
call ccc void @eclair_btree_iterator_next_1(ptr %stack.ptr_7)
br label %loop_1
range_query.end_1:
call ccc void @eclair_btree_iterator_next_1(ptr %stack.ptr_3)
br label %loop_0
range_query.end:
ret void
}
================================================
FILE: tests/lowering/multiple_rule_clauses.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: diff %t/expected_eir.out %t/actual_eir.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "program = " > %t/actual_eclair_program_type.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_init" > %t/actual_eclair_program_init_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_destroy" > %t/actual_eclair_program_destroy_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_run" > %t/actual_eclair_program_run_llvm.out
// RUN: diff %t/expected_eclair_program_type.out %t/actual_eclair_program_type.out
// RUN: diff %t/expected_eclair_program_init_llvm.out %t/actual_eclair_program_init_llvm.out
// RUN: diff %t/expected_eclair_program_destroy_llvm.out %t/actual_eclair_program_destroy_llvm.out
// RUN: diff %t/expected_eclair_program_run_llvm.out %t/actual_eclair_program_run_llvm.out
//--- program.eclair
@def first(u32).
@def second(u32, u32).
@def third(u32, u32) output.
first(1).
second(2, 3).
third(x, y) :-
first(y),
second(x, y).
//--- expected_ra.out
project (2, 3) into second
project (1) into first
search first as first0 do
search second as second1 where (first0[0] = second1[1]) do
project (second1[0], first0[0]) into third
//--- expected_eir.out
declare_type Program
{
symbol_table
first btree(num_columns=1, index=[0], block_size=256, search_type=linear)
second btree(num_columns=2, index=[1,0], block_size=256, search_type=linear)
third btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
}
export fn eclair_program_init() -> *Program
{
program = heap_allocate_program
symbol_table.init(program.0)
first.init_empty(program.1)
second.init_empty(program.2)
third.init_empty(program.3)
symbol_table.insert(program.0, "first")
symbol_table.insert(program.0, "second")
symbol_table.insert(program.0, "third")
return program
}
export fn eclair_program_destroy(*Program) -> Void
{
symbol_table.destroy(FN_ARG[0].0)
first.destroy(FN_ARG[0].1)
second.destroy(FN_ARG[0].2)
third.destroy(FN_ARG[0].3)
free_program(FN_ARG[0])
}
export fn eclair_program_run(*Program) -> Void
{
value = second.stack_allocate Value
value.0 = 2
value.1 = 3
second.insert(FN_ARG[0].2, value)
value_1 = first.stack_allocate Value
value_1.0 = 1
first.insert(FN_ARG[0].1, value_1)
lower_bound_value = first.stack_allocate Value
upper_bound_value = first.stack_allocate Value
lower_bound_value.0 = 0
upper_bound_value.0 = 4294967295
begin_iter = first.stack_allocate Iter
end_iter = first.stack_allocate Iter
first.iter_lower_bound(FN_ARG[0].1, lower_bound_value, begin_iter)
first.iter_upper_bound(FN_ARG[0].1, upper_bound_value, end_iter)
loop
{
condition = first.iter_is_equal(begin_iter, end_iter)
if (condition)
{
goto range_query.end
}
current = first.iter_current(begin_iter)
lower_bound_value_1 = second.stack_allocate Value
upper_bound_value_1 = second.stack_allocate Value
lower_bound_value_1.0 = 0
lower_bound_value_1.1 = current.0
upper_bound_value_1.0 = 4294967295
upper_bound_value_1.1 = current.0
begin_iter_1 = second.stack_allocate Iter
end_iter_1 = second.stack_allocate Iter
second.iter_lower_bound(FN_ARG[0].2, lower_bound_value_1, begin_iter_1)
second.iter_upper_bound(FN_ARG[0].2, upper_bound_value_1, end_iter_1)
loop
{
condition_1 = second.iter_is_equal(begin_iter_1, end_iter_1)
if (condition_1)
{
goto range_query.end_1
}
current_1 = second.iter_current(begin_iter_1)
value_2 = third.stack_allocate Value
value_2.0 = current_1.0
value_2.1 = current.0
third.insert(FN_ARG[0].3, value_2)
second.iter_next(begin_iter_1)
}
range_query.end_1:
first.iter_next(begin_iter)
}
range_query.end:
}
//--- expected_eclair_program_type.out
%program = type {%symbol_table, %btree_t_0, %btree_t_1, %btree_t_2}
//--- expected_eclair_program_init_llvm.out
define external ccc ptr @eclair_program_init() "wasm-export-name"="eclair_program_init" {
start:
%stack.ptr_0 = alloca %symbol_t, i32 1
%stack.ptr_1 = alloca %symbol_t, i32 1
%stack.ptr_2 = alloca %symbol_t, i32 1
%0 = call ccc ptr @malloc(i32 1608)
%1 = getelementptr %program, ptr %0, i32 0, i32 0
call ccc void @eclair_symbol_table_init(ptr %1)
%2 = getelementptr %program, ptr %0, i32 0, i32 1
call ccc void @eclair_btree_init_empty_0(ptr %2)
%3 = getelementptr %program, ptr %0, i32 0, i32 2
call ccc void @eclair_btree_init_empty_1(ptr %3)
%4 = getelementptr %program, ptr %0, i32 0, i32 3
call ccc void @eclair_btree_init_empty_2(ptr %4)
%5 = getelementptr %program, ptr %0, i32 0, i32 0
%6 = getelementptr inbounds [6 x i8], ptr @string_literal_0, i32 0, i32 0
%7 = zext i32 5 to i64
%8 = call ccc ptr @malloc(i32 5)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %8, ptr %6, i64 %7, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_0, i32 5, ptr %8)
%9 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %5, ptr %stack.ptr_0)
%10 = getelementptr %program, ptr %0, i32 0, i32 0
%11 = getelementptr inbounds [7 x i8], ptr @string_literal_1, i32 0, i32 0
%12 = zext i32 6 to i64
%13 = call ccc ptr @malloc(i32 6)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %13, ptr %11, i64 %12, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_1, i32 6, ptr %13)
%14 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %10, ptr %stack.ptr_1)
%15 = getelementptr %program, ptr %0, i32 0, i32 0
%16 = getelementptr inbounds [6 x i8], ptr @string_literal_2, i32 0, i32 0
%17 = zext i32 5 to i64
%18 = call ccc ptr @malloc(i32 5)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %18, ptr %16, i64 %17, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_2, i32 5, ptr %18)
%19 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %15, ptr %stack.ptr_2)
ret ptr %0
}
//--- expected_eclair_program_destroy_llvm.out
define external ccc void @eclair_program_destroy(ptr %arg_0) "wasm-export-name"="eclair_program_destroy" {
start:
%0 = getelementptr %program, ptr %arg_0, i32 0, i32 0
call ccc void @eclair_symbol_table_destroy(ptr %0)
%1 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_destroy_0(ptr %1)
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_destroy_1(ptr %2)
%3 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_destroy_2(ptr %3)
call ccc void @free(ptr %arg_0)
ret void
}
//--- expected_eclair_program_run_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [2 x i32], i32 1
%stack.ptr_1 = alloca [1 x i32], i32 1
%stack.ptr_2 = alloca [1 x i32], i32 1
%stack.ptr_3 = alloca [1 x i32], i32 1
%stack.ptr_4 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_5 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_6 = alloca [2 x i32], i32 1
%stack.ptr_7 = alloca [2 x i32], i32 1
%stack.ptr_8 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_9 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_10 = alloca [2 x i32], i32 1
%0 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 2, ptr %0
%1 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 3, ptr %1
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%3 = call ccc i1 @eclair_btree_insert_value_1(ptr %2, ptr %stack.ptr_0)
%4 = getelementptr [1 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 1, ptr %4
%5 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%6 = call ccc i1 @eclair_btree_insert_value_0(ptr %5, ptr %stack.ptr_1)
%7 = getelementptr [1 x i32], ptr %stack.ptr_2, i32 0, i32 0
store i32 0, ptr %7
%8 = getelementptr [1 x i32], ptr %stack.ptr_3, i32 0, i32 0
store i32 4294967295, ptr %8
%9 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %9, ptr %stack.ptr_2, ptr %stack.ptr_4)
%10 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %10, ptr %stack.ptr_3, ptr %stack.ptr_5)
br label %loop_0
loop_0:
%11 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_4, ptr %stack.ptr_5)
br i1 %11, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%12 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_4)
%13 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 0
store i32 0, ptr %13
%14 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 1
%15 = getelementptr [1 x i32], ptr %12, i32 0, i32 0
%16 = load i32, ptr %15
store i32 %16, ptr %14
%17 = getelementptr [2 x i32], ptr %stack.ptr_7, i32 0, i32 0
store i32 4294967295, ptr %17
%18 = getelementptr [2 x i32], ptr %stack.ptr_7, i32 0, i32 1
%19 = getelementptr [1 x i32], ptr %12, i32 0, i32 0
%20 = load i32, ptr %19
store i32 %20, ptr %18
%21 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_1(ptr %21, ptr %stack.ptr_6, ptr %stack.ptr_8)
%22 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_1(ptr %22, ptr %stack.ptr_7, ptr %stack.ptr_9)
br label %loop_1
loop_1:
%23 = call ccc i1 @eclair_btree_iterator_is_equal_1(ptr %stack.ptr_8, ptr %stack.ptr_9)
br i1 %23, label %if_1, label %end_if_1
if_1:
br label %range_query.end_1
end_if_1:
%24 = call ccc ptr @eclair_btree_iterator_current_1(ptr %stack.ptr_8)
%25 = getelementptr [2 x i32], ptr %stack.ptr_10, i32 0, i32 0
%26 = getelementptr [2 x i32], ptr %24, i32 0, i32 0
%27 = load i32, ptr %26
store i32 %27, ptr %25
%28 = getelementptr [2 x i32], ptr %stack.ptr_10, i32 0, i32 1
%29 = getelementptr [1 x i32], ptr %12, i32 0, i32 0
%30 = load i32, ptr %29
store i32 %30, ptr %28
%31 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%32 = call ccc i1 @eclair_btree_insert_value_2(ptr %31, ptr %stack.ptr_10)
call ccc void @eclair_btree_iterator_next_1(ptr %stack.ptr_8)
br label %loop_1
range_query.end_1:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_4)
br label %loop_0
range_query.end:
ret void
}
================================================
FILE: tests/lowering/mutually_recursive_rules.eclair
================================================
// TODO variant where one is recursive
// TODO tests for rules with >2 clauses, ...
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: diff %t/expected_eir.out %t/actual_eir.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "program = " > %t/actual_eclair_program_type.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_init" > %t/actual_eclair_program_init_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_destroy" > %t/actual_eclair_program_destroy_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_run" > %t/actual_eclair_program_run_llvm.out
// RUN: diff %t/expected_eclair_program_type.out %t/actual_eclair_program_type.out
// RUN: diff %t/expected_eclair_program_init_llvm.out %t/actual_eclair_program_init_llvm.out
// RUN: diff %t/expected_eclair_program_destroy_llvm.out %t/actual_eclair_program_destroy_llvm.out
// RUN: diff %t/expected_eclair_program_run_llvm.out %t/actual_eclair_program_run_llvm.out
//--- program.eclair
@def a(u32) output.
@def b(u32) output.
@def c(u32) output.
@def d(u32) output.
a(x) :- b(x), c(x).
b(1).
b(x) :- c(x), d(x).
c(2).
c(x) :- b(x), d(x).
d(3).
//--- expected_ra.out
project (3) into d
project (2) into c
project (1) into b
merge c delta_c
merge b delta_b
loop do
purge new_c
purge new_b
parallel do
search delta_b as delta_b0 do
if (delta_b0[0]) ∉ c do
search d as d1 where (delta_b0[0] = d1[0]) do
project (delta_b0[0]) into new_c
search delta_c as delta_c0 do
if (delta_c0[0]) ∉ b do
search d as d1 where (delta_c0[0] = d1[0]) do
project (delta_c0[0]) into new_b
exit if counttuples(new_c) = 0 and counttuples(new_b) = 0
merge new_c c
swap new_c delta_c
merge new_b b
swap new_b delta_b
search b as b0 do
search c as c1 where (b0[0] = c1[0]) do
project (b0[0]) into a
//--- expected_eir.out
declare_type Program
{
symbol_table
a btree(num_columns=1, index=[0], block_size=256, search_type=linear)
b btree(num_columns=1, index=[0], block_size=256, search_type=linear)
c btree(num_columns=1, index=[0], block_size=256, search_type=linear)
d btree(num_columns=1, index=[0], block_size=256, search_type=linear)
delta_b btree(num_columns=1, index=[0], block_size=256, search_type=linear)
delta_c btree(num_columns=1, index=[0], block_size=256, search_type=linear)
new_b btree(num_columns=1, index=[0], block_size=256, search_type=linear)
new_c btree(num_columns=1, index=[0], block_size=256, search_type=linear)
}
export fn eclair_program_init() -> *Program
{
program = heap_allocate_program
symbol_table.init(program.0)
a.init_empty(program.1)
b.init_empty(program.2)
c.init_empty(program.3)
d.init_empty(program.4)
delta_b.init_empty(program.5)
delta_c.init_empty(program.6)
new_b.init_empty(program.7)
new_c.init_empty(program.8)
symbol_table.insert(program.0, "a")
symbol_table.insert(program.0, "b")
symbol_table.insert(program.0, "c")
symbol_table.insert(program.0, "d")
return program
}
export fn eclair_program_destroy(*Program) -> Void
{
symbol_table.destroy(FN_ARG[0].0)
a.destroy(FN_ARG[0].1)
b.destroy(FN_ARG[0].2)
c.destroy(FN_ARG[0].3)
d.destroy(FN_ARG[0].4)
delta_b.destroy(FN_ARG[0].5)
delta_c.destroy(FN_ARG[0].6)
new_b.destroy(FN_ARG[0].7)
new_c.destroy(FN_ARG[0].8)
free_program(FN_ARG[0])
}
export fn eclair_program_run(*Program) -> Void
{
value = d.stack_allocate Value
value.0 = 3
d.insert(FN_ARG[0].4, value)
value_1 = c.stack_allocate Value
value_1.0 = 2
c.insert(FN_ARG[0].3, value_1)
value_2 = b.stack_allocate Value
value_2.0 = 1
b.insert(FN_ARG[0].2, value_2)
begin_iter = c.stack_allocate Iter
end_iter = c.stack_allocate Iter
c.iter_begin(FN_ARG[0].3, begin_iter)
c.iter_end(FN_ARG[0].3, end_iter)
delta_c.insert_range(FN_ARG[0].6, begin_iter, end_iter)
begin_iter_1 = b.stack_allocate Iter
end_iter_1 = b.stack_allocate Iter
b.iter_begin(FN_ARG[0].2, begin_iter_1)
b.iter_end(FN_ARG[0].2, end_iter_1)
delta_b.insert_range(FN_ARG[0].5, begin_iter_1, end_iter_1)
loop
{
new_c.purge(FN_ARG[0].8)
new_b.purge(FN_ARG[0].7)
parallel
{
lower_bound_value = b.stack_allocate Value
upper_bound_value = b.stack_allocate Value
lower_bound_value.0 = 0
upper_bound_value.0 = 4294967295
begin_iter_2 = b.stack_allocate Iter
end_iter_2 = b.stack_allocate Iter
delta_b.iter_lower_bound(FN_ARG[0].5, lower_bound_value, begin_iter_2)
delta_b.iter_upper_bound(FN_ARG[0].5, upper_bound_value, end_iter_2)
loop
{
condition = delta_b.iter_is_equal(begin_iter_2, end_iter_2)
if (condition)
{
goto range_query.end
}
current = delta_b.iter_current(begin_iter_2)
value_3 = c.stack_allocate Value
value_3.0 = current.0
contains_result = c.contains(FN_ARG[0].3, value_3)
condition_1 = not contains_result
if (condition_1)
{
lower_bound_value_1 = d.stack_allocate Value
upper_bound_value_1 = d.stack_allocate Value
lower_bound_value_1.0 = current.0
upper_bound_value_1.0 = current.0
begin_iter_3 = d.stack_allocate Iter
end_iter_3 = d.stack_allocate Iter
d.iter_lower_bound(FN_ARG[0].4, lower_bound_value_1, begin_iter_3)
d.iter_upper_bound(FN_ARG[0].4, upper_bound_value_1, end_iter_3)
loop
{
condition_2 = d.iter_is_equal(begin_iter_3, end_iter_3)
if (condition_2)
{
goto range_query.end_1
}
current_1 = d.iter_current(begin_iter_3)
value_4 = c.stack_allocate Value
value_4.0 = current.0
new_c.insert(FN_ARG[0].8, value_4)
d.iter_next(begin_iter_3)
}
range_query.end_1:
}
delta_b.iter_next(begin_iter_2)
}
range_query.end:
lower_bound_value_2 = c.stack_allocate Value
upper_bound_value_2 = c.stack_allocate Value
lower_bound_value_2.0 = 0
upper_bound_value_2.0 = 4294967295
begin_iter_4 = c.stack_allocate Iter
end_iter_4 = c.stack_allocate Iter
delta_c.iter_lower_bound(FN_ARG[0].6, lower_bound_value_2, begin_iter_4)
delta_c.iter_upper_bound(FN_ARG[0].6, upper_bound_value_2, end_iter_4)
loop
{
condition_3 = delta_c.iter_is_equal(begin_iter_4, end_iter_4)
if (condition_3)
{
goto range_query.end_2
}
current_2 = delta_c.iter_current(begin_iter_4)
value_5 = b.stack_allocate Value
value_5.0 = current_2.0
contains_result_1 = b.contains(FN_ARG[0].2, value_5)
condition_4 = not contains_result_1
if (condition_4)
{
lower_bound_value_3 = d.stack_allocate Value
upper_bound_value_3 = d.stack_allocate Value
lower_bound_value_3.0 = current_2.0
upper_bound_value_3.0 = current_2.0
begin_iter_5 = d.stack_allocate Iter
end_iter_5 = d.stack_allocate Iter
d.iter_lower_bound(FN_ARG[0].4, lower_bound_value_3, begin_iter_5)
d.iter_upper_bound(FN_ARG[0].4, upper_bound_value_3, end_iter_5)
loop
{
condition_5 = d.iter_is_equal(begin_iter_5, end_iter_5)
if (condition_5)
{
goto range_query.end_3
}
current_3 = d.iter_current(begin_iter_5)
value_6 = b.stack_allocate Value
value_6.0 = current_2.0
new_b.insert(FN_ARG[0].7, value_6)
d.iter_next(begin_iter_5)
}
range_query.end_3:
}
delta_c.iter_next(begin_iter_4)
}
range_query.end_2:
}
condition_6 = new_b.is_empty(FN_ARG[0].7)
if (condition_6)
{
condition_7 = new_c.is_empty(FN_ARG[0].8)
if (condition_7)
{
goto loop.end
}
}
begin_iter_6 = c.stack_allocate Iter
end_iter_6 = c.stack_allocate Iter
new_c.iter_begin(FN_ARG[0].8, begin_iter_6)
new_c.iter_end(FN_ARG[0].8, end_iter_6)
c.insert_range(FN_ARG[0].3, begin_iter_6, end_iter_6)
new_c.swap(FN_ARG[0].8, FN_ARG[0].6)
begin_iter_7 = b.stack_allocate Iter
end_iter_7 = b.stack_allocate Iter
new_b.iter_begin(FN_ARG[0].7, begin_iter_7)
new_b.iter_end(FN_ARG[0].7, end_iter_7)
b.insert_range(FN_ARG[0].2, begin_iter_7, end_iter_7)
new_b.swap(FN_ARG[0].7, FN_ARG[0].5)
}
loop.end:
lower_bound_value_4 = b.stack_allocate Value
upper_bound_value_4 = b.stack_allocate Value
lower_bound_value_4.0 = 0
upper_bound_value_4.0 = 4294967295
begin_iter_8 = b.stack_allocate Iter
end_iter_8 = b.stack_allocate Iter
b.iter_lower_bound(FN_ARG[0].2, lower_bound_value_4, begin_iter_8)
b.iter_upper_bound(FN_ARG[0].2, upper_bound_value_4, end_iter_8)
loop
{
condition_8 = b.iter_is_equal(begin_iter_8, end_iter_8)
if (condition_8)
{
goto range_query.end_4
}
current_4 = b.iter_current(begin_iter_8)
lower_bound_value_5 = c.stack_allocate Value
upper_bound_value_5 = c.stack_allocate Value
lower_bound_value_5.0 = current_4.0
upper_bound_value_5.0 = current_4.0
begin_iter_9 = c.stack_allocate Iter
end_iter_9 = c.stack_allocate Iter
c.iter_lower_bound(FN_ARG[0].3, lower_bound_value_5, begin_iter_9)
c.iter_upper_bound(FN_ARG[0].3, upper_bound_value_5, end_iter_9)
loop
{
condition_9 = c.iter_is_equal(begin_iter_9, end_iter_9)
if (condition_9)
{
goto range_query.end_5
}
current_5 = c.iter_current(begin_iter_9)
value_7 = a.stack_allocate Value
value_7.0 = current_4.0
a.insert(FN_ARG[0].1, value_7)
c.iter_next(begin_iter_9)
}
range_query.end_5:
b.iter_next(begin_iter_8)
}
range_query.end_4:
}
//--- expected_eclair_program_type.out
%program = type {%symbol_table, %btree_t_0, %btree_t_0, %btree_t_0, %btree_t_0, %btree_t_0, %btree_t_0, %btree_t_0, %btree_t_0}
//--- expected_eclair_program_init_llvm.out
define external ccc ptr @eclair_program_init() "wasm-export-name"="eclair_program_init" {
start:
%stack.ptr_0 = alloca %symbol_t, i32 1
%stack.ptr_1 = alloca %symbol_t, i32 1
%stack.ptr_2 = alloca %symbol_t, i32 1
%stack.ptr_3 = alloca %symbol_t, i32 1
%0 = call ccc ptr @malloc(i32 1688)
%1 = getelementptr %program, ptr %0, i32 0, i32 0
call ccc void @eclair_symbol_table_init(ptr %1)
%2 = getelementptr %program, ptr %0, i32 0, i32 1
call ccc void @eclair_btree_init_empty_0(ptr %2)
%3 = getelementptr %program, ptr %0, i32 0, i32 2
call ccc void @eclair_btree_init_empty_0(ptr %3)
%4 = getelementptr %program, ptr %0, i32 0, i32 3
call ccc void @eclair_btree_init_empty_0(ptr %4)
%5 = getelementptr %program, ptr %0, i32 0, i32 4
call ccc void @eclair_btree_init_empty_0(ptr %5)
%6 = getelementptr %program, ptr %0, i32 0, i32 5
call ccc void @eclair_btree_init_empty_0(ptr %6)
%7 = getelementptr %program, ptr %0, i32 0, i32 6
call ccc void @eclair_btree_init_empty_0(ptr %7)
%8 = getelementptr %program, ptr %0, i32 0, i32 7
call ccc void @eclair_btree_init_empty_0(ptr %8)
%9 = getelementptr %program, ptr %0, i32 0, i32 8
call ccc void @eclair_btree_init_empty_0(ptr %9)
%10 = getelementptr %program, ptr %0, i32 0, i32 0
%11 = getelementptr inbounds [2 x i8], ptr @string_literal_0, i32 0, i32 0
%12 = zext i32 1 to i64
%13 = call ccc ptr @malloc(i32 1)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %13, ptr %11, i64 %12, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_0, i32 1, ptr %13)
%14 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %10, ptr %stack.ptr_0)
%15 = getelementptr %program, ptr %0, i32 0, i32 0
%16 = getelementptr inbounds [2 x i8], ptr @string_literal_1, i32 0, i32 0
%17 = zext i32 1 to i64
%18 = call ccc ptr @malloc(i32 1)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %18, ptr %16, i64 %17, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_1, i32 1, ptr %18)
%19 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %15, ptr %stack.ptr_1)
%20 = getelementptr %program, ptr %0, i32 0, i32 0
%21 = getelementptr inbounds [2 x i8], ptr @string_literal_2, i32 0, i32 0
%22 = zext i32 1 to i64
%23 = call ccc ptr @malloc(i32 1)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %23, ptr %21, i64 %22, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_2, i32 1, ptr %23)
%24 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %20, ptr %stack.ptr_2)
%25 = getelementptr %program, ptr %0, i32 0, i32 0
%26 = getelementptr inbounds [2 x i8], ptr @string_literal_3, i32 0, i32 0
%27 = zext i32 1 to i64
%28 = call ccc ptr @malloc(i32 1)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %28, ptr %26, i64 %27, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_3, i32 1, ptr %28)
%29 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %25, ptr %stack.ptr_3)
ret ptr %0
}
//--- expected_eclair_program_destroy_llvm.out
define external ccc void @eclair_program_destroy(ptr %arg_0) "wasm-export-name"="eclair_program_destroy" {
start:
%0 = getelementptr %program, ptr %arg_0, i32 0, i32 0
call ccc void @eclair_symbol_table_destroy(ptr %0)
%1 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_destroy_0(ptr %1)
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_destroy_0(ptr %2)
%3 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_destroy_0(ptr %3)
%4 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_destroy_0(ptr %4)
%5 = getelementptr %program, ptr %arg_0, i32 0, i32 5
call ccc void @eclair_btree_destroy_0(ptr %5)
%6 = getelementptr %program, ptr %arg_0, i32 0, i32 6
call ccc void @eclair_btree_destroy_0(ptr %6)
%7 = getelementptr %program, ptr %arg_0, i32 0, i32 7
call ccc void @eclair_btree_destroy_0(ptr %7)
%8 = getelementptr %program, ptr %arg_0, i32 0, i32 8
call ccc void @eclair_btree_destroy_0(ptr %8)
call ccc void @free(ptr %arg_0)
ret void
}
//--- expected_eclair_program_run_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [1 x i32], i32 1
%stack.ptr_1 = alloca [1 x i32], i32 1
%stack.ptr_2 = alloca [1 x i32], i32 1
%stack.ptr_3 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_4 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_5 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_6 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_7 = alloca [1 x i32], i32 1
%stack.ptr_8 = alloca [1 x i32], i32 1
%stack.ptr_9 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_10 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_11 = alloca [1 x i32], i32 1
%stack.ptr_12 = alloca [1 x i32], i32 1
%stack.ptr_13 = alloca [1 x i32], i32 1
%stack.ptr_14 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_15 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_16 = alloca [1 x i32], i32 1
%stack.ptr_17 = alloca [1 x i32], i32 1
%stack.ptr_18 = alloca [1 x i32], i32 1
%stack.ptr_19 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_20 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_21 = alloca [1 x i32], i32 1
%stack.ptr_22 = alloca [1 x i32], i32 1
%stack.ptr_23 = alloca [1 x i32], i32 1
%stack.ptr_24 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_25 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_26 = alloca [1 x i32], i32 1
%stack.ptr_27 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_28 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_29 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_30 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_31 = alloca [1 x i32], i32 1
%stack.ptr_32 = alloca [1 x i32], i32 1
%stack.ptr_33 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_34 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_35 = alloca [1 x i32], i32 1
%stack.ptr_36 = alloca [1 x i32], i32 1
%stack.ptr_37 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_38 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_39 = alloca [1 x i32], i32 1
%0 = getelementptr [1 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 3, ptr %0
%1 = getelementptr %program, ptr %arg_0, i32 0, i32 4
%2 = call ccc i1 @eclair_btree_insert_value_0(ptr %1, ptr %stack.ptr_0)
%3 = getelementptr [1 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 2, ptr %3
%4 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%5 = call ccc i1 @eclair_btree_insert_value_0(ptr %4, ptr %stack.ptr_1)
%6 = getelementptr [1 x i32], ptr %stack.ptr_2, i32 0, i32 0
store i32 1, ptr %6
%7 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%8 = call ccc i1 @eclair_btree_insert_value_0(ptr %7, ptr %stack.ptr_2)
%9 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_begin_0(ptr %9, ptr %stack.ptr_3)
%10 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_end_0(ptr %10, ptr %stack.ptr_4)
%11 = getelementptr %program, ptr %arg_0, i32 0, i32 6
call ccc void @eclair_btree_insert_range_delta_c_c(ptr %11, ptr %stack.ptr_3, ptr %stack.ptr_4)
%12 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_begin_0(ptr %12, ptr %stack.ptr_5)
%13 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_end_0(ptr %13, ptr %stack.ptr_6)
%14 = getelementptr %program, ptr %arg_0, i32 0, i32 5
call ccc void @eclair_btree_insert_range_delta_b_b(ptr %14, ptr %stack.ptr_5, ptr %stack.ptr_6)
br label %loop_0
loop_0:
%15 = getelementptr %program, ptr %arg_0, i32 0, i32 8
call ccc void @eclair_btree_clear_0(ptr %15)
%16 = getelementptr %program, ptr %arg_0, i32 0, i32 7
call ccc void @eclair_btree_clear_0(ptr %16)
%17 = getelementptr [1 x i32], ptr %stack.ptr_7, i32 0, i32 0
store i32 0, ptr %17
%18 = getelementptr [1 x i32], ptr %stack.ptr_8, i32 0, i32 0
store i32 4294967295, ptr %18
%19 = getelementptr %program, ptr %arg_0, i32 0, i32 5
call ccc void @eclair_btree_lower_bound_0(ptr %19, ptr %stack.ptr_7, ptr %stack.ptr_9)
%20 = getelementptr %program, ptr %arg_0, i32 0, i32 5
call ccc void @eclair_btree_upper_bound_0(ptr %20, ptr %stack.ptr_8, ptr %stack.ptr_10)
br label %loop_1
loop_1:
%21 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_9, ptr %stack.ptr_10)
br i1 %21, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%22 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_9)
%23 = getelementptr [1 x i32], ptr %stack.ptr_11, i32 0, i32 0
%24 = getelementptr [1 x i32], ptr %22, i32 0, i32 0
%25 = load i32, ptr %24
store i32 %25, ptr %23
%26 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%27 = call ccc i1 @eclair_btree_contains_0(ptr %26, ptr %stack.ptr_11)
%28 = select i1 %27, i1 0, i1 1
br i1 %28, label %if_1, label %end_if_2
if_1:
%29 = getelementptr [1 x i32], ptr %stack.ptr_12, i32 0, i32 0
%30 = getelementptr [1 x i32], ptr %22, i32 0, i32 0
%31 = load i32, ptr %30
store i32 %31, ptr %29
%32 = getelementptr [1 x i32], ptr %stack.ptr_13, i32 0, i32 0
%33 = getelementptr [1 x i32], ptr %22, i32 0, i32 0
%34 = load i32, ptr %33
store i32 %34, ptr %32
%35 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_lower_bound_0(ptr %35, ptr %stack.ptr_12, ptr %stack.ptr_14)
%36 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_upper_bound_0(ptr %36, ptr %stack.ptr_13, ptr %stack.ptr_15)
br label %loop_2
loop_2:
%37 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_14, ptr %stack.ptr_15)
br i1 %37, label %if_2, label %end_if_1
if_2:
br label %range_query.end_1
end_if_1:
%38 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_14)
%39 = getelementptr [1 x i32], ptr %stack.ptr_16, i32 0, i32 0
%40 = getelementptr [1 x i32], ptr %22, i32 0, i32 0
%41 = load i32, ptr %40
store i32 %41, ptr %39
%42 = getelementptr %program, ptr %arg_0, i32 0, i32 8
%43 = call ccc i1 @eclair_btree_insert_value_0(ptr %42, ptr %stack.ptr_16)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_14)
br label %loop_2
range_query.end_1:
br label %end_if_2
end_if_2:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_9)
br label %loop_1
range_query.end:
%44 = getelementptr [1 x i32], ptr %stack.ptr_17, i32 0, i32 0
store i32 0, ptr %44
%45 = getelementptr [1 x i32], ptr %stack.ptr_18, i32 0, i32 0
store i32 4294967295, ptr %45
%46 = getelementptr %program, ptr %arg_0, i32 0, i32 6
call ccc void @eclair_btree_lower_bound_0(ptr %46, ptr %stack.ptr_17, ptr %stack.ptr_19)
%47 = getelementptr %program, ptr %arg_0, i32 0, i32 6
call ccc void @eclair_btree_upper_bound_0(ptr %47, ptr %stack.ptr_18, ptr %stack.ptr_20)
br label %loop_3
loop_3:
%48 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_19, ptr %stack.ptr_20)
br i1 %48, label %if_3, label %end_if_3
if_3:
br label %range_query.end_2
end_if_3:
%49 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_19)
%50 = getelementptr [1 x i32], ptr %stack.ptr_21, i32 0, i32 0
%51 = getelementptr [1 x i32], ptr %49, i32 0, i32 0
%52 = load i32, ptr %51
store i32 %52, ptr %50
%53 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%54 = call ccc i1 @eclair_btree_contains_0(ptr %53, ptr %stack.ptr_21)
%55 = select i1 %54, i1 0, i1 1
br i1 %55, label %if_4, label %end_if_5
if_4:
%56 = getelementptr [1 x i32], ptr %stack.ptr_22, i32 0, i32 0
%57 = getelementptr [1 x i32], ptr %49, i32 0, i32 0
%58 = load i32, ptr %57
store i32 %58, ptr %56
%59 = getelementptr [1 x i32], ptr %stack.ptr_23, i32 0, i32 0
%60 = getelementptr [1 x i32], ptr %49, i32 0, i32 0
%61 = load i32, ptr %60
store i32 %61, ptr %59
%62 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_lower_bound_0(ptr %62, ptr %stack.ptr_22, ptr %stack.ptr_24)
%63 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_upper_bound_0(ptr %63, ptr %stack.ptr_23, ptr %stack.ptr_25)
br label %loop_4
loop_4:
%64 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_24, ptr %stack.ptr_25)
br i1 %64, label %if_5, label %end_if_4
if_5:
br label %range_query.end_3
end_if_4:
%65 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_24)
%66 = getelementptr [1 x i32], ptr %stack.ptr_26, i32 0, i32 0
%67 = getelementptr [1 x i32], ptr %49, i32 0, i32 0
%68 = load i32, ptr %67
store i32 %68, ptr %66
%69 = getelementptr %program, ptr %arg_0, i32 0, i32 7
%70 = call ccc i1 @eclair_btree_insert_value_0(ptr %69, ptr %stack.ptr_26)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_24)
br label %loop_4
range_query.end_3:
br label %end_if_5
end_if_5:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_19)
br label %loop_3
range_query.end_2:
%71 = getelementptr %program, ptr %arg_0, i32 0, i32 7
%72 = call ccc i1 @eclair_btree_is_empty_0(ptr %71)
br i1 %72, label %if_6, label %end_if_7
if_6:
%73 = getelementptr %program, ptr %arg_0, i32 0, i32 8
%74 = call ccc i1 @eclair_btree_is_empty_0(ptr %73)
br i1 %74, label %if_7, label %end_if_6
if_7:
br label %loop.end
end_if_6:
br label %end_if_7
end_if_7:
%75 = getelementptr %program, ptr %arg_0, i32 0, i32 8
call ccc void @eclair_btree_begin_0(ptr %75, ptr %stack.ptr_27)
%76 = getelementptr %program, ptr %arg_0, i32 0, i32 8
call ccc void @eclair_btree_end_0(ptr %76, ptr %stack.ptr_28)
%77 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_insert_range_c_new_c(ptr %77, ptr %stack.ptr_27, ptr %stack.ptr_28)
%78 = getelementptr %program, ptr %arg_0, i32 0, i32 8
%79 = getelementptr %program, ptr %arg_0, i32 0, i32 6
call ccc void @eclair_btree_swap_0(ptr %78, ptr %79)
%80 = getelementptr %program, ptr %arg_0, i32 0, i32 7
call ccc void @eclair_btree_begin_0(ptr %80, ptr %stack.ptr_29)
%81 = getelementptr %program, ptr %arg_0, i32 0, i32 7
call ccc void @eclair_btree_end_0(ptr %81, ptr %stack.ptr_30)
%82 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_insert_range_b_new_b(ptr %82, ptr %stack.ptr_29, ptr %stack.ptr_30)
%83 = getelementptr %program, ptr %arg_0, i32 0, i32 7
%84 = getelementptr %program, ptr %arg_0, i32 0, i32 5
call ccc void @eclair_btree_swap_0(ptr %83, ptr %84)
br label %loop_0
loop.end:
%85 = getelementptr [1 x i32], ptr %stack.ptr_31, i32 0, i32 0
store i32 0, ptr %85
%86 = getelementptr [1 x i32], ptr %stack.ptr_32, i32 0, i32 0
store i32 4294967295, ptr %86
%87 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_0(ptr %87, ptr %stack.ptr_31, ptr %stack.ptr_33)
%88 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_0(ptr %88, ptr %stack.ptr_32, ptr %stack.ptr_34)
br label %loop_5
loop_5:
%89 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_33, ptr %stack.ptr_34)
br i1 %89, label %if_8, label %end_if_8
if_8:
br label %range_query.end_4
end_if_8:
%90 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_33)
%91 = getelementptr [1 x i32], ptr %stack.ptr_35, i32 0, i32 0
%92 = getelementptr [1 x i32], ptr %90, i32 0, i32 0
%93 = load i32, ptr %92
store i32 %93, ptr %91
%94 = getelementptr [1 x i32], ptr %stack.ptr_36, i32 0, i32 0
%95 = getelementptr [1 x i32], ptr %90, i32 0, i32 0
%96 = load i32, ptr %95
store i32 %96, ptr %94
%97 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_lower_bound_0(ptr %97, ptr %stack.ptr_35, ptr %stack.ptr_37)
%98 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_upper_bound_0(ptr %98, ptr %stack.ptr_36, ptr %stack.ptr_38)
br label %loop_6
loop_6:
%99 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_37, ptr %stack.ptr_38)
br i1 %99, label %if_9, label %end_if_9
if_9:
br label %range_query.end_5
end_if_9:
%100 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_37)
%101 = getelementptr [1 x i32], ptr %stack.ptr_39, i32 0, i32 0
%102 = getelementptr [1 x i32], ptr %90, i32 0, i32 0
%103 = load i32, ptr %102
store i32 %103, ptr %101
%104 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%105 = call ccc i1 @eclair_btree_insert_value_0(ptr %104, ptr %stack.ptr_39)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_37)
br label %loop_6
range_query.end_5:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_33)
br label %loop_5
range_query.end_4:
ret void
}
================================================
FILE: tests/lowering/negation.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: %extract_snippet %t/actual_eir.out "fn.*eclair_program_run" > %t/actual_eir_snippet.out
// RUN: diff %t/expected_eir.out %t/actual_eir_snippet.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_program_run" > %t/actual_llvm_snippet.out
// RUN: diff %t/expected_llvm.out %t/actual_llvm_snippet.out
//--- program.eclair
@def fact1(u32) input.
@def fact2(u32) input.
@def fact3(u32) output.
fact3(x) :-
fact1(x),
!fact1(x),
!fact2(x),
!fact2(y),
y = x + 1.
fact3(x) :-
fact1(x),
fact2(y),
!fact1(y).
//--- expected_ra.out
search fact1 as fact10 do
search fact2 as fact21 do
if (fact21[0]) ∉ fact1 do
project (fact10[0]) into fact3
search fact1 as fact10 do
if (fact10[0]) ∉ fact1 do
if (fact10[0]) ∉ fact2 do
if ((fact10[0] + 1)) ∉ fact2 do
project (fact10[0]) into fact3
//--- expected_eir.out
export fn eclair_program_run(*Program) -> Void
{
lower_bound_value = fact1.stack_allocate Value
upper_bound_value = fact1.stack_allocate Value
lower_bound_value.0 = 0
upper_bound_value.0 = 4294967295
begin_iter = fact1.stack_allocate Iter
end_iter = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value, begin_iter)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value, end_iter)
loop
{
condition = fact1.iter_is_equal(begin_iter, end_iter)
if (condition)
{
goto range_query.end
}
current = fact1.iter_current(begin_iter)
lower_bound_value_1 = fact2.stack_allocate Value
upper_bound_value_1 = fact2.stack_allocate Value
lower_bound_value_1.0 = 0
upper_bound_value_1.0 = 4294967295
begin_iter_1 = fact2.stack_allocate Iter
end_iter_1 = fact2.stack_allocate Iter
fact2.iter_lower_bound(FN_ARG[0].2, lower_bound_value_1, begin_iter_1)
fact2.iter_upper_bound(FN_ARG[0].2, upper_bound_value_1, end_iter_1)
loop
{
condition_1 = fact2.iter_is_equal(begin_iter_1, end_iter_1)
if (condition_1)
{
goto range_query.end_1
}
current_1 = fact2.iter_current(begin_iter_1)
value = fact1.stack_allocate Value
value.0 = current_1.0
contains_result = fact1.contains(FN_ARG[0].1, value)
condition_2 = not contains_result
if (condition_2)
{
value_1 = fact3.stack_allocate Value
value_1.0 = current.0
fact3.insert(FN_ARG[0].3, value_1)
}
fact2.iter_next(begin_iter_1)
}
range_query.end_1:
fact1.iter_next(begin_iter)
}
range_query.end:
lower_bound_value_2 = fact1.stack_allocate Value
upper_bound_value_2 = fact1.stack_allocate Value
lower_bound_value_2.0 = 0
upper_bound_value_2.0 = 4294967295
begin_iter_2 = fact1.stack_allocate Iter
end_iter_2 = fact1.stack_allocate Iter
fact1.iter_lower_bound(FN_ARG[0].1, lower_bound_value_2, begin_iter_2)
fact1.iter_upper_bound(FN_ARG[0].1, upper_bound_value_2, end_iter_2)
loop
{
condition_3 = fact1.iter_is_equal(begin_iter_2, end_iter_2)
if (condition_3)
{
goto range_query.end_2
}
current_2 = fact1.iter_current(begin_iter_2)
value_2 = fact1.stack_allocate Value
value_2.0 = current_2.0
contains_result_1 = fact1.contains(FN_ARG[0].1, value_2)
condition_4 = not contains_result_1
if (condition_4)
{
value_3 = fact2.stack_allocate Value
value_3.0 = current_2.0
contains_result_2 = fact2.contains(FN_ARG[0].2, value_3)
condition_5 = not contains_result_2
if (condition_5)
{
value_4 = fact2.stack_allocate Value
value_4.0 = (current_2.0 + 1)
contains_result_3 = fact2.contains(FN_ARG[0].2, value_4)
condition_6 = not contains_result_3
if (condition_6)
{
value_5 = fact3.stack_allocate Value
value_5.0 = current_2.0
fact3.insert(FN_ARG[0].3, value_5)
}
}
}
fact1.iter_next(begin_iter_2)
}
range_query.end_2:
}
//--- expected_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [1 x i32], i32 1
%stack.ptr_1 = alloca [1 x i32], i32 1
%stack.ptr_2 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_3 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_4 = alloca [1 x i32], i32 1
%stack.ptr_5 = alloca [1 x i32], i32 1
%stack.ptr_6 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_7 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_8 = alloca [1 x i32], i32 1
%stack.ptr_9 = alloca [1 x i32], i32 1
%stack.ptr_10 = alloca [1 x i32], i32 1
%stack.ptr_11 = alloca [1 x i32], i32 1
%stack.ptr_12 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_13 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_14 = alloca [1 x i32], i32 1
%stack.ptr_15 = alloca [1 x i32], i32 1
%stack.ptr_16 = alloca [1 x i32], i32 1
%stack.ptr_17 = alloca [1 x i32], i32 1
%0 = getelementptr [1 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 0, ptr %0
%1 = getelementptr [1 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 4294967295, ptr %1
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %2, ptr %stack.ptr_0, ptr %stack.ptr_2)
%3 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %3, ptr %stack.ptr_1, ptr %stack.ptr_3)
br label %loop_0
loop_0:
%4 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_2, ptr %stack.ptr_3)
br i1 %4, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%5 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_2)
%6 = getelementptr [1 x i32], ptr %stack.ptr_4, i32 0, i32 0
store i32 0, ptr %6
%7 = getelementptr [1 x i32], ptr %stack.ptr_5, i32 0, i32 0
store i32 4294967295, ptr %7
%8 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_0(ptr %8, ptr %stack.ptr_4, ptr %stack.ptr_6)
%9 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_0(ptr %9, ptr %stack.ptr_5, ptr %stack.ptr_7)
br label %loop_1
loop_1:
%10 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_6, ptr %stack.ptr_7)
br i1 %10, label %if_1, label %end_if_1
if_1:
br label %range_query.end_1
end_if_1:
%11 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_6)
%12 = getelementptr [1 x i32], ptr %stack.ptr_8, i32 0, i32 0
%13 = getelementptr [1 x i32], ptr %11, i32 0, i32 0
%14 = load i32, ptr %13
store i32 %14, ptr %12
%15 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%16 = call ccc i1 @eclair_btree_contains_0(ptr %15, ptr %stack.ptr_8)
%17 = select i1 %16, i1 0, i1 1
br i1 %17, label %if_2, label %end_if_2
if_2:
%18 = getelementptr [1 x i32], ptr %stack.ptr_9, i32 0, i32 0
%19 = getelementptr [1 x i32], ptr %5, i32 0, i32 0
%20 = load i32, ptr %19
store i32 %20, ptr %18
%21 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%22 = call ccc i1 @eclair_btree_insert_value_0(ptr %21, ptr %stack.ptr_9)
br label %end_if_2
end_if_2:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_6)
br label %loop_1
range_query.end_1:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_2)
br label %loop_0
range_query.end:
%23 = getelementptr [1 x i32], ptr %stack.ptr_10, i32 0, i32 0
store i32 0, ptr %23
%24 = getelementptr [1 x i32], ptr %stack.ptr_11, i32 0, i32 0
store i32 4294967295, ptr %24
%25 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %25, ptr %stack.ptr_10, ptr %stack.ptr_12)
%26 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %26, ptr %stack.ptr_11, ptr %stack.ptr_13)
br label %loop_2
loop_2:
%27 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_12, ptr %stack.ptr_13)
br i1 %27, label %if_3, label %end_if_3
if_3:
br label %range_query.end_2
end_if_3:
%28 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_12)
%29 = getelementptr [1 x i32], ptr %stack.ptr_14, i32 0, i32 0
%30 = getelementptr [1 x i32], ptr %28, i32 0, i32 0
%31 = load i32, ptr %30
store i32 %31, ptr %29
%32 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%33 = call ccc i1 @eclair_btree_contains_0(ptr %32, ptr %stack.ptr_14)
%34 = select i1 %33, i1 0, i1 1
br i1 %34, label %if_4, label %end_if_6
if_4:
%35 = getelementptr [1 x i32], ptr %stack.ptr_15, i32 0, i32 0
%36 = getelementptr [1 x i32], ptr %28, i32 0, i32 0
%37 = load i32, ptr %36
store i32 %37, ptr %35
%38 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%39 = call ccc i1 @eclair_btree_contains_0(ptr %38, ptr %stack.ptr_15)
%40 = select i1 %39, i1 0, i1 1
br i1 %40, label %if_5, label %end_if_5
if_5:
%41 = getelementptr [1 x i32], ptr %stack.ptr_16, i32 0, i32 0
%42 = getelementptr [1 x i32], ptr %28, i32 0, i32 0
%43 = load i32, ptr %42
%44 = add i32 %43, 1
store i32 %44, ptr %41
%45 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%46 = call ccc i1 @eclair_btree_contains_0(ptr %45, ptr %stack.ptr_16)
%47 = select i1 %46, i1 0, i1 1
br i1 %47, label %if_6, label %end_if_4
if_6:
%48 = getelementptr [1 x i32], ptr %stack.ptr_17, i32 0, i32 0
%49 = getelementptr [1 x i32], ptr %28, i32 0, i32 0
%50 = load i32, ptr %49
store i32 %50, ptr %48
%51 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%52 = call ccc i1 @eclair_btree_insert_value_0(ptr %51, ptr %stack.ptr_17)
br label %end_if_4
end_if_4:
br label %end_if_5
end_if_5:
br label %end_if_6
end_if_6:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_12)
br label %loop_2
range_query.end_2:
ret void
}
================================================
FILE: tests/lowering/negation_with_wildcards.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: %extract_snippet %t/actual_eir.out "fn.*eclair_program_run" > %t/actual_eir_snippet.out
// RUN: diff %t/expected_eir.out %t/actual_eir_snippet.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_program_run" > %t/actual_llvm_snippet.out
// RUN: diff %t/expected_llvm.out %t/actual_llvm_snippet.out
//--- program.eclair
@def first(u32).
@def second(u32, u32).
@def third(u32, u32) output.
first(1).
second(2, 3).
third(x, x) :-
first(x),
!second(_, x).
//--- expected_ra.out
project (2, 3) into second
project (1) into first
search first as first0 do
if (undefined, first0[0]) ∉ second do
project (first0[0], first0[0]) into third
//--- expected_eir.out
export fn eclair_program_run(*Program) -> Void
{
value = second.stack_allocate Value
value.0 = 2
value.1 = 3
second.insert(FN_ARG[0].2, value)
value_1 = first.stack_allocate Value
value_1.0 = 1
first.insert(FN_ARG[0].1, value_1)
lower_bound_value = first.stack_allocate Value
upper_bound_value = first.stack_allocate Value
lower_bound_value.0 = 0
upper_bound_value.0 = 4294967295
begin_iter = first.stack_allocate Iter
end_iter = first.stack_allocate Iter
first.iter_lower_bound(FN_ARG[0].1, lower_bound_value, begin_iter)
first.iter_upper_bound(FN_ARG[0].1, upper_bound_value, end_iter)
loop
{
condition = first.iter_is_equal(begin_iter, end_iter)
if (condition)
{
goto range_query.end
}
current = first.iter_current(begin_iter)
lower_bound_value_1 = second.stack_allocate Value
lower_bound_value_1.0 = 0
lower_bound_value_1.1 = current.0
upper_bound_value_1 = second.stack_allocate Value
upper_bound_value_1.0 = 4294967295
upper_bound_value_1.1 = current.0
begin_iter_1 = second.stack_allocate Iter
end_iter_1 = second.stack_allocate Iter
second.iter_lower_bound(FN_ARG[0].2, lower_bound_value_1, begin_iter_1)
second.iter_upper_bound(FN_ARG[0].2, upper_bound_value_1, end_iter_1)
condition_1 = second.iter_is_equal(begin_iter_1, end_iter_1)
if (condition_1)
{
value_2 = third.stack_allocate Value
value_2.0 = current.0
value_2.1 = current.0
third.insert(FN_ARG[0].3, value_2)
}
first.iter_next(begin_iter)
}
range_query.end:
}
//--- expected_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [2 x i32], i32 1
%stack.ptr_1 = alloca [1 x i32], i32 1
%stack.ptr_2 = alloca [1 x i32], i32 1
%stack.ptr_3 = alloca [1 x i32], i32 1
%stack.ptr_4 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_5 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_6 = alloca [2 x i32], i32 1
%stack.ptr_7 = alloca [2 x i32], i32 1
%stack.ptr_8 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_9 = alloca %btree_iterator_t_1, i32 1
%stack.ptr_10 = alloca [2 x i32], i32 1
%0 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 2, ptr %0
%1 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 3, ptr %1
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%3 = call ccc i1 @eclair_btree_insert_value_1(ptr %2, ptr %stack.ptr_0)
%4 = getelementptr [1 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 1, ptr %4
%5 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%6 = call ccc i1 @eclair_btree_insert_value_0(ptr %5, ptr %stack.ptr_1)
%7 = getelementptr [1 x i32], ptr %stack.ptr_2, i32 0, i32 0
store i32 0, ptr %7
%8 = getelementptr [1 x i32], ptr %stack.ptr_3, i32 0, i32 0
store i32 4294967295, ptr %8
%9 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %9, ptr %stack.ptr_2, ptr %stack.ptr_4)
%10 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %10, ptr %stack.ptr_3, ptr %stack.ptr_5)
br label %loop_0
loop_0:
%11 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_4, ptr %stack.ptr_5)
br i1 %11, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%12 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_4)
%13 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 0
store i32 0, ptr %13
%14 = getelementptr [2 x i32], ptr %stack.ptr_6, i32 0, i32 1
%15 = getelementptr [1 x i32], ptr %12, i32 0, i32 0
%16 = load i32, ptr %15
store i32 %16, ptr %14
%17 = getelementptr [2 x i32], ptr %stack.ptr_7, i32 0, i32 0
store i32 4294967295, ptr %17
%18 = getelementptr [2 x i32], ptr %stack.ptr_7, i32 0, i32 1
%19 = getelementptr [1 x i32], ptr %12, i32 0, i32 0
%20 = load i32, ptr %19
store i32 %20, ptr %18
%21 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_1(ptr %21, ptr %stack.ptr_6, ptr %stack.ptr_8)
%22 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_1(ptr %22, ptr %stack.ptr_7, ptr %stack.ptr_9)
%23 = call ccc i1 @eclair_btree_iterator_is_equal_1(ptr %stack.ptr_8, ptr %stack.ptr_9)
br i1 %23, label %if_1, label %end_if_1
if_1:
%24 = getelementptr [2 x i32], ptr %stack.ptr_10, i32 0, i32 0
%25 = getelementptr [1 x i32], ptr %12, i32 0, i32 0
%26 = load i32, ptr %25
store i32 %26, ptr %24
%27 = getelementptr [2 x i32], ptr %stack.ptr_10, i32 0, i32 1
%28 = getelementptr [1 x i32], ptr %12, i32 0, i32 0
%29 = load i32, ptr %28
store i32 %29, ptr %27
%30 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%31 = call ccc i1 @eclair_btree_insert_value_2(ptr %30, ptr %stack.ptr_10)
br label %end_if_1
end_if_1:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_4)
br label %loop_0
range_query.end:
ret void
}
================================================
FILE: tests/lowering/no_top_level_facts.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: diff %t/expected_eir.out %t/actual_eir.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "program = " > %t/actual_eclair_program_type.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_program_init" > %t/actual_eclair_program_init_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_program_destroy" > %t/actual_eclair_program_destroy_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_program_run" > %t/actual_eclair_program_run_llvm.out
// RUN: diff %t/expected_eclair_program_type.out %t/actual_eclair_program_type.out
// RUN: diff %t/expected_eclair_program_init_llvm.out %t/actual_eclair_program_init_llvm.out
// RUN: diff %t/expected_eclair_program_destroy_llvm.out %t/actual_eclair_program_destroy_llvm.out
// RUN: diff %t/expected_eclair_program_run_llvm.out %t/actual_eclair_program_run_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_add_facts" > %t/actual_eclair_add_facts_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@eclair_get_facts" > %t/actual_eclair_get_facts_llvm.out
// RUN: diff %t/expected_eclair_add_facts_llvm.out %t/actual_eclair_add_facts_llvm.out
// RUN: diff %t/expected_eclair_get_facts_llvm.out %t/actual_eclair_get_facts_llvm.out
//--- program.eclair
@def edge(u32, u32) input.
@def path(u32, u32) output.
path(x, y) :-
edge(x, y).
path(x, z) :-
edge(x, y),
path(y, z).
//--- expected_ra.out
search edge as edge0 do
project (edge0[0], edge0[1]) into path
merge path delta_path
loop do
purge new_path
search edge as edge0 do
search delta_path as delta_path1 where (edge0[1] = delta_path1[0]) do
if (edge0[0], delta_path1[1]) ∉ path do
project (edge0[0], delta_path1[1]) into new_path
exit if counttuples(new_path) = 0
merge new_path path
swap new_path delta_path
//--- expected_eir.out
declare_type Program
{
symbol_table
delta_path btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
edge btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
new_path btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
path btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
}
export fn eclair_program_init() -> *Program
{
program = heap_allocate_program
symbol_table.init(program.0)
delta_path.init_empty(program.1)
edge.init_empty(program.2)
new_path.init_empty(program.3)
path.init_empty(program.4)
symbol_table.insert(program.0, "edge")
symbol_table.insert(program.0, "path")
return program
}
export fn eclair_program_destroy(*Program) -> Void
{
symbol_table.destroy(FN_ARG[0].0)
delta_path.destroy(FN_ARG[0].1)
edge.destroy(FN_ARG[0].2)
new_path.destroy(FN_ARG[0].3)
path.destroy(FN_ARG[0].4)
free_program(FN_ARG[0])
}
export fn eclair_program_run(*Program) -> Void
{
lower_bound_value = edge.stack_allocate Value
upper_bound_value = edge.stack_allocate Value
lower_bound_value.0 = 0
lower_bound_value.1 = 0
upper_bound_value.0 = 4294967295
upper_bound_value.1 = 4294967295
begin_iter = edge.stack_allocate Iter
end_iter = edge.stack_allocate Iter
edge.iter_lower_bound(FN_ARG[0].2, lower_bound_value, begin_iter)
edge.iter_upper_bound(FN_ARG[0].2, upper_bound_value, end_iter)
loop
{
condition = edge.iter_is_equal(begin_iter, end_iter)
if (condition)
{
goto range_query.end
}
current = edge.iter_current(begin_iter)
value = path.stack_allocate Value
value.0 = current.0
value.1 = current.1
path.insert(FN_ARG[0].4, value)
edge.iter_next(begin_iter)
}
range_query.end:
begin_iter_1 = path.stack_allocate Iter
end_iter_1 = path.stack_allocate Iter
path.iter_begin(FN_ARG[0].4, begin_iter_1)
path.iter_end(FN_ARG[0].4, end_iter_1)
delta_path.insert_range(FN_ARG[0].1, begin_iter_1, end_iter_1)
loop
{
new_path.purge(FN_ARG[0].3)
lower_bound_value_1 = edge.stack_allocate Value
upper_bound_value_1 = edge.stack_allocate Value
lower_bound_value_1.0 = 0
lower_bound_value_1.1 = 0
upper_bound_value_1.0 = 4294967295
upper_bound_value_1.1 = 4294967295
begin_iter_2 = edge.stack_allocate Iter
end_iter_2 = edge.stack_allocate Iter
edge.iter_lower_bound(FN_ARG[0].2, lower_bound_value_1, begin_iter_2)
edge.iter_upper_bound(FN_ARG[0].2, upper_bound_value_1, end_iter_2)
loop
{
condition_1 = edge.iter_is_equal(begin_iter_2, end_iter_2)
if (condition_1)
{
goto range_query.end_1
}
current_1 = edge.iter_current(begin_iter_2)
lower_bound_value_2 = path.stack_allocate Value
upper_bound_value_2 = path.stack_allocate Value
lower_bound_value_2.0 = current_1.1
lower_bound_value_2.1 = 0
upper_bound_value_2.0 = current_1.1
upper_bound_value_2.1 = 4294967295
begin_iter_3 = path.stack_allocate Iter
end_iter_3 = path.stack_allocate Iter
delta_path.iter_lower_bound(FN_ARG[0].1, lower_bound_value_2, begin_iter_3)
delta_path.iter_upper_bound(FN_ARG[0].1, upper_bound_value_2, end_iter_3)
loop
{
condition_2 = delta_path.iter_is_equal(begin_iter_3, end_iter_3)
if (condition_2)
{
goto range_query.end_2
}
current_2 = delta_path.iter_current(begin_iter_3)
value_1 = path.stack_allocate Value
value_1.0 = current_1.0
value_1.1 = current_2.1
contains_result = path.contains(FN_ARG[0].4, value_1)
condition_3 = not contains_result
if (condition_3)
{
value_2 = path.stack_allocate Value
value_2.0 = current_1.0
value_2.1 = current_2.1
new_path.insert(FN_ARG[0].3, value_2)
}
delta_path.iter_next(begin_iter_3)
}
range_query.end_2:
edge.iter_next(begin_iter_2)
}
range_query.end_1:
condition_4 = new_path.is_empty(FN_ARG[0].3)
if (condition_4)
{
goto loop.end
}
begin_iter_4 = path.stack_allocate Iter
end_iter_4 = path.stack_allocate Iter
new_path.iter_begin(FN_ARG[0].3, begin_iter_4)
new_path.iter_end(FN_ARG[0].3, end_iter_4)
path.insert_range(FN_ARG[0].4, begin_iter_4, end_iter_4)
new_path.swap(FN_ARG[0].3, FN_ARG[0].1)
}
loop.end:
}
//--- expected_eclair_program_type.out
%program = type {%symbol_table, %btree_t_0, %btree_t_0, %btree_t_0, %btree_t_0}
//--- expected_eclair_program_init_llvm.out
define external ccc ptr @eclair_program_init() "wasm-export-name"="eclair_program_init" {
start:
%stack.ptr_0 = alloca %symbol_t, i32 1
%stack.ptr_1 = alloca %symbol_t, i32 1
%0 = call ccc ptr @malloc(i32 1624)
%1 = getelementptr %program, ptr %0, i32 0, i32 0
call ccc void @eclair_symbol_table_init(ptr %1)
%2 = getelementptr %program, ptr %0, i32 0, i32 1
call ccc void @eclair_btree_init_empty_0(ptr %2)
%3 = getelementptr %program, ptr %0, i32 0, i32 2
call ccc void @eclair_btree_init_empty_0(ptr %3)
%4 = getelementptr %program, ptr %0, i32 0, i32 3
call ccc void @eclair_btree_init_empty_0(ptr %4)
%5 = getelementptr %program, ptr %0, i32 0, i32 4
call ccc void @eclair_btree_init_empty_0(ptr %5)
%6 = getelementptr %program, ptr %0, i32 0, i32 0
%7 = getelementptr inbounds [5 x i8], ptr @string_literal_0, i32 0, i32 0
%8 = zext i32 4 to i64
%9 = call ccc ptr @malloc(i32 4)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %9, ptr %7, i64 %8, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_0, i32 4, ptr %9)
%10 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %6, ptr %stack.ptr_0)
%11 = getelementptr %program, ptr %0, i32 0, i32 0
%12 = getelementptr inbounds [5 x i8], ptr @string_literal_1, i32 0, i32 0
%13 = zext i32 4 to i64
%14 = call ccc ptr @malloc(i32 4)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %14, ptr %12, i64 %13, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_1, i32 4, ptr %14)
%15 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %11, ptr %stack.ptr_1)
ret ptr %0
}
//--- expected_eclair_program_destroy_llvm.out
define external ccc void @eclair_program_destroy(ptr %arg_0) "wasm-export-name"="eclair_program_destroy" {
start:
%0 = getelementptr %program, ptr %arg_0, i32 0, i32 0
call ccc void @eclair_symbol_table_destroy(ptr %0)
%1 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_destroy_0(ptr %1)
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_destroy_0(ptr %2)
%3 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_destroy_0(ptr %3)
%4 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_destroy_0(ptr %4)
call ccc void @free(ptr %arg_0)
ret void
}
//--- expected_eclair_program_run_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [2 x i32], i32 1
%stack.ptr_1 = alloca [2 x i32], i32 1
%stack.ptr_2 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_3 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_4 = alloca [2 x i32], i32 1
%stack.ptr_5 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_6 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_7 = alloca [2 x i32], i32 1
%stack.ptr_8 = alloca [2 x i32], i32 1
%stack.ptr_9 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_10 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_11 = alloca [2 x i32], i32 1
%stack.ptr_12 = alloca [2 x i32], i32 1
%stack.ptr_13 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_14 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_15 = alloca [2 x i32], i32 1
%stack.ptr_16 = alloca [2 x i32], i32 1
%stack.ptr_17 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_18 = alloca %btree_iterator_t_0, i32 1
%0 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 0, ptr %0
%1 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 0, ptr %1
%2 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 4294967295, ptr %2
%3 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 1
store i32 4294967295, ptr %3
%4 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_0(ptr %4, ptr %stack.ptr_0, ptr %stack.ptr_2)
%5 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_0(ptr %5, ptr %stack.ptr_1, ptr %stack.ptr_3)
br label %loop_0
loop_0:
%6 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_2, ptr %stack.ptr_3)
br i1 %6, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%7 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_2)
%8 = getelementptr [2 x i32], ptr %stack.ptr_4, i32 0, i32 0
%9 = getelementptr [2 x i32], ptr %7, i32 0, i32 0
%10 = load i32, ptr %9
store i32 %10, ptr %8
%11 = getelementptr [2 x i32], ptr %stack.ptr_4, i32 0, i32 1
%12 = getelementptr [2 x i32], ptr %7, i32 0, i32 1
%13 = load i32, ptr %12
store i32 %13, ptr %11
%14 = getelementptr %program, ptr %arg_0, i32 0, i32 4
%15 = call ccc i1 @eclair_btree_insert_value_0(ptr %14, ptr %stack.ptr_4)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_2)
br label %loop_0
range_query.end:
%16 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_begin_0(ptr %16, ptr %stack.ptr_5)
%17 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_end_0(ptr %17, ptr %stack.ptr_6)
%18 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_insert_range_delta_path_path(ptr %18, ptr %stack.ptr_5, ptr %stack.ptr_6)
br label %loop_1
loop_1:
%19 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_clear_0(ptr %19)
%20 = getelementptr [2 x i32], ptr %stack.ptr_7, i32 0, i32 0
store i32 0, ptr %20
%21 = getelementptr [2 x i32], ptr %stack.ptr_7, i32 0, i32 1
store i32 0, ptr %21
%22 = getelementptr [2 x i32], ptr %stack.ptr_8, i32 0, i32 0
store i32 4294967295, ptr %22
%23 = getelementptr [2 x i32], ptr %stack.ptr_8, i32 0, i32 1
store i32 4294967295, ptr %23
%24 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_0(ptr %24, ptr %stack.ptr_7, ptr %stack.ptr_9)
%25 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_0(ptr %25, ptr %stack.ptr_8, ptr %stack.ptr_10)
br label %loop_2
loop_2:
%26 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_9, ptr %stack.ptr_10)
br i1 %26, label %if_1, label %end_if_1
if_1:
br label %range_query.end_1
end_if_1:
%27 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_9)
%28 = getelementptr [2 x i32], ptr %stack.ptr_11, i32 0, i32 0
%29 = getelementptr [2 x i32], ptr %27, i32 0, i32 1
%30 = load i32, ptr %29
store i32 %30, ptr %28
%31 = getelementptr [2 x i32], ptr %stack.ptr_11, i32 0, i32 1
store i32 0, ptr %31
%32 = getelementptr [2 x i32], ptr %stack.ptr_12, i32 0, i32 0
%33 = getelementptr [2 x i32], ptr %27, i32 0, i32 1
%34 = load i32, ptr %33
store i32 %34, ptr %32
%35 = getelementptr [2 x i32], ptr %stack.ptr_12, i32 0, i32 1
store i32 4294967295, ptr %35
%36 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %36, ptr %stack.ptr_11, ptr %stack.ptr_13)
%37 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %37, ptr %stack.ptr_12, ptr %stack.ptr_14)
br label %loop_3
loop_3:
%38 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_13, ptr %stack.ptr_14)
br i1 %38, label %if_2, label %end_if_2
if_2:
br label %range_query.end_2
end_if_2:
%39 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_13)
%40 = getelementptr [2 x i32], ptr %stack.ptr_15, i32 0, i32 0
%41 = getelementptr [2 x i32], ptr %27, i32 0, i32 0
%42 = load i32, ptr %41
store i32 %42, ptr %40
%43 = getelementptr [2 x i32], ptr %stack.ptr_15, i32 0, i32 1
%44 = getelementptr [2 x i32], ptr %39, i32 0, i32 1
%45 = load i32, ptr %44
store i32 %45, ptr %43
%46 = getelementptr %program, ptr %arg_0, i32 0, i32 4
%47 = call ccc i1 @eclair_btree_contains_0(ptr %46, ptr %stack.ptr_15)
%48 = select i1 %47, i1 0, i1 1
br i1 %48, label %if_3, label %end_if_3
if_3:
%49 = getelementptr [2 x i32], ptr %stack.ptr_16, i32 0, i32 0
%50 = getelementptr [2 x i32], ptr %27, i32 0, i32 0
%51 = load i32, ptr %50
store i32 %51, ptr %49
%52 = getelementptr [2 x i32], ptr %stack.ptr_16, i32 0, i32 1
%53 = getelementptr [2 x i32], ptr %39, i32 0, i32 1
%54 = load i32, ptr %53
store i32 %54, ptr %52
%55 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%56 = call ccc i1 @eclair_btree_insert_value_0(ptr %55, ptr %stack.ptr_16)
br label %end_if_3
end_if_3:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_13)
br label %loop_3
range_query.end_2:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_9)
br label %loop_2
range_query.end_1:
%57 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%58 = call ccc i1 @eclair_btree_is_empty_0(ptr %57)
br i1 %58, label %if_4, label %end_if_4
if_4:
br label %loop.end
end_if_4:
%59 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_begin_0(ptr %59, ptr %stack.ptr_17)
%60 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_end_0(ptr %60, ptr %stack.ptr_18)
%61 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_insert_range_path_new_path(ptr %61, ptr %stack.ptr_17, ptr %stack.ptr_18)
%62 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%63 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_swap_0(ptr %62, ptr %63)
br label %loop_1
loop.end:
ret void
}
//--- expected_eclair_add_facts_llvm.out
define external ccc void @eclair_add_facts(ptr %eclair_program_0, i32 %fact_type_0, ptr %memory_0, i32 %fact_count_0) "wasm-export-name"="eclair_add_facts" {
start:
switch i32 %fact_type_0, label %switch.default_0 [i32 0, label %edge_0]
edge_0:
%0 = getelementptr %program, ptr %eclair_program_0, i32 0, i32 2
br label %for_begin_0
for_begin_0:
%1 = phi i32 [0, %edge_0], [%5, %for_body_0]
%2 = icmp ult i32 %1, %fact_count_0
br i1 %2, label %for_body_0, label %for_end_0
for_body_0:
%3 = getelementptr [2 x i32], ptr %memory_0, i32 %1
%4 = call ccc i1 @eclair_btree_insert_value_0(ptr %0, ptr %3)
%5 = add i32 1, %1
br label %for_begin_0
for_end_0:
br label %end_0
switch.default_0:
ret void
end_0:
ret void
}
//--- expected_eclair_get_facts_llvm.out
define external ccc ptr @eclair_get_facts(ptr %eclair_program_0, i32 %fact_type_0) "wasm-export-name"="eclair_get_facts" {
start:
%stack.ptr_0 = alloca i32, i32 1
%stack.ptr_1 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_2 = alloca %btree_iterator_t_0, i32 1
switch i32 %fact_type_0, label %switch.default_0 [i32 1, label %path_0]
path_0:
%0 = getelementptr %program, ptr %eclair_program_0, i32 0, i32 4
%1 = call ccc i64 @eclair_btree_size_0(ptr %0)
%2 = trunc i64 %1 to i32
%3 = mul i32 %2, 8
%4 = call ccc ptr @malloc(i32 %3)
store i32 0, ptr %stack.ptr_0
call ccc void @eclair_btree_begin_0(ptr %0, ptr %stack.ptr_1)
call ccc void @eclair_btree_end_0(ptr %0, ptr %stack.ptr_2)
br label %while_begin_0
while_begin_0:
%5 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_1, ptr %stack.ptr_2)
%6 = select i1 %5, i1 0, i1 1
br i1 %6, label %while_body_0, label %while_end_0
while_body_0:
%7 = load i32, ptr %stack.ptr_0
%8 = getelementptr [2 x i32], ptr %4, i32 %7
%9 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_1)
%10 = getelementptr [2 x i32], ptr %9, i32 0
%11 = load [2 x i32], ptr %10
%12 = getelementptr [2 x i32], ptr %8, i32 0
store [2 x i32] %11, ptr %12
%13 = add i32 %7, 1
store i32 %13, ptr %stack.ptr_0
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_1)
br label %while_begin_0
while_end_0:
ret ptr %4
switch.default_0:
ret ptr zeroinitializer
}
================================================
FILE: tests/lowering/recursive_mix_of_rules.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
//--- program.eclair
@def edge(u32, u32) input.
@def reachable(u32) output.
reachable(x) :- edge(x, _).
reachable(x) :- edge(_, x).
reachable(x) :-
edge(x, y),
reachable(y).
reachable(x) :-
edge(y, x),
reachable(y).
//--- expected_ra.out
search edge as edge0 do
project (edge0[1]) into reachable
search edge as edge0 do
project (edge0[0]) into reachable
merge reachable delta_reachable
loop do
purge new_reachable
parallel do
search edge as edge0 do
if (edge0[1]) ∉ reachable do
search delta_reachable as delta_reachable1 where (edge0[0] = delta_reachable1[0]) do
project (edge0[1]) into new_reachable
search edge as edge0 do
if (edge0[0]) ∉ reachable do
search delta_reachable as delta_reachable1 where (edge0[1] = delta_reachable1[0]) do
project (edge0[0]) into new_reachable
exit if counttuples(new_reachable) = 0
merge new_reachable reachable
swap new_reachable delta_reachable
================================================
FILE: tests/lowering/single_non_recursive_rule.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: diff %t/expected_eir.out %t/actual_eir.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "program = " > %t/actual_eclair_program_type.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_init" > %t/actual_eclair_program_init_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_destroy" > %t/actual_eclair_program_destroy_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_run" > %t/actual_eclair_program_run_llvm.out
// RUN: diff %t/expected_eclair_program_type.out %t/actual_eclair_program_type.out
// RUN: diff %t/expected_eclair_program_init_llvm.out %t/actual_eclair_program_init_llvm.out
// RUN: diff %t/expected_eclair_program_destroy_llvm.out %t/actual_eclair_program_destroy_llvm.out
// RUN: diff %t/expected_eclair_program_run_llvm.out %t/actual_eclair_program_run_llvm.out
//--- program.eclair
@def edge(u32, u32).
@def path(u32, u32) output.
edge(1,2).
path(x,y) :-
edge(x,y).
//--- expected_ra.out
project (1, 2) into edge
search edge as edge0 do
project (edge0[0], edge0[1]) into path
//--- expected_eir.out
declare_type Program
{
symbol_table
edge btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
path btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
}
export fn eclair_program_init() -> *Program
{
program = heap_allocate_program
symbol_table.init(program.0)
edge.init_empty(program.1)
path.init_empty(program.2)
symbol_table.insert(program.0, "edge")
symbol_table.insert(program.0, "path")
return program
}
export fn eclair_program_destroy(*Program) -> Void
{
symbol_table.destroy(FN_ARG[0].0)
edge.destroy(FN_ARG[0].1)
path.destroy(FN_ARG[0].2)
free_program(FN_ARG[0])
}
export fn eclair_program_run(*Program) -> Void
{
value = edge.stack_allocate Value
value.0 = 1
value.1 = 2
edge.insert(FN_ARG[0].1, value)
lower_bound_value = edge.stack_allocate Value
upper_bound_value = edge.stack_allocate Value
lower_bound_value.0 = 0
lower_bound_value.1 = 0
upper_bound_value.0 = 4294967295
upper_bound_value.1 = 4294967295
begin_iter = edge.stack_allocate Iter
end_iter = edge.stack_allocate Iter
edge.iter_lower_bound(FN_ARG[0].1, lower_bound_value, begin_iter)
edge.iter_upper_bound(FN_ARG[0].1, upper_bound_value, end_iter)
loop
{
condition = edge.iter_is_equal(begin_iter, end_iter)
if (condition)
{
goto range_query.end
}
current = edge.iter_current(begin_iter)
value_1 = path.stack_allocate Value
value_1.0 = current.0
value_1.1 = current.1
path.insert(FN_ARG[0].2, value_1)
edge.iter_next(begin_iter)
}
range_query.end:
}
//--- expected_eclair_program_type.out
%program = type {%symbol_table, %btree_t_0, %btree_t_0}
//--- expected_eclair_program_init_llvm.out
define external ccc ptr @eclair_program_init() "wasm-export-name"="eclair_program_init" {
start:
%stack.ptr_0 = alloca %symbol_t, i32 1
%stack.ptr_1 = alloca %symbol_t, i32 1
%0 = call ccc ptr @malloc(i32 1592)
%1 = getelementptr %program, ptr %0, i32 0, i32 0
call ccc void @eclair_symbol_table_init(ptr %1)
%2 = getelementptr %program, ptr %0, i32 0, i32 1
call ccc void @eclair_btree_init_empty_0(ptr %2)
%3 = getelementptr %program, ptr %0, i32 0, i32 2
call ccc void @eclair_btree_init_empty_0(ptr %3)
%4 = getelementptr %program, ptr %0, i32 0, i32 0
%5 = getelementptr inbounds [5 x i8], ptr @string_literal_0, i32 0, i32 0
%6 = zext i32 4 to i64
%7 = call ccc ptr @malloc(i32 4)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %7, ptr %5, i64 %6, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_0, i32 4, ptr %7)
%8 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %4, ptr %stack.ptr_0)
%9 = getelementptr %program, ptr %0, i32 0, i32 0
%10 = getelementptr inbounds [5 x i8], ptr @string_literal_1, i32 0, i32 0
%11 = zext i32 4 to i64
%12 = call ccc ptr @malloc(i32 4)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %12, ptr %10, i64 %11, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_1, i32 4, ptr %12)
%13 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %9, ptr %stack.ptr_1)
ret ptr %0
}
//--- expected_eclair_program_destroy_llvm.out
define external ccc void @eclair_program_destroy(ptr %arg_0) "wasm-export-name"="eclair_program_destroy" {
start:
%0 = getelementptr %program, ptr %arg_0, i32 0, i32 0
call ccc void @eclair_symbol_table_destroy(ptr %0)
%1 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_destroy_0(ptr %1)
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_destroy_0(ptr %2)
call ccc void @free(ptr %arg_0)
ret void
}
//--- expected_eclair_program_run_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [2 x i32], i32 1
%stack.ptr_1 = alloca [2 x i32], i32 1
%stack.ptr_2 = alloca [2 x i32], i32 1
%stack.ptr_3 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_4 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_5 = alloca [2 x i32], i32 1
%0 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 1, ptr %0
%1 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 2, ptr %1
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%3 = call ccc i1 @eclair_btree_insert_value_0(ptr %2, ptr %stack.ptr_0)
%4 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 0, ptr %4
%5 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 1
store i32 0, ptr %5
%6 = getelementptr [2 x i32], ptr %stack.ptr_2, i32 0, i32 0
store i32 4294967295, ptr %6
%7 = getelementptr [2 x i32], ptr %stack.ptr_2, i32 0, i32 1
store i32 4294967295, ptr %7
%8 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %8, ptr %stack.ptr_1, ptr %stack.ptr_3)
%9 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %9, ptr %stack.ptr_2, ptr %stack.ptr_4)
br label %loop_0
loop_0:
%10 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_3, ptr %stack.ptr_4)
br i1 %10, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%11 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_3)
%12 = getelementptr [2 x i32], ptr %stack.ptr_5, i32 0, i32 0
%13 = getelementptr [2 x i32], ptr %11, i32 0, i32 0
%14 = load i32, ptr %13
store i32 %14, ptr %12
%15 = getelementptr [2 x i32], ptr %stack.ptr_5, i32 0, i32 1
%16 = getelementptr [2 x i32], ptr %11, i32 0, i32 1
%17 = load i32, ptr %16
store i32 %17, ptr %15
%18 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%19 = call ccc i1 @eclair_btree_insert_value_0(ptr %18, ptr %stack.ptr_5)
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_3)
br label %loop_0
range_query.end:
ret void
}
================================================
FILE: tests/lowering/single_recursive_rule.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// NOTE: program for now also contains delta_ and new_ relations,
// probably it's more efficient to move these to the stack (but left out of scope for now)
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: diff %t/expected_eir.out %t/actual_eir.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "program = " > %t/actual_eclair_program_type.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_init" > %t/actual_eclair_program_init_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_destroy" > %t/actual_eclair_program_destroy_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_run" > %t/actual_eclair_program_run_llvm.out
// RUN: diff %t/expected_eclair_program_type.out %t/actual_eclair_program_type.out
// RUN: diff %t/expected_eclair_program_init_llvm.out %t/actual_eclair_program_init_llvm.out
// RUN: diff %t/expected_eclair_program_destroy_llvm.out %t/actual_eclair_program_destroy_llvm.out
// RUN: diff %t/expected_eclair_program_run_llvm.out %t/actual_eclair_program_run_llvm.out
//--- program.eclair
@def edge(u32, u32).
@def path(u32, u32) output.
edge(1,2).
path(x, y) :-
edge(x, z),
path(z, y).
//--- expected_ra.out
project (1, 2) into edge
merge path delta_path
loop do
purge new_path
search edge as edge0 do
search delta_path as delta_path1 where (edge0[1] = delta_path1[0]) do
if (edge0[0], delta_path1[1]) ∉ path do
project (edge0[0], delta_path1[1]) into new_path
exit if counttuples(new_path) = 0
merge new_path path
swap new_path delta_path
//--- expected_eir.out
declare_type Program
{
symbol_table
delta_path btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
edge btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
new_path btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
path btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
}
export fn eclair_program_init() -> *Program
{
program = heap_allocate_program
symbol_table.init(program.0)
delta_path.init_empty(program.1)
edge.init_empty(program.2)
new_path.init_empty(program.3)
path.init_empty(program.4)
symbol_table.insert(program.0, "edge")
symbol_table.insert(program.0, "path")
return program
}
export fn eclair_program_destroy(*Program) -> Void
{
symbol_table.destroy(FN_ARG[0].0)
delta_path.destroy(FN_ARG[0].1)
edge.destroy(FN_ARG[0].2)
new_path.destroy(FN_ARG[0].3)
path.destroy(FN_ARG[0].4)
free_program(FN_ARG[0])
}
export fn eclair_program_run(*Program) -> Void
{
value = edge.stack_allocate Value
value.0 = 1
value.1 = 2
edge.insert(FN_ARG[0].2, value)
begin_iter = path.stack_allocate Iter
end_iter = path.stack_allocate Iter
path.iter_begin(FN_ARG[0].4, begin_iter)
path.iter_end(FN_ARG[0].4, end_iter)
delta_path.insert_range(FN_ARG[0].1, begin_iter, end_iter)
loop
{
new_path.purge(FN_ARG[0].3)
lower_bound_value = edge.stack_allocate Value
upper_bound_value = edge.stack_allocate Value
lower_bound_value.0 = 0
lower_bound_value.1 = 0
upper_bound_value.0 = 4294967295
upper_bound_value.1 = 4294967295
begin_iter_1 = edge.stack_allocate Iter
end_iter_1 = edge.stack_allocate Iter
edge.iter_lower_bound(FN_ARG[0].2, lower_bound_value, begin_iter_1)
edge.iter_upper_bound(FN_ARG[0].2, upper_bound_value, end_iter_1)
loop
{
condition = edge.iter_is_equal(begin_iter_1, end_iter_1)
if (condition)
{
goto range_query.end
}
current = edge.iter_current(begin_iter_1)
lower_bound_value_1 = path.stack_allocate Value
upper_bound_value_1 = path.stack_allocate Value
lower_bound_value_1.0 = current.1
lower_bound_value_1.1 = 0
upper_bound_value_1.0 = current.1
upper_bound_value_1.1 = 4294967295
begin_iter_2 = path.stack_allocate Iter
end_iter_2 = path.stack_allocate Iter
delta_path.iter_lower_bound(FN_ARG[0].1, lower_bound_value_1, begin_iter_2)
delta_path.iter_upper_bound(FN_ARG[0].1, upper_bound_value_1, end_iter_2)
loop
{
condition_1 = delta_path.iter_is_equal(begin_iter_2, end_iter_2)
if (condition_1)
{
goto range_query.end_1
}
current_1 = delta_path.iter_current(begin_iter_2)
value_1 = path.stack_allocate Value
value_1.0 = current.0
value_1.1 = current_1.1
contains_result = path.contains(FN_ARG[0].4, value_1)
condition_2 = not contains_result
if (condition_2)
{
value_2 = path.stack_allocate Value
value_2.0 = current.0
value_2.1 = current_1.1
new_path.insert(FN_ARG[0].3, value_2)
}
delta_path.iter_next(begin_iter_2)
}
range_query.end_1:
edge.iter_next(begin_iter_1)
}
range_query.end:
condition_3 = new_path.is_empty(FN_ARG[0].3)
if (condition_3)
{
goto loop.end
}
begin_iter_3 = path.stack_allocate Iter
end_iter_3 = path.stack_allocate Iter
new_path.iter_begin(FN_ARG[0].3, begin_iter_3)
new_path.iter_end(FN_ARG[0].3, end_iter_3)
path.insert_range(FN_ARG[0].4, begin_iter_3, end_iter_3)
new_path.swap(FN_ARG[0].3, FN_ARG[0].1)
}
loop.end:
}
//--- expected_eclair_program_type.out
%program = type {%symbol_table, %btree_t_0, %btree_t_0, %btree_t_0, %btree_t_0}
//--- expected_eclair_program_init_llvm.out
define external ccc ptr @eclair_program_init() "wasm-export-name"="eclair_program_init" {
start:
%stack.ptr_0 = alloca %symbol_t, i32 1
%stack.ptr_1 = alloca %symbol_t, i32 1
%0 = call ccc ptr @malloc(i32 1624)
%1 = getelementptr %program, ptr %0, i32 0, i32 0
call ccc void @eclair_symbol_table_init(ptr %1)
%2 = getelementptr %program, ptr %0, i32 0, i32 1
call ccc void @eclair_btree_init_empty_0(ptr %2)
%3 = getelementptr %program, ptr %0, i32 0, i32 2
call ccc void @eclair_btree_init_empty_0(ptr %3)
%4 = getelementptr %program, ptr %0, i32 0, i32 3
call ccc void @eclair_btree_init_empty_0(ptr %4)
%5 = getelementptr %program, ptr %0, i32 0, i32 4
call ccc void @eclair_btree_init_empty_0(ptr %5)
%6 = getelementptr %program, ptr %0, i32 0, i32 0
%7 = getelementptr inbounds [5 x i8], ptr @string_literal_0, i32 0, i32 0
%8 = zext i32 4 to i64
%9 = call ccc ptr @malloc(i32 4)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %9, ptr %7, i64 %8, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_0, i32 4, ptr %9)
%10 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %6, ptr %stack.ptr_0)
%11 = getelementptr %program, ptr %0, i32 0, i32 0
%12 = getelementptr inbounds [5 x i8], ptr @string_literal_1, i32 0, i32 0
%13 = zext i32 4 to i64
%14 = call ccc ptr @malloc(i32 4)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %14, ptr %12, i64 %13, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_1, i32 4, ptr %14)
%15 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %11, ptr %stack.ptr_1)
ret ptr %0
}
//--- expected_eclair_program_destroy_llvm.out
define external ccc void @eclair_program_destroy(ptr %arg_0) "wasm-export-name"="eclair_program_destroy" {
start:
%0 = getelementptr %program, ptr %arg_0, i32 0, i32 0
call ccc void @eclair_symbol_table_destroy(ptr %0)
%1 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_destroy_0(ptr %1)
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_destroy_0(ptr %2)
%3 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_destroy_0(ptr %3)
%4 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_destroy_0(ptr %4)
call ccc void @free(ptr %arg_0)
ret void
}
//--- expected_eclair_program_run_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [2 x i32], i32 1
%stack.ptr_1 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_2 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_3 = alloca [2 x i32], i32 1
%stack.ptr_4 = alloca [2 x i32], i32 1
%stack.ptr_5 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_6 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_7 = alloca [2 x i32], i32 1
%stack.ptr_8 = alloca [2 x i32], i32 1
%stack.ptr_9 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_10 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_11 = alloca [2 x i32], i32 1
%stack.ptr_12 = alloca [2 x i32], i32 1
%stack.ptr_13 = alloca %btree_iterator_t_0, i32 1
%stack.ptr_14 = alloca %btree_iterator_t_0, i32 1
%0 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 1, ptr %0
%1 = getelementptr [2 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 2, ptr %1
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%3 = call ccc i1 @eclair_btree_insert_value_0(ptr %2, ptr %stack.ptr_0)
%4 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_begin_0(ptr %4, ptr %stack.ptr_1)
%5 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_end_0(ptr %5, ptr %stack.ptr_2)
%6 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_insert_range_delta_path_path(ptr %6, ptr %stack.ptr_1, ptr %stack.ptr_2)
br label %loop_0
loop_0:
%7 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_clear_0(ptr %7)
%8 = getelementptr [2 x i32], ptr %stack.ptr_3, i32 0, i32 0
store i32 0, ptr %8
%9 = getelementptr [2 x i32], ptr %stack.ptr_3, i32 0, i32 1
store i32 0, ptr %9
%10 = getelementptr [2 x i32], ptr %stack.ptr_4, i32 0, i32 0
store i32 4294967295, ptr %10
%11 = getelementptr [2 x i32], ptr %stack.ptr_4, i32 0, i32 1
store i32 4294967295, ptr %11
%12 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_lower_bound_0(ptr %12, ptr %stack.ptr_3, ptr %stack.ptr_5)
%13 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_upper_bound_0(ptr %13, ptr %stack.ptr_4, ptr %stack.ptr_6)
br label %loop_1
loop_1:
%14 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_5, ptr %stack.ptr_6)
br i1 %14, label %if_0, label %end_if_0
if_0:
br label %range_query.end
end_if_0:
%15 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_5)
%16 = getelementptr [2 x i32], ptr %stack.ptr_7, i32 0, i32 0
%17 = getelementptr [2 x i32], ptr %15, i32 0, i32 1
%18 = load i32, ptr %17
store i32 %18, ptr %16
%19 = getelementptr [2 x i32], ptr %stack.ptr_7, i32 0, i32 1
store i32 0, ptr %19
%20 = getelementptr [2 x i32], ptr %stack.ptr_8, i32 0, i32 0
%21 = getelementptr [2 x i32], ptr %15, i32 0, i32 1
%22 = load i32, ptr %21
store i32 %22, ptr %20
%23 = getelementptr [2 x i32], ptr %stack.ptr_8, i32 0, i32 1
store i32 4294967295, ptr %23
%24 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_lower_bound_0(ptr %24, ptr %stack.ptr_7, ptr %stack.ptr_9)
%25 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_upper_bound_0(ptr %25, ptr %stack.ptr_8, ptr %stack.ptr_10)
br label %loop_2
loop_2:
%26 = call ccc i1 @eclair_btree_iterator_is_equal_0(ptr %stack.ptr_9, ptr %stack.ptr_10)
br i1 %26, label %if_1, label %end_if_1
if_1:
br label %range_query.end_1
end_if_1:
%27 = call ccc ptr @eclair_btree_iterator_current_0(ptr %stack.ptr_9)
%28 = getelementptr [2 x i32], ptr %stack.ptr_11, i32 0, i32 0
%29 = getelementptr [2 x i32], ptr %15, i32 0, i32 0
%30 = load i32, ptr %29
store i32 %30, ptr %28
%31 = getelementptr [2 x i32], ptr %stack.ptr_11, i32 0, i32 1
%32 = getelementptr [2 x i32], ptr %27, i32 0, i32 1
%33 = load i32, ptr %32
store i32 %33, ptr %31
%34 = getelementptr %program, ptr %arg_0, i32 0, i32 4
%35 = call ccc i1 @eclair_btree_contains_0(ptr %34, ptr %stack.ptr_11)
%36 = select i1 %35, i1 0, i1 1
br i1 %36, label %if_2, label %end_if_2
if_2:
%37 = getelementptr [2 x i32], ptr %stack.ptr_12, i32 0, i32 0
%38 = getelementptr [2 x i32], ptr %15, i32 0, i32 0
%39 = load i32, ptr %38
store i32 %39, ptr %37
%40 = getelementptr [2 x i32], ptr %stack.ptr_12, i32 0, i32 1
%41 = getelementptr [2 x i32], ptr %27, i32 0, i32 1
%42 = load i32, ptr %41
store i32 %42, ptr %40
%43 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%44 = call ccc i1 @eclair_btree_insert_value_0(ptr %43, ptr %stack.ptr_12)
br label %end_if_2
end_if_2:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_9)
br label %loop_2
range_query.end_1:
call ccc void @eclair_btree_iterator_next_0(ptr %stack.ptr_5)
br label %loop_1
range_query.end:
%45 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%46 = call ccc i1 @eclair_btree_is_empty_0(ptr %45)
br i1 %46, label %if_3, label %end_if_3
if_3:
br label %loop.end
end_if_3:
%47 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_begin_0(ptr %47, ptr %stack.ptr_13)
%48 = getelementptr %program, ptr %arg_0, i32 0, i32 3
call ccc void @eclair_btree_end_0(ptr %48, ptr %stack.ptr_14)
%49 = getelementptr %program, ptr %arg_0, i32 0, i32 4
call ccc void @eclair_btree_insert_range_path_new_path(ptr %49, ptr %stack.ptr_13, ptr %stack.ptr_14)
%50 = getelementptr %program, ptr %arg_0, i32 0, i32 3
%51 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_swap_0(ptr %50, ptr %51)
br label %loop_0
loop.end:
ret void
}
================================================
FILE: tests/lowering/stratification.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit ra %t/program2.eclair > %t/actual_ra2.out
// RUN: diff %t/expected_ra2.out %t/actual_ra2.out
//--- program.eclair
@def a(u32) input.
@def b(u32) input.
@def c(u32).
@def d(u32).
@def e(u32) output.
@def f(u32, u32) input.
@def g(u32, u32) output.
c(x) :-
a(x),
!b(x).
d(x) :-
b(x).
e(x) :-
!c(x),
d(x).
g(x, y) :-
f(x, y).
g(x, z) :-
f(x, y),
g(y, z),
!d(x).
//--- expected_ra.out
search f as f0 do
project (f0[0], f0[1]) into g
search b as b0 do
project (b0[0]) into d
merge g delta_g
loop do
purge new_g
search f as f0 do
if (f0[0]) ∉ d do
search delta_g as delta_g1 where (f0[1] = delta_g1[0]) do
if (f0[0], delta_g1[1]) ∉ g do
project (f0[0], delta_g1[1]) into new_g
exit if counttuples(new_g) = 0
merge new_g g
swap new_g delta_g
search a as a0 do
if (a0[0]) ∉ b do
project (a0[0]) into c
search d as d0 do
if (d0[0]) ∉ c do
project (d0[0]) into e
//--- program2.eclair
@def a(u32, string) input.
@def b(u32, string, u32, u32) input.
@def c(u32, string) input.
@def d(u32, u32) input.
@def e(u32, u32).
@def f(u32, string) output.
e(x, y) :-
d(x, y),
c(y, _).
e(x, y) :-
e(x, z),
e(x, a),
b(y, _, z, a).
f(x, y) :-
e(x, z),
a(z, y).
//--- expected_ra2.out
search d as d0 do
search c as c1 do
if d0[1] = c1[0] do
project (d0[0], d0[1]) into e
merge e delta_e
loop do
purge new_e
parallel do
search delta_e as delta_e0 do
search e as e1 do
search b as b2 do
if (delta_e0[0], e1[1]) ∉ delta_e do
if e1[1] = b2[3] do
if delta_e0[0] = e1[0] do
if delta_e0[1] = b2[2] do
if (delta_e0[0], b2[0]) ∉ e do
project (delta_e0[0], b2[0]) into new_e
search e as e0 do
search delta_e as delta_e1 do
search b as b2 do
if delta_e1[1] = b2[3] do
if e0[0] = delta_e1[0] do
if e0[1] = b2[2] do
if (e0[0], b2[0]) ∉ e do
project (e0[0], b2[0]) into new_e
exit if counttuples(new_e) = 0
merge new_e e
swap new_e delta_e
search e as e0 do
search a as a1 do
if e0[1] = a1[0] do
project (e0[0], a1[1]) into f
================================================
FILE: tests/lowering/top_level_facts.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair > %t/actual_ra.out
// RUN: diff %t/expected_ra.out %t/actual_ra.out
// RUN: %eclair compile --emit eir %t/program.eclair > %t/actual_eir.out
// RUN: diff %t/expected_eir.out %t/actual_eir.out
// RUN: %eclair compile --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_init" > %t/actual_eclair_program_init_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_destroy" > %t/actual_eclair_program_destroy_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "@eclair_program_run" > %t/actual_eclair_program_run_llvm.out
// RUN: diff %t/expected_eclair_program_init_llvm.out %t/actual_eclair_program_init_llvm.out
// RUN: diff %t/expected_eclair_program_destroy_llvm.out %t/actual_eclair_program_destroy_llvm.out
// RUN: diff %t/expected_eclair_program_run_llvm.out %t/actual_eclair_program_run_llvm.out
//--- program.eclair
@def edge(u32, u32) output.
@def another(u32, u32, u32) output.
edge(1, 2).
edge(2, 3).
another(1,2,3).
//--- expected_ra.out
project (1, 2, 3) into another
project (2, 3) into edge
project (1, 2) into edge
//--- expected_eir.out
declare_type Program
{
symbol_table
another btree(num_columns=3, index=[0,1,2], block_size=256, search_type=linear)
edge btree(num_columns=2, index=[0,1], block_size=256, search_type=linear)
}
export fn eclair_program_init() -> *Program
{
program = heap_allocate_program
symbol_table.init(program.0)
another.init_empty(program.1)
edge.init_empty(program.2)
symbol_table.insert(program.0, "edge")
symbol_table.insert(program.0, "another")
return program
}
export fn eclair_program_destroy(*Program) -> Void
{
symbol_table.destroy(FN_ARG[0].0)
another.destroy(FN_ARG[0].1)
edge.destroy(FN_ARG[0].2)
free_program(FN_ARG[0])
}
export fn eclair_program_run(*Program) -> Void
{
value = another.stack_allocate Value
value.0 = 1
value.1 = 2
value.2 = 3
another.insert(FN_ARG[0].1, value)
value_1 = edge.stack_allocate Value
value_1.0 = 2
value_1.1 = 3
edge.insert(FN_ARG[0].2, value_1)
value_2 = edge.stack_allocate Value
value_2.0 = 1
value_2.1 = 2
edge.insert(FN_ARG[0].2, value_2)
}
//--- expected_eclair_program_init_llvm.out
define external ccc ptr @eclair_program_init() "wasm-export-name"="eclair_program_init" {
start:
%stack.ptr_0 = alloca %symbol_t, i32 1
%stack.ptr_1 = alloca %symbol_t, i32 1
%0 = call ccc ptr @malloc(i32 1592)
%1 = getelementptr %program, ptr %0, i32 0, i32 0
call ccc void @eclair_symbol_table_init(ptr %1)
%2 = getelementptr %program, ptr %0, i32 0, i32 1
call ccc void @eclair_btree_init_empty_0(ptr %2)
%3 = getelementptr %program, ptr %0, i32 0, i32 2
call ccc void @eclair_btree_init_empty_1(ptr %3)
%4 = getelementptr %program, ptr %0, i32 0, i32 0
%5 = getelementptr inbounds [5 x i8], ptr @string_literal_0, i32 0, i32 0
%6 = zext i32 4 to i64
%7 = call ccc ptr @malloc(i32 4)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %7, ptr %5, i64 %6, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_0, i32 4, ptr %7)
%8 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %4, ptr %stack.ptr_0)
%9 = getelementptr %program, ptr %0, i32 0, i32 0
%10 = getelementptr inbounds [8 x i8], ptr @string_literal_1, i32 0, i32 0
%11 = zext i32 7 to i64
%12 = call ccc ptr @malloc(i32 7)
call ccc void @llvm.memcpy.p0i8.p0i8.i64(ptr %12, ptr %10, i64 %11, i1 0)
call ccc void @eclair_symbol_init(ptr %stack.ptr_1, i32 7, ptr %12)
%13 = call ccc i32 @eclair_symbol_table_find_or_insert(ptr %9, ptr %stack.ptr_1)
ret ptr %0
}
//--- expected_eclair_program_destroy_llvm.out
define external ccc void @eclair_program_destroy(ptr %arg_0) "wasm-export-name"="eclair_program_destroy" {
start:
%0 = getelementptr %program, ptr %arg_0, i32 0, i32 0
call ccc void @eclair_symbol_table_destroy(ptr %0)
%1 = getelementptr %program, ptr %arg_0, i32 0, i32 1
call ccc void @eclair_btree_destroy_0(ptr %1)
%2 = getelementptr %program, ptr %arg_0, i32 0, i32 2
call ccc void @eclair_btree_destroy_1(ptr %2)
call ccc void @free(ptr %arg_0)
ret void
}
//--- expected_eclair_program_run_llvm.out
define external ccc void @eclair_program_run(ptr %arg_0) "wasm-export-name"="eclair_program_run" {
start:
%stack.ptr_0 = alloca [3 x i32], i32 1
%stack.ptr_1 = alloca [2 x i32], i32 1
%stack.ptr_2 = alloca [2 x i32], i32 1
%0 = getelementptr [3 x i32], ptr %stack.ptr_0, i32 0, i32 0
store i32 1, ptr %0
%1 = getelementptr [3 x i32], ptr %stack.ptr_0, i32 0, i32 1
store i32 2, ptr %1
%2 = getelementptr [3 x i32], ptr %stack.ptr_0, i32 0, i32 2
store i32 3, ptr %2
%3 = getelementptr %program, ptr %arg_0, i32 0, i32 1
%4 = call ccc i1 @eclair_btree_insert_value_0(ptr %3, ptr %stack.ptr_0)
%5 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 0
store i32 2, ptr %5
%6 = getelementptr [2 x i32], ptr %stack.ptr_1, i32 0, i32 1
store i32 3, ptr %6
%7 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%8 = call ccc i1 @eclair_btree_insert_value_1(ptr %7, ptr %stack.ptr_1)
%9 = getelementptr [2 x i32], ptr %stack.ptr_2, i32 0, i32 0
store i32 1, ptr %9
%10 = getelementptr [2 x i32], ptr %stack.ptr_2, i32 0, i32 1
store i32 2, ptr %10
%11 = getelementptr %program, ptr %arg_0, i32 0, i32 2
%12 = call ccc i1 @eclair_btree_insert_value_1(ptr %11, ptr %stack.ptr_2)
ret void
}
================================================
FILE: tests/lowering/wasm_codegen.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile --target wasm32 --emit llvm %t/program.eclair > %t/actual_llvm.out
// RUN: %extract_snippet %t/actual_llvm.out "define.*@memcmp_wasm32" > %t/actual_wasm_memcmp.out
// RUN: diff %t/expected_wasm_memcmp.out %t/actual_wasm_memcmp.out
//--- program.eclair
@def edge(u32, u32) output.
@def another(u32, u32, u32) output.
edge(1, 2).
another(1,2,3).
//--- expected_wasm_memcmp.out
define external ccc i32 @memcmp_wasm32(ptr %array1_0, ptr %array2_0, i64 %byte_count_0) {
start:
%0 = udiv i64 %byte_count_0, 8
%1 = and i64 %byte_count_0, 7
br label %for_begin_0
for_begin_0:
%2 = phi i64 [0, %start], [%9, %end_if_0]
%3 = icmp ult i64 %2, %0
br i1 %3, label %for_body_0, label %for_end_0
for_body_0:
%4 = getelementptr i64, ptr %array1_0, i64 %2
%5 = getelementptr i64, ptr %array2_0, i64 %2
%6 = load i64, ptr %4
%7 = load i64, ptr %5
%8 = icmp ne i64 %6, %7
br i1 %8, label %if_0, label %end_if_0
if_0:
ret i32 1
end_if_0:
%9 = add i64 1, %2
br label %for_begin_0
for_end_0:
%10 = mul i64 %0, 8
br label %for_begin_1
for_begin_1:
%11 = phi i64 [0, %for_end_0], [%19, %end_if_1]
%12 = icmp ult i64 %11, %1
br i1 %12, label %for_body_1, label %for_end_1
for_body_1:
%13 = add i64 %11, %10
%14 = getelementptr i8, ptr %array1_0, i64 %13
%15 = getelementptr i8, ptr %array2_0, i64 %13
%16 = load i8, ptr %14
%17 = load i8, ptr %15
%18 = icmp ne i8 %16, %17
br i1 %18, label %if_1, label %end_if_1
if_1:
ret i32 1
end_if_1:
%19 = add i64 1, %11
br label %for_begin_1
for_end_1:
ret i32 0
}
================================================
FILE: tests/parser/error_recovery.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile --emit ra-transformed %t/program.eclair 2> %t/actual_output
// RUN: diff -w %t/expected_output %t/actual_output
//--- program.eclair
@def edge(u32,).
@def path(u32, u32) output.
@def broken.
edge(1, 2).
path(x, y) :
edge(x, y).
path(x, y) :-
edge(x, z),
path(z, y).
edge(2, 3).
//--- expected_output
[error]: Failed to parse file
╭──▶ TEST_DIR/program.eclair@1:15-1:16
│
1 │ @def edge(u32,).
• ┬
• ├╸ unexpected ").@de"
• ╰╸ expecting field name or type
─────╯
[error]: Failed to parse file
╭──▶ TEST_DIR/program.eclair@3:12-3:13
│
3 │ @def broken.
• ┬
• ├╸ unexpected '.'
• ╰╸ expecting '(' or rest of identifier
─────╯
[error]: Failed to parse file
╭──▶ TEST_DIR/program.eclair@7:12-7:13
│
7 │ path(x, y) :
• ┬
• ├╸ unexpected ":"
• ╰╸ expecting ":-" or '.'
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@10:6-10:7
│
10 │ ╭┤ path(x, y) :-
• │ ┬
• │ ╰╸ The variable 'x' is ungrounded, meaning it is not directly bound as an argument to a relation.
11 │ │ edge(x, z),
12 │ ├┤ path(z, y).
• │
• ╰╸ This contains no clauses that refer to 'x'.
•
│ Hint: Use the variable 'x' as an argument in a relation.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@5:1-5:12
│
5 │ edge(1, 2).
• ┬──────────
• ╰╸ Could not find a type definition for 'edge'.
•
│ Hint: Add a type definition for 'edge'.
│ Hint: Add an extern definition for 'edge'.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@11:3-11:13
│
11 │ edge(x, z),
• ┬─────────
• ╰╸ Could not find a type definition for 'edge'.
•
│ Hint: Add a type definition for 'edge'.
│ Hint: Add an extern definition for 'edge'.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@14:1-14:12
│
14 │ edge(2, 3).
• ┬──────────
• ╰╸ Could not find a type definition for 'edge'.
•
│ Hint: Add a type definition for 'edge'.
│ Hint: Add an extern definition for 'edge'.
─────╯
================================================
FILE: tests/parser/file_not_found.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile foo.eclair 2> %t/actual_output
// RUN: diff -w %t/expected_output %t/actual_output
//--- expected_output
File not found: foo.eclair.
================================================
FILE: tests/parser/valid.eclair
================================================
// RUN: %eclair compile --emit ra-transformed %s | FileCheck %s
// CHECK: project
// u32
@def fact1(u32) output.
@def fact2(u32, u32, u32) output.
@def fact3 ( u32 , u32 ) output.
fact3(0, 1).
fact3(2, 3).
fact2(1,2,3).
// strings
@def fact4(string) output.
@def fact5(u32, string) output.
@def fact6(string , string,string ) output .
fact4("").
fact4("a").
fact4( "b" ).
fact6( "c" , "d","e" ).
fact4("\"\n\r\t\b\f\v\0").
// NOTE: rules and assignments are tested implicitly in other tests
// mix of everything
@def edge(field1: u32, field2: u32) input.
@def path(u32, only_one_named_field: u32) output.
@def literals_in_rule(u32) output.
edge(1, 2).
edge(2, 3).
path(x, y) :-
edge(x, y).
path(x, y) :-
edge(x, z),
path(z, y).
// This also checks for potential naming collisions
@def u32(u32) input.
@def string(string) input.
@def mix(u32, string) input.
literals_in_rule(789) :-
u32( 123 ),
string( "abc"),
mix(456, "def").
@def constraints(u32).
constraints(x) :-
u32(x),
x < 100,
x <= 100,
100 > x,
100 >= x,
100 != x.
@def arithmetic(u32).
arithmetic(x) :-
u32(x),
x = 1 + 2 * (7 / 4),
1 + 2 - 0 < x.
arithmetic(123 + 456 * 789).
@extern constraint(string).
@extern func(u32) u32.
@extern func2(u32, u32) string.
@def test_externs(u32).
test_externs(func(123)).
test_externs(x) :-
edge(x, y),
func(y) + 1 = x,
x = func(y) + y,
func(x) = func(y).
@extern func_with_named_fields(field1: u32, field2: u32) string.
@extern constraint_with_named_field(u32, another_field: u32).
@def test_negation(u32).
test_negation(x) :-
edge(x, x),
!edge(1, 2),
edge(123, x).
// TODO: failure cases, more thorough testing in general
================================================
FILE: tests/runtime/hashmap_test.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile %t/program.eclair > %t/program.ll
// RUN: %clang -O0 -o %t/program %t/main.c %t/program.ll
// RUN: %t/program
//--- program.eclair
@def fact(u32) output.
//--- main.c
#include
#include
#include
#include
#include
typedef uint32_t u32;
typedef struct symbol {
u32 size;
char *data;
} __attribute__((packed)) symbol_t;
typedef struct entry {
symbol_t symbol;
u32 value;
} entry_t;
typedef struct bucket {
entry_t *start;
entry_t *end;
u32 capacity;
} bucket_t;
typedef struct hashmap {
bucket_t buckets[64];
} eclair_hashmap_t;
static void ASSERT(bool result, const char *msg) {
if (!result) {
printf("Assertion failed: %s\n", msg);
exit(1);
}
}
extern void eclair_hashmap_init(void *map);
extern void eclair_hashmap_destroy(void *map);
extern u32 eclair_hashmap_get_or_put_value(void *map, void *key, u32 value);
extern bool eclair_hashmap_contains(void *map, void *key);
extern u32 eclair_hashmap_lookup(void *map, void *key);
static void test_eclair_hashmap_init() {
eclair_hashmap_t map;
eclair_hashmap_init(&map);
eclair_hashmap_destroy(&map);
}
static void test_eclair_hashmap_collisions() {
eclair_hashmap_t map;
eclair_hashmap_init(&map);
// NOTE: these 2 create a collision
symbol_t symbol1 = {.size = 1, .data = "<"};
symbol_t symbol2 = {.size = 1, .data = "|"};
eclair_hashmap_get_or_put_value(&map, &symbol1, 0);
eclair_hashmap_get_or_put_value(&map, &symbol2, 1);
u32 hash = 60; // 60 % 64 or 124 % 64 = 60
printf("%s, %s\n", map.buckets[hash].start[0].symbol.data, symbol1.data);
ASSERT(map.buckets[hash].start[0].symbol.data == symbol1.data,
"Unexpected symbol1 in hashmap");
ASSERT(map.buckets[hash].start[0].value == 0, "Unexpected value1 in hashmap");
ASSERT(map.buckets[hash].start[1].symbol.data == symbol2.data,
"Unexpected symbol2 in hashmap");
ASSERT(map.buckets[hash].start[1].value == 1, "Unexpected value2 in hashmap");
eclair_hashmap_destroy(&map);
}
static void test_eclair_hashmap_get_or_put_value() {
eclair_hashmap_t map;
eclair_hashmap_init(&map);
// NOTE: these 2 create a collision
symbol_t symbol1 = {.size = 1, .data = "<"};
symbol_t symbol2 = {.size = 1, .data = "|"};
// non-existing value => adds new value
u32 result1 = eclair_hashmap_get_or_put_value(&map, &symbol1, 0);
u32 result2 = eclair_hashmap_get_or_put_value(&map, &symbol2, 1);
ASSERT(result1 == 0, "Unexpected result from eclair_hashmap_get_or_put_value");
ASSERT(result2 == 1, "Unexpected result from eclair_hashmap_get_or_put_value");
// existing value => finds existing value
u32 result3 = eclair_hashmap_get_or_put_value(&map, &symbol1, 2);
u32 result4 = eclair_hashmap_get_or_put_value(&map, &symbol2, 3);
ASSERT(result1 == 0, "Unexpected result from eclair_hashmap_get_or_put_value");
ASSERT(result2 == 1, "Unexpected result from eclair_hashmap_get_or_put_value");
eclair_hashmap_destroy(&map);
}
static void test_eclair_hashmap_contains() {
eclair_hashmap_t map;
eclair_hashmap_init(&map);
// NOTE: these 2 create a collision
symbol_t symbol1 = {.size = 1, .data = "<"};
symbol_t symbol2 = {.size = 1, .data = "|"};
eclair_hashmap_get_or_put_value(&map, &symbol1, 0);
eclair_hashmap_get_or_put_value(&map, &symbol2, 1);
ASSERT(eclair_hashmap_contains(&map, &symbol1), "Expected to find symbol1!");
ASSERT(eclair_hashmap_contains(&map, &symbol2), "Expected to find symbol2!");
symbol_t symbol3 = {.size = 1, .data = "a"};
ASSERT(!eclair_hashmap_contains(&map, &symbol3), "Expected not to find symbol3!");
eclair_hashmap_destroy(&map);
}
static void test_eclair_hashmap_lookup() {
// NOTE: can't be used for value not present in map!
eclair_hashmap_t map;
eclair_hashmap_init(&map);
// NOTE: these 2 create a collision
symbol_t symbol1 = {.size = 1, .data = "<"};
symbol_t symbol2 = {.size = 1, .data = "|"};
eclair_hashmap_get_or_put_value(&map, &symbol1, 0);
eclair_hashmap_get_or_put_value(&map, &symbol2, 1);
symbol_t symbol3 = {.size = 1, .data = "a"};
eclair_hashmap_get_or_put_value(&map, &symbol3, 2);
ASSERT(eclair_hashmap_lookup(&map, &symbol1) == 0, "Expected to find symbol1!");
ASSERT(eclair_hashmap_lookup(&map, &symbol2) == 1, "Expected to find symbol2!");
ASSERT(eclair_hashmap_lookup(&map, &symbol3) == 2, "Expected to find symbol3!");
eclair_hashmap_destroy(&map);
}
int main(int argc, char **argv) {
printf("Starting tests..\n");
test_eclair_hashmap_init();
printf("hashmap init: OK!\n");
test_eclair_hashmap_collisions();
printf("hashmap collisions: OK!\n");
test_eclair_hashmap_get_or_put_value();
printf("hashmap get or put value: OK!\n");
test_eclair_hashmap_contains();
printf("hashmap contains: OK!\n");
test_eclair_hashmap_lookup();
printf("Hashmap: all good!\n");
return 0;
}
================================================
FILE: tests/runtime/symbol_table_test.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile %t/program.eclair > %t/program.ll
// RUN: %clang -O0 -o %t/program %t/main.c %t/program.ll
// RUN: %t/program
//--- program.eclair
@def fact(u32) output.
//--- main.c
#include
#include
#include
#include
#include
// NOTE: strings need to be malloc'ed / strdup'ed since they get freed
// when calling eclair_symbol_table_destroy
typedef uint32_t u32;
typedef struct symbol {
u32 size;
char *data;
} __attribute__((packed)) symbol_t;
typedef symbol_t elem_t;
typedef struct vector {
elem_t *start;
elem_t *end;
uint32_t capacity;
} eclair_vector_t;
typedef struct entry {
symbol_t symbol;
u32 value;
} entry_t;
typedef struct bucket {
entry_t *start;
entry_t *end;
u32 capacity;
} bucket_t;
typedef struct hashmap {
bucket_t buckets[64];
} eclair_hashmap_t;
typedef struct symbol_table {
eclair_vector_t idx2sym;
eclair_hashmap_t sym2idx;
} eclair_symbol_table_t;
extern void eclair_symbol_table_init(eclair_symbol_table_t *table);
extern void eclair_symbol_table_destroy(eclair_symbol_table_t *table);
extern u32 eclair_symbol_table_find_or_insert(eclair_symbol_table_t *table, symbol_t *symbol);
extern bool eclair_symbol_table_contains_index(eclair_symbol_table_t *table, u32 index);
extern bool eclair_symbol_table_contains_symbol(eclair_symbol_table_t *table,
symbol_t *symbol);
extern u32 eclair_symbol_table_lookup_index(eclair_symbol_table_t *table, symbol_t *symbol);
extern symbol_t *eclair_symbol_table_lookup_symbol(eclair_symbol_table_t *table, u32 index);
static void ASSERT(bool result, const char *msg) {
if (!result) {
printf("Assertion failed: %s\n", msg);
exit(1);
}
}
static void test_eclair_symbol_table_init() {
eclair_symbol_table_t table;
eclair_symbol_table_init(&table);
eclair_symbol_table_destroy(&table);
}
static void test_eclair_symbol_table_find_or_insert() {
// NOTE: hash collisions are checked on hashmap level
eclair_symbol_table_t table;
eclair_symbol_table_init(&table);
symbol_t symbol1 = {.size = 1, .data = strdup("a")};
symbol_t symbol2 = {.size = 1, .data = strdup("b")};
symbol_t symbol3 = {.size = 1, .data = strdup("c")};
u32 index1 = eclair_symbol_table_find_or_insert(&table, &symbol1);
u32 index2 = eclair_symbol_table_find_or_insert(&table, &symbol2);
u32 index3 = eclair_symbol_table_find_or_insert(&table, &symbol3);
ASSERT(index1 == 0, "Received unexpected index for symbol1!");
ASSERT(index2 == 1, "Received unexpected index for symbol2!");
ASSERT(index3 == 2, "Received unexpected index for symbol3!");
u32 index4 = eclair_symbol_table_find_or_insert(&table, &symbol1);
ASSERT(index4 == 0, "Received unexpected index for symbol1!");
eclair_symbol_table_destroy(&table);
}
static void test_eclair_symbol_table_contains_index() {
eclair_symbol_table_t table;
eclair_symbol_table_init(&table);
symbol_t symbol = {.size = 1, .data = strdup("a")};
u32 index = eclair_symbol_table_find_or_insert(&table, &symbol);
ASSERT(eclair_symbol_table_contains_index(&table, index),
"Expected to find symbol for known index!");
u32 unknown_index = 42;
ASSERT(!eclair_symbol_table_contains_index(&table, unknown_index),
"Expected not to find symbol for known index!");
eclair_symbol_table_destroy(&table);
}
static void test_eclair_symbol_table_contains_symbol() {
eclair_symbol_table_t table;
eclair_symbol_table_init(&table);
symbol_t symbol = {.size = 1, .data = strdup("a")};
eclair_symbol_table_find_or_insert(&table, &symbol);
ASSERT(eclair_symbol_table_contains_symbol(&table, &symbol),
"Expected to find symbol!");
symbol_t not_added = {.size = 1, .data = "b"};
ASSERT(!eclair_symbol_table_contains_symbol(&table, ¬_added),
"Did not expect to find symbol!");
eclair_symbol_table_destroy(&table);
}
static void test_eclair_symbol_table_lookup_index() {
eclair_symbol_table_t table;
eclair_symbol_table_init(&table);
symbol_t symbol1 = {.size = 1, .data = strdup("a")};
symbol_t symbol2 = {.size = 1, .data = strdup("b")};
eclair_symbol_table_find_or_insert(&table, &symbol1);
eclair_symbol_table_find_or_insert(&table, &symbol2);
u32 index1 = eclair_symbol_table_lookup_index(&table, &symbol1);
u32 index2 = eclair_symbol_table_lookup_index(&table, &symbol2);
ASSERT(index1 == 0, "Expected to find index for symbol1!");
ASSERT(index2 == 1, "Expected to find index for symbol2!");
// This should not occur in Datalog!
// symbol_t not_added = {.size = 1, .data = "c"};
// u32 missing_index = eclair_symbol_table_lookup_symbol(&table, ¬_added);
// ASSERT(missing_index == 0xFFFFFFFF,
// "Did not expect to find index for missing symbol!");
eclair_symbol_table_destroy(&table);
}
static void test_eclair_symbol_table_lookup_symbol() {
eclair_symbol_table_t table;
eclair_symbol_table_init(&table);
symbol_t symbol1 = {.size = 1, .data = strdup("a")};
symbol_t symbol2 = {.size = 1, .data = strdup("b")};
u32 index1 = eclair_symbol_table_find_or_insert(&table, &symbol1);
u32 index2 = eclair_symbol_table_find_or_insert(&table, &symbol2);
symbol_t *symbol1_result = eclair_symbol_table_lookup_symbol(&table, index1);
symbol_t *symbol2_result = eclair_symbol_table_lookup_symbol(&table, index2);
ASSERT(strcmp(symbol1_result->data, "a") == 0,
"Expected to find index for symbol1!");
ASSERT(strcmp(symbol2_result->data, "b") == 0,
"Expected to find index for symbol2!");
// This reads uninitialized memory, no safety checks are done!
// Should not occur in a real DL program
// u32 missing = 42;
// ASSERT(strcmp(eclair_symbol_table_lookup_index(&table, missing)->data, "a") != 0,
// "Expected not to find unknown index");
eclair_symbol_table_destroy(&table);
}
int main(int argc, char **argv) {
printf("Testing symbol_table...\n");
test_eclair_symbol_table_init();
printf("eclair_symbol_table_init: OK!\n");
test_eclair_symbol_table_find_or_insert();
printf("eclair_symbol_table_find_or_insert: OK!\n");
test_eclair_symbol_table_contains_index();
printf("eclair_symbol_table_contains_index: OK!\n");
test_eclair_symbol_table_contains_symbol();
printf("eclair_symbol_table_contains_symbol: OK!\n");
test_eclair_symbol_table_lookup_symbol();
printf("eclair_symbol_table_lookup_symbol: OK!\n");
test_eclair_symbol_table_lookup_index();
printf("symbol_table: all good!\n");
return 0;
}
================================================
FILE: tests/runtime/vector_test.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile %t/program.eclair > %t/program.ll
// RUN: %clang -O0 -o %t/program %t/main.c %t/program.ll
// RUN: %t/program
//--- program.eclair
@def fact(u32) output.
//--- main.c
#include
#include
#include
#include
#include
typedef uint32_t u32;
typedef struct symbol {
u32 length;
char *data;
} __attribute__((packed)) symbol_t;
typedef symbol_t elem_t;
typedef struct vector {
elem_t *start;
elem_t *end;
uint32_t capacity;
} eclair_vector_t;
extern void eclair_vector_init_symbol(struct vector *);
extern void eclair_vector_destroy_symbol(struct vector *);
extern uint32_t eclair_vector_push_symbol(struct vector *, elem_t *);
extern uint32_t eclair_vector_size_symbol(struct vector *);
extern elem_t *eclair_vector_get_value_symbol(struct vector *, uint32_t);
void ASSERT(bool result, const char *msg) {
if (!result) {
printf("Assertion failed: %s\n", msg);
exit(1);
}
}
#define INITIAL_CAPACITY 16
#define GROW_FACTOR 2
static void test_eclair_vector_init() {
eclair_vector_t vec;
eclair_vector_init_symbol(&vec);
ASSERT(eclair_vector_size_symbol(&vec) == 0, "vector size should be 0");
ASSERT(vec.start == vec.end, "");
ASSERT(vec.capacity == INITIAL_CAPACITY,
"vector capacity should be INITIAL_CAPACITY");
eclair_vector_destroy_symbol(&vec);
}
static void test_eclair_vector_single_push() {
eclair_vector_t vec;
eclair_vector_init_symbol(&vec);
ASSERT(eclair_vector_size_symbol(&vec) == 0, "Unexpected size before!");
// strdup needed since the vector frees symbols
symbol_t symbol = {.data = strdup("some_symbol")};
u32 idx = eclair_vector_push_symbol(&vec, &symbol);
ASSERT(eclair_vector_size_symbol(&vec) == 1, "Unexpected size after!");
eclair_vector_destroy_symbol(&vec);
}
static void test_eclair_vector_push() {
eclair_vector_t vec;
eclair_vector_init_symbol(&vec);
for (u32 i = 0; i < INITIAL_CAPACITY; ++i) {
// strdup needed since the vector frees symbols
symbol_t symbol = {.data = strdup("some_symbol")};
ASSERT(eclair_vector_size_symbol(&vec) == i, "Unexpected size before!");
u32 idx = eclair_vector_push_symbol(&vec, &symbol);
ASSERT(idx == i, "Unexpected index!");
ASSERT(eclair_vector_size_symbol(&vec) == i + 1, "Unexpected size after!");
ASSERT(vec.capacity == INITIAL_CAPACITY, "Unexpected capacity");
}
ASSERT(eclair_vector_size_symbol(&vec) == INITIAL_CAPACITY,
"Unexpected size before resize!");
symbol_t symbol = {.data = strdup("final_symbol")};
u32 idx = eclair_vector_push_symbol(&vec, &symbol);
ASSERT(idx == INITIAL_CAPACITY, "Unexpected index!");
ASSERT(eclair_vector_size_symbol(&vec) == INITIAL_CAPACITY + 1,
"Unexpected size after resize!");
ASSERT(vec.capacity == GROW_FACTOR * INITIAL_CAPACITY, "Unexpected capacity");
eclair_vector_destroy_symbol(&vec);
}
static void test_eclair_vector_resize() {
eclair_vector_t vec;
eclair_vector_init_symbol(&vec);
ASSERT(vec.capacity == INITIAL_CAPACITY, "Unexpected capacity");
for (u32 i = 0; i < 2 * INITIAL_CAPACITY; ++i) {
// strdup needed since the vector frees symbols
symbol_t symbol = {.data = strdup("some_symbol")};
u32 idx = eclair_vector_push_symbol(&vec, &symbol);
}
ASSERT(vec.capacity == GROW_FACTOR * INITIAL_CAPACITY, "Unexpected capacity");
for (u32 i = 0; i < 2 * INITIAL_CAPACITY; ++i) {
// strdup needed since the vector frees symbols
symbol_t symbol = {.data = strdup("some_symbol")};
u32 idx = eclair_vector_push_symbol(&vec, &symbol);
}
ASSERT(vec.capacity == GROW_FACTOR * GROW_FACTOR * INITIAL_CAPACITY,
"Unexpected capacity");
eclair_vector_destroy_symbol(&vec);
}
int main(int argc, char **argv) {
printf("Start tests..\n");
test_eclair_vector_init();
printf("eclair_vector_init: OK!\n");
test_eclair_vector_single_push();
printf("eclair_vector_single_push: OK!\n");
test_eclair_vector_push();
printf("eclair_vector_push: OK!\n");
test_eclair_vector_resize();
printf("Vector: all good!\n");
return 0;
}
================================================
FILE: tests/semantic_analysis/cyclic_negation.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program1.eclair 2> %t/actual1.out
// RUN: diff -w %t/expected1.out %t/actual1.out
//--- program1.eclair
@def a(u32) input.
@def b(u32) output.
@def c(u32) input.
@def d(u32) output.
@def e(u32) input.
@def f(u32) input.
@def g(u32) output.
b(x) :-
a(x),
!b(x).
d(x) :-
c(x),
!d(x).
d(x) :-
!c(x),
d(x).
g(x) :-
f(x).
f(x) :-
e(x),
!g(x).
//--- expected1.out
[error]: Negation used in recursive set of rules
╭──▶ TEST_DIR/program1.eclair@11:3-11:8
│
11 │ !b(x).
• ┬────
• ╰╸ This negation is used in a set of rules that is recursive, which is not allowed.
•
│ Hint: Restructure the program so the negation does not occur in the set of recursive rules.
│ Hint: Remove the negation entirely.
─────╯
[error]: Negation used in recursive set of rules
╭──▶ TEST_DIR/program1.eclair@15:3-15:8
│
15 │ !d(x).
• ┬────
• ╰╸ This negation is used in a set of rules that is recursive, which is not allowed.
•
│ Hint: Restructure the program so the negation does not occur in the set of recursive rules.
│ Hint: Remove the negation entirely.
─────╯
[error]: Negation used in recursive set of rules
╭──▶ TEST_DIR/program1.eclair@26:3-26:8
│
26 │ !g(x).
• ┬────
• ╰╸ This negation is used in a set of rules that is recursive, which is not allowed.
•
│ Hint: Restructure the program so the negation does not occur in the set of recursive rules.
│ Hint: Remove the negation entirely.
─────╯
================================================
FILE: tests/semantic_analysis/dead_internal_relation.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair --emit ra-transformed 2> %t/actual.out
// RUN: diff %t/expected.out %t/actual.out
//--- program.eclair
@def fact(u32).
@def fact2(u32) output.
@def internal_rule(u32).
internal_rule(x) :-
x = 1.
//--- expected.out
[error]: Dead internal relation
╭──▶ TEST_DIR/program.eclair@1:1-1:16
│
1 │ @def fact(u32).
• ┬──────────────
• ╰╸ The internal rule 'fact' has no facts or rules defined and will never produce results.
•
│ Hint: This might indicate a logic error in your code.
│ Hint: Remove this rule if it is no longer needed.
│ Hint: Add 'input' to the declaration to indicate this rule is an input.
─────╯
================================================
FILE: tests/semantic_analysis/invalid_extern_usage.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
//--- program1.eclair
// RUN: %eclair compile --emit ra-transformed %t/program1.eclair 2> %t/program1.out
// RUN: diff -w %t/expected1.out %t/program1.out
@def edge(u32, u32) input.
@def test_externs(u32) output.
@extern constraint1(string).
@extern func1(u32) u32.
@extern func2(u32, u32) string.
// Duplicate externs / functions
@extern constraint1(string).
@extern func1(string).
@def func2(u32) output.
// Usage of externs as facts
constraint1("abc").
func1(123).
// Usage of externs as rules
@extern constraint2(u32).
@extern func3(u32) u32.
@extern func4(u32, u32) u32.
constraint2(x) :- edge(x, 123).
func3(x) :- edge(x, 123).
// Invalid wildcards in extern constraints / functions
test_externs(x) :-
edge(x, func3(_)),
edge(x, func4(_, _)),
constraint2(_).
// Ungrounded variables
test_externs(x) :-
constraint2(x),
x = func4(x, x).
//--- expected1.out
[error]: Ungrounded variable
╭──▶ TEST_DIR/program1.eclair@35:14-35:15
│
35 │ ╭┤ test_externs(x) :-
• │ ┬
• │ ╰╸ The variable 'x' is ungrounded, meaning it is not directly bound as an argument to a relation.
36 │ │ constraint2(x),
37 │ ├┤ x = func4(x, x).
• │
• ╰╸ This contains no clauses that refer to 'x'.
•
│ Hint: Use the variable 'x' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program1.eclair@37:3-37:4
│
35 │ ╭┤ test_externs(x) :-
36 │ │ constraint2(x),
37 │ ├┤ x = func4(x, x).
• │ ┬
• │ ╰╸ The variable 'x' is ungrounded, meaning it is not directly bound as an argument to a relation.
• │
• ╰╸ This contains no clauses that refer to 'x'.
•
│ Hint: Use the variable 'x' as an argument in a relation.
─────╯
[error]: Wildcard in externally defined atom
╭──▶ TEST_DIR/program1.eclair@30:17-30:18
│
30 │ edge(x, func3(_)),
• ┬─────┬─
• │ ╰╸ Wildcard found.
• ╰╸ An external atom only supports constants or grounded variables.
•
│ Hint: Replace the wildcard with a constant or grounded variable.
─────╯
[error]: Wildcard in externally defined atom
╭──▶ TEST_DIR/program1.eclair@31:17-31:18
│
31 │ edge(x, func4(_, _)),
• ┬─────┬────
• │ ╰╸ Wildcard found.
• ╰╸ An external atom only supports constants or grounded variables.
•
│ Hint: Replace the wildcard with a constant or grounded variable.
─────╯
[error]: Wildcard in externally defined atom
╭──▶ TEST_DIR/program1.eclair@31:20-31:21
│
31 │ edge(x, func4(_, _)),
• ┬────────┬─
• │ ╰╸ Wildcard found.
• ╰╸ An external atom only supports constants or grounded variables.
•
│ Hint: Replace the wildcard with a constant or grounded variable.
─────╯
[error]: Wildcard in externally defined atom
╭──▶ TEST_DIR/program1.eclair@32:15-32:16
│
32 │ constraint2(_).
• ┬───────────┬─
• │ ╰╸ Wildcard found.
• ╰╸ An external atom only supports constants or grounded variables.
•
│ Hint: Replace the wildcard with a constant or grounded variable.
─────╯
[error]: Multiple definitions for 'constraint1'
╭──▶ TEST_DIR/program1.eclair@7:1-7:29
│
7 │ @extern constraint1(string).
• ┬───────────────────────────
• ╰╸ 'constraint1' is originally defined here.
•
12 │ @extern constraint1(string).
• ┬───────────────────────────
• ╰╸ 'constraint1' is re-defined here.
•
│ Hint: You can solve this by removing the duplicate definitions for 'constraint1'.
─────╯
[error]: Multiple definitions for 'func1'
╭──▶ TEST_DIR/program1.eclair@8:1-8:24
│
8 │ @extern func1(u32) u32.
• ┬──────────────────────
• ╰╸ 'func1' is originally defined here.
•
13 │ @extern func1(string).
• ┬─────────────────────
• ╰╸ 'func1' is re-defined here.
•
│ Hint: You can solve this by removing the duplicate definitions for 'func1'.
─────╯
[error]: Multiple definitions for 'func2'
╭──▶ TEST_DIR/program1.eclair@9:1-9:32
│
9 │ @extern func2(u32, u32) string.
• ┬──────────────────────────────
• ╰╸ 'func2' is originally defined here.
•
14 │ @def func2(u32) output.
• ┬──────────────────────
• ╰╸ 'func2' is re-defined here.
•
│ Hint: You can solve this by removing the duplicate definitions for 'func2'.
─────╯
[error]: Extern definition used as top level fact
╭──▶ TEST_DIR/program1.eclair@17:1-17:20
│
7 │ @extern constraint1(string).
• ┬───────────────────────────
• ╰╸ 'constraint1' previously defined here as external.
•
17 │ constraint1("abc").
• ┬──────────────────
• ╰╸ 'constraint1' is used as a fact here, which is not allowed for extern definitions.
•
│ Hint: Convert 'constraint1' to a relation.
│ Hint: Remove the top level fact.
─────╯
[error]: Extern definition used as top level fact
╭──▶ TEST_DIR/program1.eclair@17:1-17:20
│
12 │ @extern constraint1(string).
• ┬───────────────────────────
• ╰╸ 'constraint1' previously defined here as external.
•
17 │ constraint1("abc").
• ┬──────────────────
• ╰╸ 'constraint1' is used as a fact here, which is not allowed for extern definitions.
•
│ Hint: Convert 'constraint1' to a relation.
│ Hint: Remove the top level fact.
─────╯
[error]: Extern definition used as top level fact
╭──▶ TEST_DIR/program1.eclair@18:1-18:12
│
8 │ @extern func1(u32) u32.
• ┬──────────────────────
• ╰╸ 'func1' previously defined here as external.
•
18 │ func1(123).
• ┬──────────
• ╰╸ 'func1' is used as a fact here, which is not allowed for extern definitions.
•
│ Hint: Convert 'func1' to a relation.
│ Hint: Remove the top level fact.
─────╯
[error]: Extern definition used as top level fact
╭──▶ TEST_DIR/program1.eclair@18:1-18:12
│
13 │ @extern func1(string).
• ┬─────────────────────
• ╰╸ 'func1' previously defined here as external.
•
18 │ func1(123).
• ┬──────────
• ╰╸ 'func1' is used as a fact here, which is not allowed for extern definitions.
•
│ Hint: Convert 'func1' to a relation.
│ Hint: Remove the top level fact.
─────╯
[error]: Extern definition used in rule head
╭──▶ TEST_DIR/program1.eclair@25:1-25:32
│
21 │ @extern constraint2(u32).
• ┬────────────────────────
• ╰╸ 'constraint2' previously defined here as external.
•
25 │ constraint2(x) :- edge(x, 123).
• ┬──────────────────────────────
• ╰╸ 'constraint2' is used as a rule head here, which is not allowed for extern definitions.
•
│ Hint: Convert 'constraint2' to a relation.
│ Hint: Remove the rule.
─────╯
[error]: Extern definition used in rule head
╭──▶ TEST_DIR/program1.eclair@26:1-26:26
│
22 │ @extern func3(u32) u32.
• ┬──────────────────────
• ╰╸ 'func3' previously defined here as external.
•
26 │ func3(x) :- edge(x, 123).
• ┬────────────────────────
• ╰╸ 'func3' is used as a rule head here, which is not allowed for extern definitions.
•
│ Hint: Convert 'func3' to a relation.
│ Hint: Remove the rule.
─────╯
[error]: Invalid use of function
╭──▶ TEST_DIR/program1.eclair@18:1-18:12
│
8 │ @extern func1(u32) u32.
• ┬──────────────────────
• ╰╸ Previously defined as a function here.
•
18 │ func1(123).
• ┬──────────
• ╰╸ Expected a constraint here.
•
│ Hint: Maybe you meant to declare this an external constraint instead?
│ Hint: Remove the invalid function.
─────╯
[error]: Invalid use of function
╭──▶ TEST_DIR/program1.eclair@26:1-26:26
│
22 │ @extern func3(u32) u32.
• ┬──────────────────────
• ╰╸ Previously defined as a function here.
•
26 │ func3(x) :- edge(x, 123).
• ┬────────────────────────
• ╰╸ Expected a constraint here.
•
│ Hint: Maybe you meant to declare this an external constraint instead?
│ Hint: Remove the invalid function.
─────╯
================================================
FILE: tests/semantic_analysis/invalid_options_usage.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
//--- program1.eclair
// RUN: %eclair compile %t/program1.eclair 2> %t/actual1.out
// RUN: diff %t/expected1.out %t/actual1.out
@def fact(string) input input.
@def fact2(string) output output output.
//--- expected1.out
[error]: Failed to parse file
╭──▶ TEST_DIR/program1.eclair@4:30-4:31
│
4 │ @def fact(string) input input.
• ┬
• ╰╸ More than one option of type 'input' is not allowed.
─────╯
[error]: Failed to parse file
╭──▶ TEST_DIR/program1.eclair@5:40-5:41
│
5 │ @def fact2(string) output output output.
• ┬
• ╰╸ More than one option of type 'output' is not allowed.
─────╯
================================================
FILE: tests/semantic_analysis/invalid_wildcard_usage.eclair
================================================
// NOTE: happy path is mostly skipped, this is tested implicitly by running
// the compiler end-to-end in most other tests
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program1.eclair 2> %t/top_level_facts_actual.out
// RUN: diff %t/top_level_facts_expected.out %t/top_level_facts_actual.out
//--- program1.eclair
@def a(u32, u32) output.
a(123, _).
a(_, 123).
//--- top_level_facts_expected.out
[error]: Wildcard in top level fact
╭──▶ TEST_DIR/program1.eclair@3:8-3:9
│
3 │ a(123, _).
• ┬──────┬──
• │ ╰╸ Wildcard found.
• ╰╸ A top level fact only supports constants.
• Variables or wildcards are not allowed.
•
│ Hint: Replace the wildcard with a constant.
─────╯
[error]: Wildcard in top level fact
╭──▶ TEST_DIR/program1.eclair@4:3-4:4
│
4 │ a(_, 123).
• ┬─┬───────
• │ ╰╸ Wildcard found.
• ╰╸ A top level fact only supports constants.
• Variables or wildcards are not allowed.
•
│ Hint: Replace the wildcard with a constant.
─────╯
//--- program2.eclair
// RUN: %eclair compile %t/program2.eclair 2> %t/wildcard_in_rule_head_actual.out
// RUN: diff -w %t/wildcard_in_rule_head_expected.out %t/wildcard_in_rule_head_actual.out
@def a(u32, u32) output.
@def b(u32) input.
a(x, _) :-
b(x).
a(_, x) :-
b(x).
//--- wildcard_in_rule_head_expected.out
[error]: Wildcard in 'head' of rule
╭──▶ TEST_DIR/program2.eclair@8:6-8:7
│
8 │ ╭┤ a(x, _) :-
• │ ┬
• │ ╰╸ Wildcard found.
9 │ ├┤ b(x).
• │
• ╰╸ Only constants and variables are allowed in the head of a rule.
• Wildcards are not allowed.
•
│ Hint: Replace the wildcard with a constant or a variable.
─────╯
[error]: Wildcard in 'head' of rule
╭──▶ TEST_DIR/program2.eclair@11:3-11:4
│
11 │ ╭┤ a(_, x) :-
• │ ┬
• │ ╰╸ Wildcard found.
12 │ ├┤ b(x).
• │
• ╰╸ Only constants and variables are allowed in the head of a rule.
• Wildcards are not allowed.
•
│ Hint: Replace the wildcard with a constant or a variable.
─────╯
//--- program3.eclair
// RUN: %eclair compile %t/program3.eclair 2> %t/wildcard_in_assignment_actual.out
// RUN: diff -w %t/wildcard_in_assignment_expected.out %t/wildcard_in_assignment_actual.out
@def a(u32) output.
@def b(u32) input.
a(x) :-
b(x),
_ = 123.
a(x) :-
b(x),
123 = _.
a(x) :-
b(x),
_ = _.
//--- wildcard_in_assignment_expected.out
[error]: Found wildcard in constraint
╭──▶ TEST_DIR/program3.eclair@10:3-10:4
│
10 │ _ = 123.
• ┬──────
• ├╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a constraint.
•
│ Hint: This statement can be removed since it has no effect.
│ Hint: Replace the wildcard with a variable.
─────╯
[error]: Found wildcard in constraint
╭──▶ TEST_DIR/program3.eclair@14:9-14:10
│
14 │ 123 = _.
• ┬─────┬
• │ ╰╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a constraint.
•
│ Hint: This statement can be removed since it has no effect.
│ Hint: Replace the wildcard with a variable.
─────╯
[error]: Found wildcard in constraint
╭──▶ TEST_DIR/program3.eclair@18:3-18:4
│
18 │ _ = _.
• ┬────
• ├╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a constraint.
•
│ Hint: This statement can be removed since it has no effect.
│ Hint: Replace the wildcard with a variable.
─────╯
[error]: Found wildcard in constraint
╭──▶ TEST_DIR/program3.eclair@18:7-18:8
│
18 │ _ = _.
• ┬───┬
• │ ╰╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a constraint.
•
│ Hint: This statement can be removed since it has no effect.
│ Hint: Replace the wildcard with a variable.
─────╯
//--- program4.eclair
// RUN: %eclair compile %t/program4.eclair 2> %t/wildcard_in_valid_actual.out
// RUN: diff %t/wildcard_valid_expected.out %t/wildcard_in_valid_actual.out
@def a(u32) output.
@def b(u32, u32, u32) input.
a(x) :-
b(x, _, _),
b(_, x, _),
b(_, _, x).
//--- wildcard_valid_expected.out
//--- program5.eclair
// RUN: %eclair compile %t/program5.eclair 2> %t/wildcard_in_comparison_actual.out
// RUN: diff -w %t/wildcard_in_comparison_expected.out %t/wildcard_in_comparison_actual.out
@def a(u32) output.
@def b(u32) input.
a(x) :-
b(x),
123 < _,
123 <= _,
123 > _,
123 >= _,
123 != _.
//--- wildcard_in_comparison_expected.out
[error]: Found wildcard in constraint
╭──▶ TEST_DIR/program5.eclair@10:9-10:10
│
10 │ 123 < _,
• ┬─────┬
• │ ╰╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a constraint.
•
│ Hint: This statement can be removed since it has no effect.
│ Hint: Replace the wildcard with a variable.
─────╯
[error]: Found wildcard in constraint
╭──▶ TEST_DIR/program5.eclair@11:10-11:11
│
11 │ 123 <= _,
• ┬──────┬
• │ ╰╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a constraint.
•
│ Hint: This statement can be removed since it has no effect.
│ Hint: Replace the wildcard with a variable.
─────╯
[error]: Found wildcard in constraint
╭──▶ TEST_DIR/program5.eclair@12:9-12:10
│
12 │ 123 > _,
• ┬─────┬
• │ ╰╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a constraint.
•
│ Hint: This statement can be removed since it has no effect.
│ Hint: Replace the wildcard with a variable.
─────╯
[error]: Found wildcard in constraint
╭──▶ TEST_DIR/program5.eclair@13:10-13:11
│
13 │ 123 >= _,
• ┬──────┬
• │ ╰╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a constraint.
•
│ Hint: This statement can be removed since it has no effect.
│ Hint: Replace the wildcard with a variable.
─────╯
[error]: Found wildcard in constraint
╭──▶ TEST_DIR/program5.eclair@14:10-14:11
│
14 │ 123 != _.
• ┬──────┬
• │ ╰╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a constraint.
•
│ Hint: This statement can be removed since it has no effect.
│ Hint: Replace the wildcard with a variable.
─────╯
//--- program6.eclair
// RUN: %eclair compile %t/program6.eclair 2> %t/wildcard_in_binop_actual.out
// RUN: diff -w %t/wildcard_in_binop_expected.out %t/wildcard_in_binop_actual.out
@def a(u32) output.
@def b(u32) output.
b(123 + _).
b(_ + 123).
a(x) :-
b(x),
x = 123 + _,
x = _ + 123.
//--- wildcard_in_binop_expected.out
[error]: Found wildcard in binary operation
╭──▶ TEST_DIR/program6.eclair@8:9-8:10
│
8 │ b(123 + _).
• ┬─────┬
• │ ╰╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a binary operation.
•
│ Hint: Replace the wildcard with a variable or literal.
─────╯
[error]: Found wildcard in binary operation
╭──▶ TEST_DIR/program6.eclair@9:3-9:4
│
9 │ b(_ + 123).
• ┬──────
• ├╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a binary operation.
•
│ Hint: Replace the wildcard with a variable or literal.
─────╯
[error]: Found wildcard in binary operation
╭──▶ TEST_DIR/program6.eclair@13:13-13:14
│
13 │ x = 123 + _,
• ┬─────┬
• │ ╰╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a binary operation.
•
│ Hint: Replace the wildcard with a variable or literal.
─────╯
[error]: Found wildcard in binary operation
╭──▶ TEST_DIR/program6.eclair@14:7-14:8
│
14 │ x = _ + 123.
• ┬──────
• ├╸ Wildcard found.
• ╰╸ Only constants and variables are allowed in a binary operation.
•
│ Hint: Replace the wildcard with a variable or literal.
─────╯
================================================
FILE: tests/semantic_analysis/no_output_relations.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program1.eclair 2> %t/actual1.out
// RUN: diff -w %t/expected1.out %t/actual1.out
// RUN: %eclair compile %t/program2.eclair | FileCheck %t/program2.eclair
//--- program1.eclair
@def fact(u32) input.
fact(123).
//--- expected1.out
[error]: No output relations found
╭──▶ TEST_DIR/program1.eclair@1:1-1:2
│
1 │ @def fact(u32) input.
• ┬
• ╰╸ This module does not produce any results
•
│ Hint: Add an 'output' qualifier to one of the relations defined in this module.
─────╯
//--- program2.eclair
@def fact(u32) input.
@def fact2(u32) output.
fact(123).
fact2(x) :- fact(x).
// CHECK: eclair_program_run
================================================
FILE: tests/semantic_analysis/unconstrained_variables.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def fact1(u32, u32) output.
@def fact2(u32) output.
fact2(x) :- fact1(x, 1).
fact2(2) :-
fact1(x, 2),
!fact1(2, x).
fact2(3) :-
fact1(x, 3),
fact1(3, x).
fact2(4) :-
fact1(x, 4),
x = 4.
fact2(2) :-
fact1(x, y).
//--- expected.out
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program.eclair@19:9-19:10
│
18 │ ╭┤ fact2(2) :-
19 │ ├┤ fact1(x, y).
• │ ┬
• │ ╰╸ The variable 'x' only occurs once.
• │
• ╰╸ This rule contains no other references to 'x'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program.eclair@19:12-19:13
│
18 │ ╭┤ fact2(2) :-
19 │ ├┤ fact1(x, y).
• │ ┬
• │ ╰╸ The variable 'y' only occurs once.
• │
• ╰╸ This rule contains no other references to 'y'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
================================================
FILE: tests/semantic_analysis/ungrounded_variables.eclair
================================================
// NOTE: happy path is not tested, this is tested implicitly by running
// the compiler end-to-end in most other tests
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/top_level_facts_actual.out
// RUN: diff %t/top_level_facts_expected.out %t/top_level_facts_actual.out
//--- program.eclair
@def edge(u32, u32) output.
edge(a, 1).
edge(2, b).
edge(c, d).
edge(e + 1, 1 + f).
//--- top_level_facts_expected.out
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@3:6-3:7
│
3 │ edge(a, 1).
• ┬────┬─────
• │ ╰╸ The variable 'a' is ungrounded, meaning it is not directly bound as an argument to a relation.
• ╰╸ This contains no clauses that refer to 'a'.
•
│ Hint: Use the variable 'a' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@4:9-4:10
│
4 │ edge(2, b).
• ┬───────┬──
• │ ╰╸ The variable 'b' is ungrounded, meaning it is not directly bound as an argument to a relation.
• ╰╸ This contains no clauses that refer to 'b'.
•
│ Hint: Use the variable 'b' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@5:6-5:7
│
5 │ edge(c, d).
• ┬────┬─────
• │ ╰╸ The variable 'c' is ungrounded, meaning it is not directly bound as an argument to a relation.
• ╰╸ This contains no clauses that refer to 'c'.
•
│ Hint: Use the variable 'c' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@5:9-5:10
│
5 │ edge(c, d).
• ┬───────┬──
• │ ╰╸ The variable 'd' is ungrounded, meaning it is not directly bound as an argument to a relation.
• ╰╸ This contains no clauses that refer to 'd'.
•
│ Hint: Use the variable 'd' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@6:6-6:7
│
6 │ edge(e + 1, 1 + f).
• ┬────┬─────────────
• │ ╰╸ The variable 'e' is ungrounded, meaning it is not directly bound as an argument to a relation.
• ╰╸ This contains no clauses that refer to 'e'.
•
│ Hint: Use the variable 'e' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@6:17-6:18
│
6 │ edge(e + 1, 1 + f).
• ┬───────────────┬──
• │ ╰╸ The variable 'f' is ungrounded, meaning it is not directly bound as an argument to a relation.
• ╰╸ This contains no clauses that refer to 'f'.
•
│ Hint: Use the variable 'f' as an argument in a relation.
─────╯
//--- program2.eclair
// RUN: %eclair compile %t/program2.eclair 2> %t/ungrounded_var_in_rule_actual.out
// RUN: diff -w %t/ungrounded_var_in_rule_expected.out %t/ungrounded_var_in_rule_actual.out
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
reachable(x, z) :-
edge(x, y).
reachable(a, b) :-
edge(x, y).
//--- ungrounded_var_in_rule_expected.out
[error]: Ungrounded variable
╭──▶ TEST_DIR/program2.eclair@8:14-8:15
│
8 │ ╭┤ reachable(x, z) :-
• │ ┬
• │ ╰╸ The variable 'z' is ungrounded, meaning it is not directly bound as an argument to a relation.
9 │ ├┤ edge(x, y).
• │
• ╰╸ This contains no clauses that refer to 'z'.
•
│ Hint: Use the variable 'z' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program2.eclair@11:11-11:12
│
11 │ ╭┤ reachable(a, b) :-
• │ ┬
• │ ╰╸ The variable 'a' is ungrounded, meaning it is not directly bound as an argument to a relation.
12 │ ├┤ edge(x, y).
• │
• ╰╸ This contains no clauses that refer to 'a'.
•
│ Hint: Use the variable 'a' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program2.eclair@11:14-11:15
│
11 │ ╭┤ reachable(a, b) :-
• │ ┬
• │ ╰╸ The variable 'b' is ungrounded, meaning it is not directly bound as an argument to a relation.
12 │ ├┤ edge(x, y).
• │
• ╰╸ This contains no clauses that refer to 'b'.
•
│ Hint: Use the variable 'b' as an argument in a relation.
─────╯
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program2.eclair@8:14-8:15
│
8 │ ╭┤ reachable(x, z) :-
• │ ┬
• │ ╰╸ The variable 'z' only occurs once.
9 │ ├┤ edge(x, y).
• │
• ╰╸ This rule contains no other references to 'z'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program2.eclair@9:11-9:12
│
8 │ ╭┤ reachable(x, z) :-
9 │ ├┤ edge(x, y).
• │ ┬
• │ ╰╸ The variable 'y' only occurs once.
• │
• ╰╸ This rule contains no other references to 'y'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program2.eclair@11:11-11:12
│
11 │ ╭┤ reachable(a, b) :-
• │ ┬
• │ ╰╸ The variable 'a' only occurs once.
12 │ ├┤ edge(x, y).
• │
• ╰╸ This rule contains no other references to 'a'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program2.eclair@11:14-11:15
│
11 │ ╭┤ reachable(a, b) :-
• │ ┬
• │ ╰╸ The variable 'b' only occurs once.
12 │ ├┤ edge(x, y).
• │
• ╰╸ This rule contains no other references to 'b'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program2.eclair@12:8-12:9
│
11 │ ╭┤ reachable(a, b) :-
12 │ ├┤ edge(x, y).
• │ ┬
• │ ╰╸ The variable 'x' only occurs once.
• │
• ╰╸ This rule contains no other references to 'x'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program2.eclair@12:11-12:12
│
11 │ ╭┤ reachable(a, b) :-
12 │ ├┤ edge(x, y).
• │ ┬
• │ ╰╸ The variable 'y' only occurs once.
• │
• ╰╸ This rule contains no other references to 'y'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
//--- program3.eclair
// RUN: %eclair compile %t/program3.eclair 2> %t/ungrounded_var_check_in_rule_body_actual.out
// RUN: diff -w %t/ungrounded_var_check_in_rule_body_expected.out %t/ungrounded_var_check_in_rule_body_actual.out
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
reachable(x, z) :-
edge(x, y),
reachable(y, z),
edge(a, b).
//--- ungrounded_var_check_in_rule_body_expected.out
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program3.eclair@11:8-11:9
│
8 │ ╭┤ reachable(x, z) :-
9 │ │ edge(x, y),
10 │ │ reachable(y, z),
11 │ ├┤ edge(a, b).
• │ ┬
• │ ╰╸ The variable 'a' only occurs once.
• │
• ╰╸ This rule contains no other references to 'a'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program3.eclair@11:11-11:12
│
8 │ ╭┤ reachable(x, z) :-
9 │ │ edge(x, y),
10 │ │ reachable(y, z),
11 │ ├┤ edge(a, b).
• │ ┬
• │ ╰╸ The variable 'b' only occurs once.
• │
• ╰╸ This rule contains no other references to 'b'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
//--- program4.eclair
// RUN: %eclair compile %t/program4.eclair 2> %t/ungrounded_var_check_for_edge_cases.out
// RUN: diff -w %t/ungrounded_var_check_for_edge_cases.out %t/ungrounded_var_check_for_edge_cases_actual.out
@def bar(u32) input.
@def foo(u32) output.
foo(x) :-
bar(x),
y = y.
foo(x) :-
bar(x),
a = b,
b = a.
foo(x) :-
bar(x),
a = b,
b = c,
c = a.
//--- ungrounded_var_check_for_edge_cases_actual.out
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@10:3-10:4
│
8 │ ╭┤ foo(x) :-
9 │ │ bar(x),
10 │ ├┤ y = y.
• │ ┬
• │ ╰╸ The variable 'y' is ungrounded, meaning it is not directly bound as an argument to a relation.
• │
• ╰╸ This contains no clauses that refer to 'y'.
•
│ Hint: Use the variable 'y' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@10:7-10:8
│
8 │ ╭┤ foo(x) :-
9 │ │ bar(x),
10 │ ├┤ y = y.
• │ ┬
• │ ╰╸ The variable 'y' is ungrounded, meaning it is not directly bound as an argument to a relation.
• │
• ╰╸ This contains no clauses that refer to 'y'.
•
│ Hint: Use the variable 'y' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@14:3-14:4
│
12 │ ╭┤ foo(x) :-
13 │ │ bar(x),
14 │ │ a = b,
• │ ┬
• │ ╰╸ The variable 'a' is ungrounded, meaning it is not directly bound as an argument to a relation.
15 │ ├┤ b = a.
• │
• ╰╸ This contains no clauses that refer to 'a'.
•
│ Hint: Use the variable 'a' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@14:7-14:8
│
12 │ ╭┤ foo(x) :-
13 │ │ bar(x),
14 │ │ a = b,
• │ ┬
• │ ╰╸ The variable 'b' is ungrounded, meaning it is not directly bound as an argument to a relation.
15 │ ├┤ b = a.
• │
• ╰╸ This contains no clauses that refer to 'b'.
•
│ Hint: Use the variable 'b' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@15:3-15:4
│
12 │ ╭┤ foo(x) :-
13 │ │ bar(x),
14 │ │ a = b,
15 │ ├┤ b = a.
• │ ┬
• │ ╰╸ The variable 'b' is ungrounded, meaning it is not directly bound as an argument to a relation.
• │
• ╰╸ This contains no clauses that refer to 'b'.
•
│ Hint: Use the variable 'b' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@15:7-15:8
│
12 │ ╭┤ foo(x) :-
13 │ │ bar(x),
14 │ │ a = b,
15 │ ├┤ b = a.
• │ ┬
• │ ╰╸ The variable 'a' is ungrounded, meaning it is not directly bound as an argument to a relation.
• │
• ╰╸ This contains no clauses that refer to 'a'.
•
│ Hint: Use the variable 'a' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@19:3-19:4
│
17 │ ╭┤ foo(x) :-
18 │ │ bar(x),
19 │ │ a = b,
• │ ┬
• │ ╰╸ The variable 'a' is ungrounded, meaning it is not directly bound as an argument to a relation.
20 │ │ b = c,
21 │ ├┤ c = a.
• │
• ╰╸ This contains no clauses that refer to 'a'.
•
│ Hint: Use the variable 'a' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@19:7-19:8
│
17 │ ╭┤ foo(x) :-
18 │ │ bar(x),
19 │ │ a = b,
• │ ┬
• │ ╰╸ The variable 'b' is ungrounded, meaning it is not directly bound as an argument to a relation.
20 │ │ b = c,
21 │ ├┤ c = a.
• │
• ╰╸ This contains no clauses that refer to 'b'.
•
│ Hint: Use the variable 'b' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@20:3-20:4
│
17 │ ╭┤ foo(x) :-
18 │ │ bar(x),
19 │ │ a = b,
20 │ │ b = c,
• │ ┬
• │ ╰╸ The variable 'b' is ungrounded, meaning it is not directly bound as an argument to a relation.
21 │ ├┤ c = a.
• │
• ╰╸ This contains no clauses that refer to 'b'.
•
│ Hint: Use the variable 'b' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@20:7-20:8
│
17 │ ╭┤ foo(x) :-
18 │ │ bar(x),
19 │ │ a = b,
20 │ │ b = c,
• │ ┬
• │ ╰╸ The variable 'c' is ungrounded, meaning it is not directly bound as an argument to a relation.
21 │ ├┤ c = a.
• │
• ╰╸ This contains no clauses that refer to 'c'.
•
│ Hint: Use the variable 'c' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@21:3-21:4
│
17 │ ╭┤ foo(x) :-
18 │ │ bar(x),
19 │ │ a = b,
20 │ │ b = c,
21 │ ├┤ c = a.
• │ ┬
• │ ╰╸ The variable 'c' is ungrounded, meaning it is not directly bound as an argument to a relation.
• │
• ╰╸ This contains no clauses that refer to 'c'.
•
│ Hint: Use the variable 'c' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program4.eclair@21:7-21:8
│
17 │ ╭┤ foo(x) :-
18 │ │ bar(x),
19 │ │ a = b,
20 │ │ b = c,
21 │ ├┤ c = a.
• │ ┬
• │ ╰╸ The variable 'a' is ungrounded, meaning it is not directly bound as an argument to a relation.
• │
• ╰╸ This contains no clauses that refer to 'a'.
•
│ Hint: Use the variable 'a' as an argument in a relation.
─────╯
================================================
FILE: tests/semantic_analysis/ungrounded_variables_arithmetic.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program1.eclair 2> %t/actual1.out
// RUN: diff -w %t/expected1.out %t/actual1.out
//--- program1.eclair
@def a(u32) output.
@def b(u32) output.
b(123 + a).
a(abc) :-
def = 123,
abc = 123 + def,
b(abc).
a(abc) :-
abc = 123,
// Should detect cycle correctly.
def = abc + def.
//--- expected1.out
[error]: Ungrounded variable
╭──▶ TEST_DIR/program1.eclair@4:9-4:10
│
4 │ b(123 + a).
• ┬───────┬──
• │ ╰╸ The variable 'a' is ungrounded, meaning it is not directly bound as an argument to a relation.
• ╰╸ This contains no clauses that refer to 'a'.
•
│ Hint: Use the variable 'a' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program1.eclair@14:3-14:6
│
11 │ ╭┤ a(abc) :-
12 │ │ abc = 123,
13 │ │ // Should detect cycle correctly.
14 │ ├┤ def = abc + def.
• │ ┬──
• │ ╰╸ The variable 'def' is ungrounded, meaning it is not directly bound as an argument to a relation.
• │
• ╰╸ This contains no clauses that refer to 'def'.
•
│ Hint: Use the variable 'def' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program1.eclair@14:15-14:18
│
11 │ ╭┤ a(abc) :-
12 │ │ abc = 123,
13 │ │ // Should detect cycle correctly.
14 │ ├┤ def = abc + def.
• │ ┬──
• │ ╰╸ The variable 'def' is ungrounded, meaning it is not directly bound as an argument to a relation.
• │
• ╰╸ This contains no clauses that refer to 'def'.
•
│ Hint: Use the variable 'def' as an argument in a relation.
─────╯
================================================
FILE: tests/semantic_analysis/ungrounded_variables_comparisons.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program1.eclair 2> %t/program1_actual.out
// RUN: diff -w %t/program1_expected.out %t/program1_actual.out
//--- program1.eclair
@def fact(u32, u32) input.
@def rule(u32, u32) output.
rule(x, y) :-
x < y,
x <= y,
x > y,
x >= y,
x != y,
fact(x, y).
//--- program1_expected.out
//--- program2.eclair
// RUN: %eclair compile %t/program2.eclair 2> %t/program2_actual.out
// RUN: diff -w %t/program2_expected.out %t/program2_actual.out
@def fact(u32, u32) input.
@def rule(u32, u32) output.
rule(x, y) :-
x < z,
z <= y,
x > z,
z >= y,
x != z,
fact(x, y).
//--- program2_expected.out
[error]: Ungrounded variable
╭──▶ TEST_DIR/program2.eclair@9:7-9:8
│
8 │ ╭┤ rule(x, y) :-
9 │ │ x < z,
• │ ┬
• │ ╰╸ The variable 'z' is ungrounded, meaning it is not directly bound as an argument to a relation.
10 │ │ z <= y,
11 │ │ x > z,
12 │ │ z >= y,
13 │ │ x != z,
14 │ ├┤ fact(x, y).
• │
• ╰╸ This contains no clauses that refer to 'z'.
•
│ Hint: Use the variable 'z' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program2.eclair@10:3-10:4
│
8 │ ╭┤ rule(x, y) :-
9 │ │ x < z,
10 │ │ z <= y,
• │ ┬
• │ ╰╸ The variable 'z' is ungrounded, meaning it is not directly bound as an argument to a relation.
11 │ │ x > z,
12 │ │ z >= y,
13 │ │ x != z,
14 │ ├┤ fact(x, y).
• │
• ╰╸ This contains no clauses that refer to 'z'.
•
│ Hint: Use the variable 'z' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program2.eclair@11:7-11:8
│
8 │ ╭┤ rule(x, y) :-
9 │ │ x < z,
10 │ │ z <= y,
11 │ │ x > z,
• │ ┬
• │ ╰╸ The variable 'z' is ungrounded, meaning it is not directly bound as an argument to a relation.
12 │ │ z >= y,
13 │ │ x != z,
14 │ ├┤ fact(x, y).
• │
• ╰╸ This contains no clauses that refer to 'z'.
•
│ Hint: Use the variable 'z' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program2.eclair@12:3-12:4
│
8 │ ╭┤ rule(x, y) :-
9 │ │ x < z,
10 │ │ z <= y,
11 │ │ x > z,
12 │ │ z >= y,
• │ ┬
• │ ╰╸ The variable 'z' is ungrounded, meaning it is not directly bound as an argument to a relation.
13 │ │ x != z,
14 │ ├┤ fact(x, y).
• │
• ╰╸ This contains no clauses that refer to 'z'.
•
│ Hint: Use the variable 'z' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program2.eclair@13:8-13:9
│
8 │ ╭┤ rule(x, y) :-
9 │ │ x < z,
10 │ │ z <= y,
11 │ │ x > z,
12 │ │ z >= y,
13 │ │ x != z,
• │ ┬
• │ ╰╸ The variable 'z' is ungrounded, meaning it is not directly bound as an argument to a relation.
14 │ ├┤ fact(x, y).
• │
• ╰╸ This contains no clauses that refer to 'z'.
•
│ Hint: Use the variable 'z' as an argument in a relation.
─────╯
//--- program3.eclair
// RUN: %eclair compile %t/program3.eclair 2> %t/program3_actual.out
// RUN: diff -w %t/program3_expected.out %t/program3_actual.out
@def fact(u32, u32) input.
@def rule(u32, u32) output.
rule(x, y) :-
x = z,
y = a,
a < z,
fact(x, y).
rule(x, y) :-
x = z,
y = a,
a < z,
fact(z, y).
//--- program3_expected.out
================================================
FILE: tests/semantic_analysis/ungrounded_variables_negations.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program1.eclair 2> %t/actual1.out
// RUN: diff -w %t/expected1.out %t/actual1.out
//--- program1.eclair
@def a(u32) output.
@def b(u32) output.
a(abc) :-
abc = 123,
!b(abc),
!b(def),
!b(abc + 123).
//--- expected1.out
[error]: Ungrounded variable
╭──▶ TEST_DIR/program1.eclair@7:6-7:9
│
4 │ ╭┤ a(abc) :-
5 │ │ abc = 123,
6 │ │ !b(abc),
7 │ │ !b(def),
• │ ┬──
• │ ╰╸ The variable 'def' is ungrounded, meaning it is not directly bound as an argument to a relation.
8 │ ├┤ !b(abc + 123).
• │
• ╰╸ This contains no clauses that refer to 'def'.
•
│ Hint: Use the variable 'def' as an argument in a relation.
─────╯
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program1.eclair@7:6-7:9
│
4 │ ╭┤ a(abc) :-
5 │ │ abc = 123,
6 │ │ !b(abc),
7 │ │ !b(def),
• │ ┬──
• │ ╰╸ The variable 'def' only occurs once.
8 │ ├┤ !b(abc + 123).
• │
• ╰╸ This rule contains no other references to 'def'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
================================================
FILE: tests/string_support/encode_decode_string.eclair
================================================
// RUN: split-file %s %t
// RUN: %eclair compile %t/program.eclair > %t/program.ll
// RUN: %clang -O0 -o %t/program %t/main.c %t/program.ll
// RUN: %t/program | FileCheck %s
// CHECK: 0 1 2
// CHECK-NEXT: Edge, Reachable, edge
//--- program.eclair
@def Edge(u32, u32) input.
@def Reachable(u32, u32) output.
Reachable(x, y) :-
Edge(x, y).
Reachable(x, y) :-
Edge(x, z),
Reachable(z, y).
//--- main.c
#include
#include
#include
#include
#include
struct program;
struct symbol {
uint32_t length;
const char* data;
} __attribute__((packed));
extern struct program* eclair_program_init();
extern void eclair_program_destroy(struct program*);
extern uint32_t eclair_encode_string(struct program*, uint32_t length, const char* str);
extern struct symbol* eclair_decode_string(struct program*, uint32_t index);
static const char* str1 = "Edge";
static const char* str2 = "Reachable";
static const char* str3 = "edge";
int main(int argc, char** argv)
{
struct program* prog = eclair_program_init();
uint32_t str_index1 = eclair_encode_string(prog, strlen(str1), str1);
uint32_t str_index2 = eclair_encode_string(prog, strlen(str2), str2);
uint32_t str_index3 = eclair_encode_string(prog, strlen(str3), str3);
printf("%d %d %d\n", str_index1, str_index2, str_index3);
struct symbol* symbol0 = eclair_decode_string(prog, 0);
struct symbol* symbol1 = eclair_decode_string(prog, 1);
struct symbol* symbol2 = eclair_decode_string(prog, str_index3);
printf("%s, %s, %s\n", symbol0->data, symbol1->data, symbol2->data);
eclair_program_destroy(prog);
return 0;
}
================================================
FILE: tests/string_support/encode_decode_string_native.eclair
================================================
// This checks if strings can be encoded / decoded between C <=> Eclair
// RUN: split-file %s %t
// RUN: %eclair compile %t/program.eclair > %t/program.ll
// RUN: %clang -O0 -o %t/program %t/main.c %t/program.ll
// RUN: %t/program | FileCheck %s
// NOTE: fact is inserted at place 0, Test at place 1!
// CHECK: 2 2 3 1
// CHECK-NEXT: fact, Test, some example text, some more text
//--- program.eclair
@def fact(u32) input output.
@def Test(u32) input output.
//--- main.c
#include
#include
#include
#include
#include
struct program;
struct symbol {
uint32_t length;
const char* data;
} __attribute__((packed));
extern struct program* eclair_program_init();
extern void eclair_program_destroy(struct program*);
extern uint32_t eclair_encode_string(struct program*, uint32_t length, const char* str);
extern struct symbol* eclair_decode_string(struct program*, uint32_t index);
static const char* str1 = "some example text";
static const char* str2 = "some more text";
static const char* str3 = "Test";
int main(int argc, char** argv)
{
struct program* prog = eclair_program_init();
uint32_t str_index1 = eclair_encode_string(prog, strlen(str1), str1);
uint32_t str_index2 = eclair_encode_string(prog, strlen(str1), str1);
uint32_t str_index3 = eclair_encode_string(prog, strlen(str2), str2);
uint32_t str_index4 = eclair_encode_string(prog, strlen(str3), str3);
printf("%d %d %d %d\n", str_index1, str_index2, str_index3, str_index4);
struct symbol* symbol0 = eclair_decode_string(prog, 0);
struct symbol* symbol1 = eclair_decode_string(prog, 1);
struct symbol* symbol2 = eclair_decode_string(prog, str_index1);
struct symbol* symbol3 = eclair_decode_string(prog, str_index3);
printf("%s, %s, %s, %s\n", symbol0->data, symbol1->data, symbol2->data, symbol3->data);
eclair_program_destroy(prog);
return 0;
}
================================================
FILE: tests/string_support/encode_decode_string_wasm.eclair
================================================
// This checks if strings can be encoded / decoded between JS <=> Eclair
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// TODO: we really need to have our own WASM allocator..
// RUN: test -e %t/walloc.c || wget https://raw.githubusercontent.com/wingo/walloc/master/walloc.c -O %t/walloc.c
// RUN: %clang -O0 --target=wasm32 -mbulk-memory -nostdlib -c -o %t/walloc.o %t/walloc.c
// RUN: %eclair compile --target wasm32 %t/program.eclair > %t/program.ll
// RUN: %clang -O0 --target=wasm32 -mbulk-memory -nostdlib -c -o %t/program.o %t/program.ll
// RUN: %wasm-ld --no-entry --import-memory --import-undefined -o %t/program.wasm %t/program.o %t/walloc.o
// RUN: node %t/program.js | FileCheck %s
// CHECK: 1 1 2
// CHECK-NEXT: fact some example text some more text
//--- program.eclair
@def fact(u32) input output.
//--- program.js
const fs = require("fs");
const encodeString = (memory, instance, program, string) => {
const address = instance.exports.eclair_malloc(string.length * 3);
const array = new Uint8Array(memory.buffer, address, string.length * 3);
const { written } = new TextEncoder().encodeInto(string, array);
const index = instance.exports.eclair_encode_string(
program,
written,
address
);
instance.exports.eclair_free(address);
return index;
};
const decodeString = (memory, instance, program, index) => {
const address = instance.exports.eclair_decode_string(program, index);
const symbolMemory = new Uint32Array(memory.buffer, address, 2);
const [stringLength, byteArrayAddress] = symbolMemory;
const bytes = new Uint8Array(memory.buffer, byteArrayAddress, stringLength);
return new TextDecoder().decode(bytes);
};
const main = () => {
const bytes = fs.readFileSync("TEST_DIR/program.wasm");
const mod = new WebAssembly.Module(bytes);
const memory = new WebAssembly.Memory({ initial: 10, maximum: 10 });
const imports = { env: { memory } };
const instance = new WebAssembly.Instance(mod, imports);
const program = instance.exports.eclair_program_init();
const str = "some example text";
const str2 = "some more text";
const strIndex1 = encodeString(memory, instance, program, str);
const strIndex2 = encodeString(memory, instance, program, str);
const strIndex3 = encodeString(memory, instance, program, str2);
console.log(strIndex1, strIndex2, strIndex3);
console.log(
decodeString(memory, instance, program, 0),
decodeString(memory, instance, program, strIndex1),
decodeString(memory, instance, program, strIndex3)
);
instance.exports.eclair_program_destroy(program);
};
main();
================================================
FILE: tests/transpilation/souffle.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile --emit souffle %t/program.eclair > %t/actual_souffle.out
// RUN: diff %t/expected_souffle.out %t/actual_souffle.out
// RUN: %eclair compile --emit souffle %t/unsupported.eclair 2> %t/error.out
// RUN: diff -w %t/expected_error.out %t/error.out
// RUN: %eclair compile --emit souffle %t/unsupported2.eclair 2> %t/error.out
// RUN: diff %t/expected_error2.out %t/error.out
//--- program.eclair
@def fact1(u32) input.
@def fact2(u32) output.
fact2(y) :-
fact1(x),
y = x + 3.
fact2(x + 3) :-
fact1(x).
fact2((x + 1) + 2 * x) :-
fact1(x).
fact2(x) :-
!fact1(x),
fact1(x + 4),
fact1(x + 4).
fact2((8 - x) / x) :-
fact1(x).
@def fact3(u32, string) output.
fact3(123, "abcd").
//--- expected_souffle.out
.decl fact1(arg_0: unsigned)
.input fact1
.decl fact2(arg_0: unsigned)
.output fact2
fact2(y) :-
fact1(x),
y = (x + 3).
fact2((x + 3)) :-
fact1(x).
fact2(((x + 1) + (2 * x))) :-
fact1(x).
fact2(x) :-
!fact1(x),
fact1((x + 4)),
fact1((x + 4)).
fact2(((8 - x) / x)) :-
fact1(x).
.decl fact3(arg_0: unsigned, arg_1: symbol)
.output fact3
fact3(123, "abcd").
//--- unsupported.eclair
@def fact1(u32) input.
fact2(y) :-
fact1(?).
//--- expected_error.out
[error]: Unsupported feature in Souffle
╭──▶ TEST_DIR/unsupported.eclair@4:9-4:10
│
4 │ fact1(?).
• ┬
• ╰╸ Souffle has no support for holes.
•
│ Hint: Replace the hole with a variable or literal.
─────╯
//--- unsupported2.eclair
@extern match(string, string).
//--- expected_error2.out
[error]: Unsupported feature in Souffle
╭──▶ TEST_DIR/unsupported2.eclair@1:1-1:31
│
1 │ @extern match(string, string).
• ┬─────────────────────────────
• ╰╸ Eclair can't transpile extern definitions yet.
•
│ Hint: Please open a github issue asking for this feature.
─────╯
================================================
FILE: tests/typesystem/arg_count_mismatch.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def edge(u32, u32, u32) output.
@def path(u32) output.
edge(1, 2).
path(3, 4).
@def fact1(u32, u32) input.
@def fact2(u32, u32, u32) output.
fact2(x, y) :-
fact1(x, y).
@def fact3(u32, u32) input.
@def fact4(u32) output.
fact4(x, y) :-
fact3(x, y).
@def fact5(u32, u32, u32) input.
@def fact6(u32, u32) output.
fact6(x, y) :-
fact5(x, y).
@def fact7(u32, u32) input.
@def fact8(u32, u32) output.
fact8(x, y) :-
fact7(x, y, 123).
@def a(u32, u32) output.
@def b(u32) input.
@def c(u32) input.
a(x, y) :-
b(x, 123),
c(y, 456).
//--- expected.out
[error]: Found an unexpected amount of arguments for 'edge'
╭──▶ TEST_DIR/program.eclair@3:1-3:12
│
1 │ @def edge(u32, u32, u32) output.
• ┬───────────────────────────────
• ╰╸ 'edge' is defined with 3 arguments.
•
3 │ edge(1, 2).
• ┬──────────
• ╰╸ 2 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 3 arguments to 'edge'.
─────╯
[error]: Found an unexpected amount of arguments for 'path'
╭──▶ TEST_DIR/program.eclair@4:1-4:12
│
2 │ @def path(u32) output.
• ┬─────────────────────
• ╰╸ 'path' is defined with 1 argument.
•
4 │ path(3, 4).
• ┬──────────
• ╰╸ 2 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 1 argument to 'path'.
─────╯
[error]: Found an unexpected amount of arguments for 'fact2'
╭──▶ TEST_DIR/program.eclair@9:1-10:15
│
7 │ @def fact2(u32, u32, u32) output.
• ┬────────────────────────────────
• ╰╸ 'fact2' is defined with 3 arguments.
•
9 │ ╭┤ fact2(x, y) :-
10 │ ├┤ fact1(x, y).
• │
• ╰╸ 2 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 3 arguments to 'fact2'.
─────╯
[error]: Found an unexpected amount of arguments for 'fact4'
╭──▶ TEST_DIR/program.eclair@15:1-16:15
│
13 │ @def fact4(u32) output.
• ┬──────────────────────
• ╰╸ 'fact4' is defined with 1 argument.
•
15 │ ╭┤ fact4(x, y) :-
16 │ ├┤ fact3(x, y).
• │
• ╰╸ 2 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 1 argument to 'fact4'.
─────╯
[error]: Found an unexpected amount of arguments for 'fact5'
╭──▶ TEST_DIR/program.eclair@22:3-22:14
│
18 │ @def fact5(u32, u32, u32) input.
• ┬───────────────────────────────
• ╰╸ 'fact5' is defined with 3 arguments.
•
22 │ fact5(x, y).
• ┬──────────
• ╰╸ 2 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 3 arguments to 'fact5'.
─────╯
[error]: Found an unexpected amount of arguments for 'fact7'
╭──▶ TEST_DIR/program.eclair@28:3-28:19
│
24 │ @def fact7(u32, u32) input.
• ┬──────────────────────────
• ╰╸ 'fact7' is defined with 2 arguments.
•
28 │ fact7(x, y, 123).
• ┬───────────────
• ╰╸ 3 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 2 arguments to 'fact7'.
─────╯
[error]: Found an unexpected amount of arguments for 'b'
╭──▶ TEST_DIR/program.eclair@35:3-35:12
│
31 │ @def b(u32) input.
• ┬─────────────────
• ╰╸ 'b' is defined with 1 argument.
•
35 │ b(x, 123),
• ┬────────
• ╰╸ 2 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 1 argument to 'b'.
─────╯
[error]: Found an unexpected amount of arguments for 'c'
╭──▶ TEST_DIR/program.eclair@36:3-36:12
│
32 │ @def c(u32) input.
• ┬─────────────────
• ╰╸ 'c' is defined with 1 argument.
•
36 │ c(y, 456).
• ┬────────
• ╰╸ 2 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 1 argument to 'c'.
─────╯
================================================
FILE: tests/typesystem/arithmetic.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
//--- program1.eclair
// RUN: %eclair compile --emit ra-transformed %t/program1.eclair | FileCheck %t/program1.eclair
// CHECK: project
@def number(u32) input.
@def arithmetic(u32) output.
arithmetic(123 + 456).
arithmetic(456 - 123).
arithmetic(123 * 456).
arithmetic(123 / 456).
arithmetic(123 * 456 + 789).
arithmetic(x) :-
number(x),
x = 123 + (456 * 789).
//--- program2.eclair
// RUN: %eclair compile --emit ra-transformed %t/program2.eclair 2> %t/program2.out
// RUN: diff -w %t/expected.out %t/program2.out
@def number(u32) input.
@def arithmetic(u32) output.
arithmetic("abc" + 456).
arithmetic(123 - "abc").
arithmetic(x) :-
number(x),
x = "abc" + (456 * "def"),
"abc" = 1 + 2.
//--- expected.out
[error]: Type mismatch
╭──▶ TEST_DIR/program2.eclair@7:12-7:17
│
7 │ arithmetic("abc" + 456).
• ┬───────────────────────
• ╰───────────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ├╸ 3) While checking the type of this..
• ╰╸ 4) Expected this to be of type 'u32', but it actually has type 'string'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program2.eclair@8:18-8:23
│
8 │ arithmetic(123 - "abc").
• ┬───────────────────────
• ╰─────────────────╸ 1) While checking the type of this..
• ╰──────╸ 2) While checking the type of this..
• ├╸ 3) While checking the type of this..
• ╰╸ 4) Expected this to be of type 'u32', but it actually has type 'string'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program2.eclair@12:7-12:12
│
10 │ ╭┤ arithmetic(x) :-
11 │ │ number(x),
12 │ │ x = "abc" + (456 * "def"),
• │ ┬────────────────────────
• │ ╰────╸ 2) While checking the type of this..
• │ ├╸ 3) While inferring the type of this..
• │ ├╸ 4) While checking the type of this..
• │ ╰╸ 5) Expected this to be of type 'u32', but it actually has type 'string'.
13 │ ├┤ "abc" = 1 + 2.
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program2.eclair@12:22-12:27
│
10 │ ╭┤ arithmetic(x) :-
11 │ │ number(x),
12 │ │ x = "abc" + (456 * "def"),
• │ ┬────────────────────────
• │ ╰───────────────────╸ 2) While checking the type of this..
• │ ╰───────────────╸ 3) While inferring the type of this..
• │ ╰──────╸ 4) While checking the type of this..
• │ ├╸ 5) While checking the type of this..
• │ ╰╸ 6) Expected this to be of type 'u32', but it actually has type 'string'.
13 │ ├┤ "abc" = 1 + 2.
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type unification failure
╭──▶ TEST_DIR/program2.eclair@13:3-13:16
│
10 │ ╭┤ arithmetic(x) :-
11 │ │ number(x),
12 │ │ x = "abc" + (456 * "def"),
13 │ ├┤ "abc" = 1 + 2.
• │ ┬────────────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
• │
• ╰╸ 1) While checking the type of this..
─────╯
================================================
FILE: tests/typesystem/comparisons.eclair
================================================
// NOTE: happy path already tested in lowering tests.
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def fact1(u32, u32) input.
@def fact2(u32).
fact2(x) :-
fact1(x, _),
x != "abc",
"abc" != x.
fact2(x) :-
fact1(x, _),
x < "abc",
"abc" < x.
fact2(x) :-
fact1(x, _),
x <= "abc",
x >= "abc",
x > "abc".
//--- expected.out
[error]: No output relations found
╭──▶ TEST_DIR/program.eclair@1:1-1:2
│
1 │ @def fact1(u32, u32) input.
• ┬
• ╰╸ This module does not produce any results
•
│ Hint: Add an 'output' qualifier to one of the relations defined in this module.
─────╯
[error]: Type unification failure
╭──▶ TEST_DIR/program.eclair@6:3-6:13
│
4 │ ╭┤ fact2(x) :-
5 │ │ fact1(x, _),
6 │ │ x != "abc",
• │ ┬─────────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
7 │ ├┤ "abc" != x.
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type unification failure
╭──▶ TEST_DIR/program.eclair@7:3-7:13
│
4 │ ╭┤ fact2(x) :-
5 │ │ fact1(x, _),
6 │ │ x != "abc",
7 │ ├┤ "abc" != x.
• │ ┬─────────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@11:7-11:12
│
9 │ ╭┤ fact2(x) :-
10 │ │ fact1(x, _),
11 │ │ x < "abc",
• │ ┬────────
• │ ╰────╸ 2) While checking the type of this..
• │ ├╸ 3) While checking the type of this..
• │ ╰╸ 4) Expected this to be of type 'u32', but it actually has type 'string'.
12 │ ├┤ "abc" < x.
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@12:3-12:8
│
9 │ ╭┤ fact2(x) :-
10 │ │ fact1(x, _),
11 │ │ x < "abc",
12 │ ├┤ "abc" < x.
• │ ┬────────
• │ ├╸ 2) While checking the type of this..
• │ ├╸ 3) While checking the type of this..
• │ ╰╸ 4) Expected this to be of type 'u32', but it actually has type 'string'.
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@16:8-16:13
│
14 │ ╭┤ fact2(x) :-
15 │ │ fact1(x, _),
16 │ │ x <= "abc",
• │ ┬─────────
• │ ╰─────╸ 2) While checking the type of this..
• │ ├╸ 3) While checking the type of this..
• │ ╰╸ 4) Expected this to be of type 'u32', but it actually has type 'string'.
17 │ │ x >= "abc",
18 │ ├┤ x > "abc".
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@17:8-17:13
│
14 │ ╭┤ fact2(x) :-
15 │ │ fact1(x, _),
16 │ │ x <= "abc",
17 │ │ x >= "abc",
• │ ┬─────────
• │ ╰─────╸ 2) While checking the type of this..
• │ ├╸ 3) While checking the type of this..
• │ ╰╸ 4) Expected this to be of type 'u32', but it actually has type 'string'.
18 │ ├┤ x > "abc".
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@18:7-18:12
│
14 │ ╭┤ fact2(x) :-
15 │ │ fact1(x, _),
16 │ │ x <= "abc",
17 │ │ x >= "abc",
18 │ ├┤ x > "abc".
• │ ┬────────
• │ ╰────╸ 2) While checking the type of this..
• │ ├╸ 3) While checking the type of this..
• │ ╰╸ 4) Expected this to be of type 'u32', but it actually has type 'string'.
• │
• ╰╸ 1) While checking the type of this..
─────╯
================================================
FILE: tests/typesystem/duplicate_type_declarations.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def edge(u32, u32) output.
@def edge(u32, u32) output.
@def path(u32, u32) output.
@def edge(u32, u32) output.
@def path(u32, u32) output.
//--- expected.out
[error]: Multiple definitions for 'edge'
╭──▶ TEST_DIR/program.eclair@1:1-1:28
│
1 │ @def edge(u32, u32) output.
• ┬──────────────────────────
• ╰╸ 'edge' is originally defined here.
2 │ @def edge(u32, u32) output.
• ┬──────────────────────────
• ╰╸ 'edge' is re-defined here.
•
4 │ @def edge(u32, u32) output.
• ┬──────────────────────────
• ╰╸ 'edge' is re-defined here.
•
│ Hint: You can solve this by removing the duplicate definitions for 'edge'.
─────╯
[error]: Multiple definitions for 'path'
╭──▶ TEST_DIR/program.eclair@3:1-3:28
│
3 │ @def path(u32, u32) output.
• ┬──────────────────────────
• ╰╸ 'path' is originally defined here.
•
5 │ @def path(u32, u32) output.
• ┬──────────────────────────
• ╰╸ 'path' is re-defined here.
•
│ Hint: You can solve this by removing the duplicate definitions for 'path'.
─────╯
================================================
FILE: tests/typesystem/extern_definitions.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
//--- program1.eclair
// RUN: %eclair compile --emit ra-transformed %t/program1.eclair | FileCheck %t/program1.eclair
// CHECK: project
@def edge(u32, u32) input.
@def test_externs(u32) output.
@extern constraint1(string).
@extern func1(u32) u32.
@extern func2(u32, u32) string.
test_externs(func1(123)).
test_externs(x) :-
edge(x, y),
constraint1("abc"),
constraint1(func2(123, 456)),
func1(y) + 1 = x,
x = func1(y) + y,
func1(x) = func1(y),
func1(func1(x)) = y.
//--- program2.eclair
// RUN: %eclair compile --emit ra-transformed %t/program2.eclair 2> %t/program2.out
// RUN: diff -w %t/expected.out %t/program2.out
@extern constraint2(string).
@extern func3(u32) u32.
@extern func4(u32, u32) string.
@def edge2(u32, u32) input.
@def test_externs2(u32) output.
// Type errors in functions
test_externs2(func3("abc")).
test_externs2(func3(123, 123)).
test_externs2(func4(123, 123)).
test_externs2(func4(123, 123) + 123).
// Type errors in constraints
test_externs2(x) :-
edge2(x, 123),
constraint2(x),
constraint2("abc", "def").
// Using in wrong context
test_externs2(constraint2("abc")).
test_externs2(edge2(123, 456)).
test_externs2(x) :-
edge2(x, 123),
func3(x).
// Unknown extern definition
test_externs2(x) :-
edge2(x, 123),
unknown_constraint(x),
x = unknown_function(123).
//--- expected.out
[error]: Type mismatch
╭──▶ TEST_DIR/program2.eclair@12:21-12:26
│
12 │ test_externs2(func3("abc")).
• ┬───────────────────────────
• ╰────────────────────╸ 1) While checking the type of this..
• ╰──────╸ 2) While checking the type of this..
• ├╸ 3) While checking the type of this..
• ╰╸ 4) Expected this to be of type 'u32', but it actually has type 'string'.
─────╯
[error]: Found an unexpected amount of arguments for 'func3'
╭──▶ TEST_DIR/program2.eclair@13:15-13:30
│
5 │ @extern func3(u32) u32.
• ┬──────────────────────
• ╰╸ 'func3' is defined with 1 argument.
•
13 │ test_externs2(func3(123, 123)).
• ┬──────────────
• ╰╸ 2 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 1 argument to 'func3'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program2.eclair@14:15-14:30
│
14 │ test_externs2(func4(123, 123)).
• ┬──────────────────────────────
• ╰──────────────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program2.eclair@15:15-15:30
│
15 │ test_externs2(func4(123, 123) + 123).
• ┬────────────────────────────────────
• ╰──────────────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ├╸ 3) While checking the type of this..
• ╰╸ 4) Expected this to be of type 'u32', but it actually has type 'string'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program2.eclair@20:15-20:16
│
18 │ ╭┤ test_externs2(x) :-
19 │ │ edge2(x, 123),
20 │ │ constraint2(x),
• │ ┬
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'string', but it actually has type 'u32'.
21 │ ├┤ constraint2("abc", "def").
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Found an unexpected amount of arguments for 'constraint2'
╭──▶ TEST_DIR/program2.eclair@21:3-21:28
│
4 │ @extern constraint2(string).
• ┬───────────────────────────
• ╰╸ 'constraint2' is defined with 1 argument.
•
21 │ constraint2("abc", "def").
• ┬────────────────────────
• ╰╸ 2 arguments are provided here.
•
│ Hint: You can solve this by passing exactly 1 argument to 'constraint2'.
─────╯
[error]: Invalid use of constraint
╭──▶ TEST_DIR/program2.eclair@24:15-24:33
│
4 │ @extern constraint2(string).
• ┬───────────────────────────
• ╰╸ Previously defined as a constraint here.
•
24 │ test_externs2(constraint2("abc")).
• ┬─────────────────
• ╰╸ Expected a function.
•
│ Hint: Maybe you meant to declare this as a function instead?
│ Hint: Remove the invalid constraint.
─────╯
[error]: Invalid use of constraint
╭──▶ TEST_DIR/program2.eclair@25:15-25:30
│
8 │ @def edge2(u32, u32) input.
• ┬──────────────────────────
• ╰╸ Previously defined as a constraint here.
•
25 │ test_externs2(edge2(123, 456)).
• ┬──────────────
• ╰╸ Expected a function.
•
│ Hint: Maybe you meant to declare this as a function instead?
│ Hint: Remove the invalid constraint.
─────╯
[error]: Invalid use of function
╭──▶ TEST_DIR/program2.eclair@28:3-28:11
│
5 │ @extern func3(u32) u32.
• ┬──────────────────────
• ╰╸ Previously defined as a function here.
•
28 │ func3(x).
• ┬───────
• ╰╸ Expected a constraint here.
•
│ Hint: Maybe you meant to declare this an external constraint instead?
│ Hint: Remove the invalid function.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program2.eclair@33:3-33:24
│
33 │ unknown_constraint(x),
• ┬────────────────────
• ╰╸ Could not find a type definition for 'unknown_constraint'.
•
│ Hint: Add a type definition for 'unknown_constraint'.
│ Hint: Add an extern definition for 'unknown_constraint'.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program2.eclair@34:7-34:28
│
34 │ x = unknown_function(123).
• ┬────────────────────
• ╰╸ Could not find a type definition for 'unknown_function'.
•
│ Hint: Add an extern definition for 'unknown_function'.
─────╯
================================================
FILE: tests/typesystem/negation.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
//--- program1.eclair
// RUN: %eclair compile %t/program1.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
@def fact1(u32) input.
@def fact2(u32) output.
fact2(x) :-
fact1(x),
!fact1(2),
!fact1("abc"),
!fact1(x + 1).
//--- expected.out
[error]: Type mismatch
╭──▶ TEST_DIR/program1.eclair@10:10-10:15
│
7 │ ╭┤ fact2(x) :-
8 │ │ fact1(x),
9 │ │ !fact1(2),
10 │ │ !fact1("abc"),
• │ ┬────────────
• │ ╰───────╸ 2) While checking the type of this..
• │ ╰──────╸ 3) While checking the type of this..
• │ ├╸ 4) While checking the type of this..
• │ ╰╸ 5) Expected this to be of type 'u32', but it actually has type 'string'.
11 │ ├┤ !fact1(x + 1).
• │
• ╰╸ 1) While checking the type of this..
─────╯
================================================
FILE: tests/typesystem/no_rules_for_type.eclair
================================================
// RUN: %eclair compile %s | FileCheck %s
@def edge(u32, u32) input.
@def chain(u32, u32, u32) input output.
// CHECK: chain
================================================
FILE: tests/typesystem/type_mismatch_in_rule.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def fact1(u32) input.
@def fact2(u32, string) output.
fact2(123, x) :-
fact1(x).
//--- expected.out
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@4:9-4:10
│
3 │ ╭┤ fact2(123, x) :-
4 │ ├┤ fact1(x).
• │ ┬
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
• │
• ╰╸ 1) While checking the type of this..
─────╯
================================================
FILE: tests/typesystem/type_mismatch_in_rule_body.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def fact1(u32, u32) input.
@def fact2(u32) output.
fact2(123) :-
fact1("abc", 123),
fact1(456, "def"),
fact1("abc", "def").
@def fact3(u32) output.
@def fact4(u32, string) input.
fact3(123) :-
fact4(x, x).
//--- expected.out
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@4:9-4:14
│
3 │ ╭┤ fact2(123) :-
4 │ │ fact1("abc", 123),
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
5 │ │ fact1(456, "def"),
6 │ ├┤ fact1("abc", "def").
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@5:14-5:19
│
3 │ ╭┤ fact2(123) :-
4 │ │ fact1("abc", 123),
5 │ │ fact1(456, "def"),
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
6 │ ├┤ fact1("abc", "def").
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@6:9-6:14
│
3 │ ╭┤ fact2(123) :-
4 │ │ fact1("abc", 123),
5 │ │ fact1(456, "def"),
6 │ ├┤ fact1("abc", "def").
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@6:16-6:21
│
3 │ ╭┤ fact2(123) :-
4 │ │ fact1("abc", 123),
5 │ │ fact1(456, "def"),
6 │ ├┤ fact1("abc", "def").
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@11:12-11:13
│
10 │ ╭┤ fact3(123) :-
11 │ ├┤ fact4(x, x).
• │ ┬
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'string', but it actually has type 'u32'.
• │
• ╰╸ 1) While checking the type of this..
─────╯
================================================
FILE: tests/typesystem/type_mismatch_in_rule_head.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
reachable(x, "abc") :-
edge(x, x).
reachable("abc", x) :-
edge(x, x).
reachable("abc", "abc") :-
edge(x, x).
@def fact1(u32) input.
@def fact2(u32, string) output.
fact2(x, x) :-
fact1(x).
//--- expected.out
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@3:14-3:19
│
3 │ ╭┤ reachable(x, "abc") :-
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
4 │ ├┤ edge(x, x).
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@5:11-5:16
│
5 │ ╭┤ reachable("abc", x) :-
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
6 │ ├┤ edge(x, x).
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@7:11-7:16
│
7 │ ╭┤ reachable("abc", "abc") :-
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
8 │ ├┤ edge(x, x).
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@7:18-7:23
│
7 │ ╭┤ reachable("abc", "abc") :-
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
8 │ ├┤ edge(x, x).
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@12:10-12:11
│
12 │ ╭┤ fact2(x, x) :-
• │ ┬
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'string', but it actually has type 'u32'.
13 │ ├┤ fact1(x).
• │
• ╰╸ 1) While checking the type of this..
─────╯
================================================
FILE: tests/typesystem/type_mismatch_top_level_atoms.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def fact1(u32, string) output.
@def fact2(string, string) output.
fact1(1, 2).
fact1("abc", "def").
fact1("abc", 2).
fact2(1, 2).
//--- expected.out
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@3:10-3:11
│
3 │ fact1(1, 2).
• ┬───────────
• ╰─────────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ╰╸ 3) Expected this to be of type 'string', but it actually has type 'u32'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@4:7-4:12
│
4 │ fact1("abc", "def").
• ┬───────────────────
• ╰──────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@5:7-5:12
│
5 │ fact1("abc", 2).
• ┬───────────────
• ╰──────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ╰╸ 3) Expected this to be of type 'u32', but it actually has type 'string'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@5:14-5:15
│
5 │ fact1("abc", 2).
• ┬───────────────
• ╰─────────────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ╰╸ 3) Expected this to be of type 'string', but it actually has type 'u32'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@6:7-6:8
│
6 │ fact2(1, 2).
• ┬───────────
• ╰──────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ╰╸ 3) Expected this to be of type 'string', but it actually has type 'u32'.
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@6:10-6:11
│
6 │ fact2(1, 2).
• ┬───────────
• ╰─────────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ╰╸ 3) Expected this to be of type 'string', but it actually has type 'u32'.
─────╯
================================================
FILE: tests/typesystem/typed_holes.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
//--- program1.eclair
// RUN: %eclair compile %t/program1.eclair 2> %t/actual1.out
// RUN: diff -w %t/expected1.out %t/actual1.out
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
reachable(x, y) :-
edge(x, y),
edge(x, ?),
x = ?.
//--- expected1.out
[error]: Found hole
╭──▶ TEST_DIR/program1.eclair@9:11-9:12
│
7 │ ╭┤ reachable(x, y) :-
8 │ │ edge(x, y),
9 │ │ edge(x, ?),
• │ ┬
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Found hole with type 'u32'.
10 │ ├┤ x = ?.
• │
• ╰╸ 1) While checking the type of this..
•
│ Hint: Possible candidate: x :: 'u32'
│ Hint: Possible candidate: y :: 'u32'
─────╯
[error]: Found hole
╭──▶ TEST_DIR/program1.eclair@10:7-10:8
│
7 │ ╭┤ reachable(x, y) :-
8 │ │ edge(x, y),
9 │ │ edge(x, ?),
10 │ ├┤ x = ?.
• │ ┬────
• │ ╰────╸ 2) While checking the type of this..
• │ ├╸ 3) While inferring the type of this..
• │ ╰╸ 4) Found hole with type 'u32'.
• │
• ╰╸ 1) While checking the type of this..
•
│ Hint: Possible candidate: x :: 'u32'
│ Hint: Possible candidate: y :: 'u32'
─────╯
//--- program2.eclair
// RUN: %eclair compile %t/program2.eclair 2> %t/actual2.out
// RUN: diff %t/expected2.out %t/actual2.out
@def fact(string, u32, u32) output.
fact(?, 42, ?).
//--- expected2.out
[error]: Found hole
╭──▶ TEST_DIR/program2.eclair@6:6-6:7
│
6 │ fact(?, 42, ?).
• ┬──────────────
• ╰─────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ╰╸ 3) Found hole with type 'string'.
─────╯
[error]: Found hole
╭──▶ TEST_DIR/program2.eclair@6:13-6:14
│
6 │ fact(?, 42, ?).
• ┬──────────────
• ╰────────────╸ 1) While checking the type of this..
• ├╸ 2) While checking the type of this..
• ╰╸ 3) Found hole with type 'u32'.
─────╯
//--- program3.eclair
// RUN: %eclair compile %t/program3.eclair 2> %t/actual3.out
// RUN: diff -w %t/expected3.out %t/actual3.out
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
reachable(x, z) :-
edge(x, ?),
reachable(y, z).
//--- expected3.out
[error]: Found unconstrained variable
╭──▶ TEST_DIR/program3.eclair@9:13-9:14
│
7 │ ╭┤ reachable(x, z) :-
8 │ │ edge(x, ?),
9 │ ├┤ reachable(y, z).
• │ ┬
• │ ╰╸ The variable 'y' only occurs once.
• │
• ╰╸ This rule contains no other references to 'y'.
•
│ Hint: Replace the variable with a wildcard ('_').
│ Hint: Use the variable in another rule clause.
─────╯
[error]: Found hole
╭──▶ TEST_DIR/program3.eclair@8:11-8:12
│
7 │ ╭┤ reachable(x, z) :-
8 │ │ edge(x, ?),
• │ ┬
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Found hole with type 'u32'.
9 │ ├┤ reachable(y, z).
• │
• ╰╸ 1) While checking the type of this..
•
│ Hint: Possible candidate: x :: 'u32'
│ Hint: Possible candidate: y :: 'u32'
│ Hint: Possible candidate: z :: 'u32'
─────╯
================================================
FILE: tests/typesystem/unification_failure.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def fact1(u32, u32) input.
@def fact2(u32).
fact2(x) :-
fact1(x, _),
x = "abc".
@def fact3(u32, u32) input.
@def fact4(u32).
fact4(x) :-
fact3(x, _),
"abc" = x.
@def fact5(string, string) input.
@def fact6(string).
fact6(x) :-
fact5(x, _),
x = 1.
@def fact7(string, string) input.
@def fact8(string).
fact8(x) :-
fact7(x, _),
1 = x.
@def fact9(string, u32) input.
@def fact10(string).
fact10(x) :-
fact9(x, y),
x = y.
@def fact11(u32, string) input.
@def fact12(u32).
fact12(x) :-
x = y,
fact11(x, z),
y = z.
@def fact13(u32, string) input.
@def fact14(u32).
fact14(x) :-
x = y,
y = z,
fact13(x, z).
@def fact15(u32, string) input.
@def fact16(u32).
fact16(x) :-
x = y,
y = z,
z = a,
fact15(x, a).
@def fact17(u32, string) input.
@def fact18(u32) output.
fact18(x) :-
x = y,
y = z,
fact17(x, a),
z = a.
//--- expected.out
[error]: Type unification failure
╭──▶ TEST_DIR/program.eclair@5:3-5:12
│
3 │ ╭┤ fact2(x) :-
4 │ │ fact1(x, _),
5 │ ├┤ x = "abc".
• │ ┬────────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type unification failure
╭──▶ TEST_DIR/program.eclair@11:3-11:12
│
9 │ ╭┤ fact4(x) :-
10 │ │ fact3(x, _),
11 │ ├┤ "abc" = x.
• │ ┬────────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type unification failure
╭──▶ TEST_DIR/program.eclair@17:3-17:8
│
15 │ ╭┤ fact6(x) :-
16 │ │ fact5(x, _),
17 │ ├┤ x = 1.
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type unification failure
╭──▶ TEST_DIR/program.eclair@23:3-23:8
│
21 │ ╭┤ fact8(x) :-
22 │ │ fact7(x, _),
23 │ ├┤ 1 = x.
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type unification failure
╭──▶ TEST_DIR/program.eclair@29:3-29:8
│
27 │ ╭┤ fact10(x) :-
28 │ │ fact9(x, y),
29 │ ├┤ x = y.
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type unification failure
╭──▶ TEST_DIR/program.eclair@36:3-36:8
│
33 │ ╭┤ fact12(x) :-
34 │ │ x = y,
35 │ │ fact11(x, z),
36 │ ├┤ y = z.
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@43:13-43:14
│
40 │ ╭┤ fact14(x) :-
41 │ │ x = y,
42 │ │ y = z,
43 │ ├┤ fact13(x, z).
• │ ┬
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'string', but it actually has type 'u32'.
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type mismatch
╭──▶ TEST_DIR/program.eclair@51:13-51:14
│
47 │ ╭┤ fact16(x) :-
48 │ │ x = y,
49 │ │ y = z,
50 │ │ z = a,
51 │ ├┤ fact15(x, a).
• │ ┬
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) Expected this to be of type 'string', but it actually has type 'u32'.
• │
• ╰╸ 1) While checking the type of this..
─────╯
[error]: Type unification failure
╭──▶ TEST_DIR/program.eclair@59:3-59:8
│
55 │ ╭┤ fact18(x) :-
56 │ │ x = y,
57 │ │ y = z,
58 │ │ fact17(x, a),
59 │ ├┤ z = a.
• │ ┬────
• │ ├╸ 2) While checking the type of this..
• │ ╰╸ 3) While unifying these types..
• │
• ╰╸ 1) While checking the type of this..
─────╯
================================================
FILE: tests/typesystem/unknown_atom_in_rule_body.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def path(u32, u32) output.
path(x, y) :-
edge(x, y).
//--- expected.out
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@3:6-3:7
│
3 │ ╭┤ path(x, y) :-
• │ ┬
• │ ╰╸ The variable 'x' is ungrounded, meaning it is not directly bound as an argument to a relation.
4 │ ├┤ edge(x, y).
• │
• ╰╸ This contains no clauses that refer to 'x'.
•
│ Hint: Use the variable 'x' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@3:9-3:10
│
3 │ ╭┤ path(x, y) :-
• │ ┬
• │ ╰╸ The variable 'y' is ungrounded, meaning it is not directly bound as an argument to a relation.
4 │ ├┤ edge(x, y).
• │
• ╰╸ This contains no clauses that refer to 'y'.
•
│ Hint: Use the variable 'y' as an argument in a relation.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@4:3-4:13
│
4 │ edge(x, y).
• ┬─────────
• ╰╸ Could not find a type definition for 'edge'.
•
│ Hint: Add a type definition for 'edge'.
│ Hint: Add an extern definition for 'edge'.
─────╯
================================================
FILE: tests/typesystem/unknown_atom_in_rule_head.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
@def edge(u32, u32) input.
path(x, y) :-
edge(x, y).
@def out(u32) output.
//--- expected.out
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@3:1-4:14
│
3 │ ╭┤ path(x, y) :-
4 │ ├┤ edge(x, y).
• │
• ╰╸ Could not find a type definition for 'path'.
•
│ Hint: Add a type definition for 'path'.
│ Hint: Add an extern definition for 'path'.
─────╯
================================================
FILE: tests/typesystem/unknown_atoms.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff -w %t/expected.out %t/actual.out
//--- program.eclair
top_level_atom(1).
path(x, y) :-
edge(x, y).
@def result(u32) output.
//--- expected.out
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@3:6-3:7
│
3 │ ╭┤ path(x, y) :-
• │ ┬
• │ ╰╸ The variable 'x' is ungrounded, meaning it is not directly bound as an argument to a relation.
4 │ ├┤ edge(x, y).
• │
• ╰╸ This contains no clauses that refer to 'x'.
•
│ Hint: Use the variable 'x' as an argument in a relation.
─────╯
[error]: Ungrounded variable
╭──▶ TEST_DIR/program.eclair@3:9-3:10
│
3 │ ╭┤ path(x, y) :-
• │ ┬
• │ ╰╸ The variable 'y' is ungrounded, meaning it is not directly bound as an argument to a relation.
4 │ ├┤ edge(x, y).
• │
• ╰╸ This contains no clauses that refer to 'y'.
•
│ Hint: Use the variable 'y' as an argument in a relation.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@1:1-1:19
│
1 │ top_level_atom(1).
• ┬─────────────────
• ╰╸ Could not find a type definition for 'top_level_atom'.
•
│ Hint: Add a type definition for 'top_level_atom'.
│ Hint: Add an extern definition for 'top_level_atom'.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@3:1-4:14
│
3 │ ╭┤ path(x, y) :-
4 │ ├┤ edge(x, y).
• │
• ╰╸ Could not find a type definition for 'path'.
•
│ Hint: Add a type definition for 'path'.
│ Hint: Add an extern definition for 'path'.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@4:3-4:13
│
4 │ edge(x, y).
• ┬─────────
• ╰╸ Could not find a type definition for 'edge'.
•
│ Hint: Add a type definition for 'edge'.
│ Hint: Add an extern definition for 'edge'.
─────╯
================================================
FILE: tests/typesystem/unknown_top_level_atoms.eclair
================================================
// RUN: mkdir -p %t && sed s@TEST_DIR@%t@g %s > %t/input.test
// RUN: split-file %t/input.test %t
// RUN: %eclair compile %t/program.eclair 2> %t/actual.out
// RUN: diff %t/expected.out %t/actual.out
//--- program.eclair
edge(1, 2).
path(3, 4).
@def result(u32) output.
//--- expected.out
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@1:1-1:12
│
1 │ edge(1, 2).
• ┬──────────
• ╰╸ Could not find a type definition for 'edge'.
•
│ Hint: Add a type definition for 'edge'.
│ Hint: Add an extern definition for 'edge'.
─────╯
[error]: Missing type definition
╭──▶ TEST_DIR/program.eclair@2:1-2:12
│
2 │ path(3, 4).
• ┬──────────
• ╰╸ Could not find a type definition for 'path'.
•
│ Hint: Add a type definition for 'path'.
│ Hint: Add an extern definition for 'path'.
─────╯
================================================
FILE: tests/typesystem/valid.eclair
================================================
// RUN: %eclair compile %s --emit ra-transformed | FileCheck %s
// CHECK: project
@def fact1(u32, string).
@def fact2(string, string).
fact1(1, "a").
fact2("abc", "def").
@def edge(u32, u32) input.
@def reachable(u32, u32) output.
reachable(x, y) :- edge(x, y).
reachable(1, 2) :- edge(x, x).
@def fact3(u32, u32) input.
@def fact4(u32).
fact4(123) :-
fact3(123, 456).
@def fact5(u32).
@def fact6(u32, u32) input.
fact5(123) :-
fact6(x, x).
@def fact7(u32) input.
@def fact8(u32, string).
@def fact9(string) input.
fact8(x, y) :-
fact7(x),
fact9(y).
@def fact10(u32, u32, string) input.
@def fact11(u32).
fact11(x) :-
fact10(x, _, _),
fact10(_, x, _).
@def fact12(u32, u32) input.
@def fact13(u32).
fact13(x) :-
fact12(x, _),
x = 123.
fact13(x) :-
fact12(x, _),
123 = x.
fact13(x) :-
fact12(x, y),
x = y.
fact13(x) :-
fact12(x, _),
123 = 456.
fact13(x) :-
fact12(x, _),
"abc" = "def".
@def fact14(string, string) input.
@def fact15(string).
fact15(x) :-
fact14(x, _),
"abc" = x.
fact15(x) :-
fact14(x, _),
x = "abc".
@def fact16(u32, u32) input.
@def fact17(u32) output.
fact17(x) :-
x = y,
fact16(x, z),
y = z.
fact17(x) :-
x = y,
y = z,
fact16(x, z).
@def fact18(u32) input.
@def fact19(u32) output.
fact19(x) :-
fact18(x),
!fact18(2),
!fact18(x + 1).
================================================
FILE: tests/utils/extract_snippet
================================================
#!/bin/bash
# Print lines starting from a match on a pattern ($2), up to first empty line.
# Use sed again to trim the trailing newline
sed -n "/^.*$2.*/,/^\$/p" $1 | sed '/^$/d'
