summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorvmchale <>2020-08-14 00:09:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-08-14 00:09:00 (GMT)
commita656c4ac8923ef61b3dac216dc2b9fedc72b075d (patch)
treef5286c19fdc4b9ff4335019e208b04fd70a58494
parentfc887211aa44a3b198be5d9f6c285583710cb5a0 (diff)
version 1.7.10.2HEAD1.7.10.2master
-rw-r--r--CHANGELOG.md5
-rw-r--r--language-ats.cabal6
-rw-r--r--src/Language/ATS/Parser.y5
-rw-r--r--test/data/arrptr.dats28
-rw-r--r--test/data/arrptr.out27
-rw-r--r--test/data/cloref.dats7
-rw-r--r--test/data/cloref.out7
-rw-r--r--test/data/stack-array.dats14
-rw-r--r--test/data/stack-array.out14
-rw-r--r--test/data/stack.out38
10 files changed, 109 insertions, 42 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index c2a01a3..d248f00 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,10 @@
# language-ats
+# 1.7.10.12
+
+ * Add `Exception` instance for parse errors
+ * Work with `cloref` arrows
+
# 1.7.10.11
* Fix bug where left shift was printed as right shift
diff --git a/language-ats.cabal b/language-ats.cabal
index 7cfe50c..e7a28da 100644
--- a/language-ats.cabal
+++ b/language-ats.cabal
@@ -1,6 +1,6 @@
cabal-version: 1.18
name: language-ats
-version: 1.7.10.1
+version: 1.7.10.2
license: BSD3
license-file: LICENSE
copyright: Copyright: (c) 2018-2019 Vanessa McHale
@@ -61,7 +61,7 @@ library
ghc-options: -Wall -O2
build-depends:
- base >=4.9 && <5,
+ base >=4.11 && <5,
array -any,
recursion >=2.2.3.0,
microlens >=0.3.0.0,
@@ -106,7 +106,7 @@ benchmark language-ats-bench
main-is: Bench.hs
hs-source-dirs: bench
default-language: Haskell2010
- ghc-options: -Wall -O2
+ ghc-options: -Wall -O2 -rtsopts -with-rtsopts=-A9M
build-depends:
base -any,
language-ats -any,
diff --git a/src/Language/ATS/Parser.y b/src/Language/ATS/Parser.y
index bd42fea..8f8429e 100644
--- a/src/Language/ATS/Parser.y
+++ b/src/Language/ATS/Parser.y
@@ -12,6 +12,7 @@
import Control.Composition
import Control.DeepSeq (NFData)
+import Control.Exception (Exception)
import qualified Data.Map as M
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
@@ -183,6 +184,7 @@ import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
rbrace { Special $$ "}" }
funcArrow { FuncType _ $$ }
plainArrow { Arrow $$ "=>" }
+ clorefArrow { Arrow $$ "=<cloref>" }
cloref1Arrow { Arrow $$ "=<cloref1>" }
cloptr1Arrow { Arrow $$ "=<cloptr1>" }
lincloptr1Arrow { Arrow $$ "=<lincloptr1>" }
@@ -426,6 +428,7 @@ CaseArrow :: { LambdaType AlexPosn }
LambdaArrow :: { LambdaType AlexPosn }
: plainArrow { Plain $1 }
+ | clorefArrow { Full $1 "cloref" }
| cloref1Arrow { Full $1 "cloref1" } -- FIXME this is a bad heuristic
| cloptr1Arrow { Full $1 "cloptr1" }
| lincloptr1Arrow { Full $1 "lincloptr1" }
@@ -1114,7 +1117,7 @@ data ATSError = Expected AlexPosn String String
| Unknown Token
| LexError String
| Exhausted
- deriving (Eq, Show, Generic, NFData)
+ deriving (Eq, Show, Generic, NFData, Exception)
unmatched :: AlexPosn -> String -> Doc
unmatched l chr = "unmatched" <+> squotes (text chr) <+> "at" <+> pretty l <> linebreak
diff --git a/test/data/arrptr.dats b/test/data/arrptr.dats
new file mode 100644
index 0000000..899d535
--- /dev/null
+++ b/test/data/arrptr.dats
@@ -0,0 +1,28 @@
+#include "share/atspre_staload.hats"
+
+staload "SATS/futhark.sats"
+staload "SATS/futhark-arr.sats"
+staload "SATS/futhark-stats.sats"
+staload "SATS/futhark-linalg.sats"
+
+implement main0 () =
+ {
+ val arr0 = $arrpsz{float}(1.0f, 2.0f, 3.0f)
+ var arr1 = $arrpsz{float}(1.0f, 2.0f, 3.0f)
+ val ctx_cfg = futhark_context_config_new()
+ val ctx = futhark_context_new(ctx_cfg)
+ val fut_arr0 = futhark_new_f32_1d(ctx, arr0, 3)
+ val fut_arr1 = futhark_new_f32_1d(ctx, arr1, 3)
+ var ret: float
+ val _ = futhark_entry_mean_f32(ctx, ret, fut_arr0)
+ val () = println!(ret)
+ val _ = futhark_entry_dotprod_f32(ctx, ret, fut_arr0, fut_arr1)
+ val () = println!(ret)
+ val _ = futhark_free_f32_1d(ctx, fut_arr0)
+ val _ = futhark_free_f32_1d(ctx, fut_arr1)
+ val () = futhark_context_free(ctx)
+ val () = futhark_context_config_free(ctx_cfg)
+ val () = arrayptr_free(arr0)
+ val () = arrayptr_free(arr1)
+ }
+
diff --git a/test/data/arrptr.out b/test/data/arrptr.out
new file mode 100644
index 0000000..5572cd3
--- /dev/null
+++ b/test/data/arrptr.out
@@ -0,0 +1,27 @@
+#include "share/atspre_staload.hats"
+
+staload "SATS/futhark.sats"
+staload "SATS/futhark-arr.sats"
+staload "SATS/futhark-stats.sats"
+staload "SATS/futhark-linalg.sats"
+
+implement main0 () =
+ {
+ val arr0 = $arrpsz{float}(1.0f, 2.0f, 3.0f)
+ var arr1 = $arrpsz{float}(1.0f, 2.0f, 3.0f)
+ val ctx_cfg = futhark_context_config_new()
+ val ctx = futhark_context_new(ctx_cfg)
+ val fut_arr0 = futhark_new_f32_1d(ctx, arr0, 3)
+ val fut_arr1 = futhark_new_f32_1d(ctx, arr1, 3)
+ var ret: float
+ val _ = futhark_entry_mean_f32(ctx, ret, fut_arr0)
+ val () = println!(ret)
+ val _ = futhark_entry_dotprod_f32(ctx, ret, fut_arr0, fut_arr1)
+ val () = println!(ret)
+ val _ = futhark_free_f32_1d(ctx, fut_arr0)
+ val _ = futhark_free_f32_1d(ctx, fut_arr1)
+ val () = futhark_context_free(ctx)
+ val () = futhark_context_config_free(ctx_cfg)
+ val () = arrayptr_free(arr0)
+ val () = arrayptr_free(arr1)
+ }
diff --git a/test/data/cloref.dats b/test/data/cloref.dats
new file mode 100644
index 0000000..1c543ee
--- /dev/null
+++ b/test/data/cloref.dats
@@ -0,0 +1,7 @@
+staload "SATS/dlist.sats"
+
+implement empty =
+ @{ f = lam x =<cloref> x }
+
+implement to_list (x) =
+ x.f(list_nil())
diff --git a/test/data/cloref.out b/test/data/cloref.out
new file mode 100644
index 0000000..1c543ee
--- /dev/null
+++ b/test/data/cloref.out
@@ -0,0 +1,7 @@
+staload "SATS/dlist.sats"
+
+implement empty =
+ @{ f = lam x =<cloref> x }
+
+implement to_list (x) =
+ x.f(list_nil())
diff --git a/test/data/stack-array.dats b/test/data/stack-array.dats
new file mode 100644
index 0000000..1f2bc66
--- /dev/null
+++ b/test/data/stack-array.dats
@@ -0,0 +1,14 @@
+staload "SATS/futhark.sats"
+staload "SATS/futhark-arr.sats"
+staload "SATS/futhark-stats.sats"
+
+implement main0 () =
+ {
+ var arr = @[float](1.0f, 2.0f, 3.0f)
+ val ctx_cfg = futhark_context_config_new()
+ val ctx = futhark_context_new(ctx_cfg)
+ val fut_arr = futhark_new_f32_1d(ctx, arr, 3)
+ val _ = futhark_free_f32_1d(ctx, fut_arr)
+ val () = futhark_context_free(ctx)
+ val () = futhark_context_config_free(ctx_cfg)
+ }
diff --git a/test/data/stack-array.out b/test/data/stack-array.out
new file mode 100644
index 0000000..1f2bc66
--- /dev/null
+++ b/test/data/stack-array.out
@@ -0,0 +1,14 @@
+staload "SATS/futhark.sats"
+staload "SATS/futhark-arr.sats"
+staload "SATS/futhark-stats.sats"
+
+implement main0 () =
+ {
+ var arr = @[float](1.0f, 2.0f, 3.0f)
+ val ctx_cfg = futhark_context_config_new()
+ val ctx = futhark_context_new(ctx_cfg)
+ val fut_arr = futhark_new_f32_1d(ctx, arr, 3)
+ val _ = futhark_free_f32_1d(ctx, fut_arr)
+ val () = futhark_context_free(ctx)
+ val () = futhark_context_config_free(ctx_cfg)
+ }
diff --git a/test/data/stack.out b/test/data/stack.out
deleted file mode 100644
index 3e394bd..0000000
--- a/test/data/stack.out
+++ /dev/null
@@ -1,38 +0,0 @@
-%{#
-#include <stdatomic.h>
-%}
-
-// BASIC APPROACH: we want to instead modify an intermediate stack, which will
-// be swapped with whatever pointer using atomic_compare_swap?
-typedef aptr(l: addr) = $extype "_Atomic void**"
-
-absview pf_free(l: addr)
-
-datavtype pointer_t(a: vt@ype) =
- | pointer_t of node_t(a)
- | none_t
-and node_t(a: vt@ype) =
- | node_t of @{ value = [ l : addr | l > null ] (a @ l, pf_free(l) | aptr(l))
- , next = pointer_t(a)
- }
-
-vtypedef stack_t(a: vt@ype) = @{ stack_head = pointer_t(a) }
-
-castfn release_stack {a:vt@ype} (stack_t(a)) : void
-
-fun new {a:vt@ype} (&stack_t(a)? >> stack_t(a)) : void
-
-fun {a:vt@ype} push (&stack_t(a) >> stack_t(a), a) : void
-
-fun {a:vt@ype} pop (&stack_t(a) >> _) : Option_vt(a)
-
-fn atomic_store {a:vt@ype}{ l : addr | l > null }(a? @ l | aptr(l), a) : (a @ l | void) =
- "mac#"
-
-// FIXME: should this return a pf_free?
-fn atomic_load {a:vt@ype}{ l : addr | l > null }(a @ l, pf_free(l) | aptr(l)) : a =
- "mac#"
-
-fn amalloc {a:vt@ype}{ sz : int | sz == sizeof(a) }(sz : size_t(sz)) :
- [ l : addr | l > null ] (a? @ l, pf_free(l) | aptr(l)) =
- "mac#malloc"