diff --git a/CHANGELOG.md b/CHANGELOG.md --- 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 --- 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 @@ 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 @@ 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 --- 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 @@ rbrace { Special $$ "}" } funcArrow { FuncType _ $$ } plainArrow { Arrow $$ "=>" } + clorefArrow { Arrow $$ "=" } cloref1Arrow { Arrow $$ "=" } cloptr1Arrow { Arrow $$ "=" } lincloptr1Arrow { Arrow $$ "=" } @@ -426,6 +428,7 @@ 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 @@ | 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 --- /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 --- /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 --- /dev/null +++ b/test/data/cloref.dats @@ -0,0 +1,7 @@ +staload "SATS/dlist.sats" + +implement empty = + @{ f = lam x = 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 --- /dev/null +++ b/test/data/cloref.out @@ -0,0 +1,7 @@ +staload "SATS/dlist.sats" + +implement empty = + @{ f = lam x = 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 --- /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 --- /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 --- a/test/data/stack.out +++ /dev/null @@ -1,38 +0,0 @@ -%{# -#include -%} - -// 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"