Skip to content

Commit

Permalink
Merge'origin/feature/simplify' into feature/borrow
Browse files Browse the repository at this point in the history
  • Loading branch information
@anfelor
anfelor committed Aug 23, 2021
2 parents 9ec87a4 + cc6b7b6 commit 791bd12
Show file tree
Hide file tree
Showing 45 changed files with 1,113 additions and 526 deletions.
1 change: 1 addition & 0 deletions .gitignore
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
.trash/
.idea/
.vs/
.vscode/
node_modules/
out/
bundle/
Expand Down
28 changes: 1 addition & 27 deletions kklib/ide/vs2019/kklib-test-interactive.vcxproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -158,36 +158,10 @@
</ItemGroup>
<ItemGroup>
<ClCompile Include="..\..\..\out\Debug\interactive.c" />
<ClCompile Include="..\..\..\out\Debug\samples_basic_garsia_dash_wachs.c" />
<ClCompile Include="..\..\..\out\Debug\std_core.c" />
<ClCompile Include="..\..\..\out\Debug\std_core_hnd.c" />
<ClCompile Include="..\..\..\out\Debug\std_core_types.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_ddouble.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_decimal.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_double.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_int32.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_random.c" />
<ClCompile Include="..\..\..\out\Debug\std_os_dir.c" />
<ClCompile Include="..\..\..\out\Debug\std_os_env.c" />
<ClCompile Include="..\..\..\out\Debug\std_os_file.c" />
<ClCompile Include="..\..\..\out\Debug\std_os_path.c" />
<ClCompile Include="..\..\..\out\Debug\std_text_parse.c" />
<ClCompile Include="..\..\..\out\Debug\std_time.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_calendar.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_calendars.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_chrono.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_date.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_duration.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_format.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_instant.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_locale.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_parse.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_time.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_timer.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_timestamp.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_utc.c" />
<ClCompile Include="..\..\..\out\Debug\test_algeff_implicits.c" />
<ClCompile Include="..\..\..\out\Debug\test_lib_time11.c" />
<ClCompile Include="..\..\..\out\Debug\test_algeff_effs5a.c" />
</ItemGroup>
<Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
<ImportGroup Label="ExtensionTargets">
Expand Down
28 changes: 1 addition & 27 deletions kklib/ide/vs2019/kklib-test-interactive.vcxproj.filters
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,32 +5,6 @@
<ClCompile Include="..\..\..\out\Debug\std_core_hnd.c" />
<ClCompile Include="..\..\..\out\Debug\std_core_types.c" />
<ClCompile Include="..\..\..\out\Debug\interactive.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_ddouble.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_decimal.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_double.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_int32.c" />
<ClCompile Include="..\..\..\out\Debug\std_num_random.c" />
<ClCompile Include="..\..\..\out\Debug\std_os_dir.c" />
<ClCompile Include="..\..\..\out\Debug\std_os_env.c" />
<ClCompile Include="..\..\..\out\Debug\std_os_file.c" />
<ClCompile Include="..\..\..\out\Debug\std_os_path.c" />
<ClCompile Include="..\..\..\out\Debug\std_text_parse.c" />
<ClCompile Include="..\..\..\out\Debug\std_time.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_calendar.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_calendars.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_chrono.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_date.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_duration.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_format.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_instant.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_locale.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_parse.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_time.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_timer.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_timestamp.c" />
<ClCompile Include="..\..\..\out\Debug\std_time_utc.c" />
<ClCompile Include="..\..\..\out\Debug\test_lib_time11.c" />
<ClCompile Include="..\..\..\out\Debug\samples_basic_garsia_dash_wachs.c" />
<ClCompile Include="..\..\..\out\Debug\test_algeff_implicits.c" />
<ClCompile Include="..\..\..\out\Debug\test_algeff_effs5a.c" />
</ItemGroup>
</Project>
6 changes: 3 additions & 3 deletions koka.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -129,7 +129,7 @@ executable koka
CPP
OverloadedStrings
ghc-options: -rtsopts -j8
cpp-options: -DKOKA_MAIN="koka" -DKOKA_VARIANT="release" -DKOKA_VERSION="2.2.0"
cpp-options: -DKOKA_MAIN="koka" -DKOKA_VARIANT="release" -DKOKA_VERSION="2.2.0" -DREADLINE=0
include-dirs:
src/Platform/cpp/Platform
c-sources:
Expand All @@ -142,7 +142,7 @@ executable koka
, bytestring
, containers
, directory
, haskeline
, isocline >=1.0.1
, mtl
, parsec
, process
Expand Down Expand Up @@ -170,9 +170,9 @@ test-suite koka-test
, directory
, extra
, filepath
, haskeline
, hspec
, hspec-core
, isocline >=1.0.1
, json
, mtl
, parsec
Expand Down
24 changes: 12 additions & 12 deletions lib/std/core/hnd.kk
View file
Original file line number Diff line number Diff line change
Expand Up @@ -451,7 +451,7 @@ private inline extern eq( ^x : int, ^y : int) : bool {

public fun initially(init : (int) -> e (), action : () -> e a ) : e a {
init(0)
if (yielding()) return yield-extend(fn(_ret){ initially-prompt(init,action()) })
if (yielding()) return yield-extend(fn(_ret:()){ initially-prompt(init,action()) })
initially-prompt(init, action() )
}

Expand Down Expand Up @@ -498,15 +498,15 @@ public fun finalize( r : resume-context<b,e,e0,r>, x : r ) : e r {
// Clauses
// -------------------------------------------

abstract type clause1<a,b,h,e,r> {
abstract type clause1<a,b,h,e::E,r> {
Clause1( clause: (marker<e,r>, ev<h>, a) -> e b )
}

private inline extern cast-ev0( f : (marker<e1,r>,ev<h>) -> e1 b) : e ((marker<e1,r>,ev<h>) -> e b) { inline "#1" }
private inline extern cast-ev1( f : (marker<e1,r>,ev<h>,a) -> e1 b) : e ((marker<e1,r>,ev<h>,a) -> e b) { inline "#1" }
private inline extern cast-ev2( f : (marker<e1,r>,ev<h>,a1,a2) -> e1 b) : e ((marker<e1,r>,ev<h>,a1,a2) -> e b) { inline "#1" }

public fun ".perform1"( ev : ev<h>, op : (forall<e1,r> h<e1,r> -> clause1<a,b,h,e1,r>), x : a ) : e b {
public noinline fun ".perform1"( ev : ev<h>, op : (forall<e1,r> h<e1,r> -> clause1<a,b,h,e1,r>), x : a ) : e b {
match(ev) {
Ev(_tag,m,h,_c,_w) -> match(h.op) {
Clause1(f) -> cast-ev1(f)(m,ev,x)
Expand Down Expand Up @@ -597,7 +597,7 @@ abstract type clause0<b,h,e,r> {
Clause0( clause: (marker<e,r>, ev<h>) -> e b )
}

public fun ".perform0"( ev : ev<h>, op : (forall<e1,r> h<e1,r> -> clause0<b,h,e1,r>) ) : e b {
public noinline fun ".perform0"( ev : ev<h>, op : (forall<e1,r> h<e1,r> -> clause0<b,h,e1,r>) ) : e b {
match(ev) {
Ev(_tag,m,h,_c,_w) -> match(h.op) {
Clause0(f) -> cast-ev0(f)(m,ev)
Expand Down Expand Up @@ -689,7 +689,7 @@ public fun clause-tail-noyield2<e,r,a1,a2,b>(op : (a1,a2) -> e b) : clause2<a1,a
Clause2(fn(_m,_ev,x1,x2){ op(x1,x2) })
}

public fun ".perform2"( evx : ev<h>, op : (forall<e1,r> h<e1,r> -> clause2<a,b,c,h,e1,r>), x : a, y : b ) : e c {
public noinline fun ".perform2"( evx : ev<h>, op : (forall<e1,r> h<e1,r> -> clause2<a,b,c,h,e1,r>), x : a, y : b ) : e c {
match(evx) {
Ev(_tag,m,h,_c,_w) -> match(h.op) {
Clause2(f) -> cast-ev2(f)(m,evx,x,y)
Expand Down Expand Up @@ -810,47 +810,47 @@ public fun ".open-none4"<a1,a2,a3,a4,b,e1,e2>( f : (a1,a2,a3,a4) -> e1 b, x1 : a
}


private fun open-at1<a,b,e1,e2>( i: ev-index, f : a -> e1 b, x : a ) : e2 b {
private noinline fun open-at1<a,b,e1,e2>( i: ev-index, f : a -> e1 b, x : a ) : e2 b {
val w = evv-swap-create1(i)
val y = cast-ev1(f)(x)
evv-set(w)
if (yielding()) return yield-cont(fn(cont,res){ open-at1(unsafe-decreasing(i),cont,res) })
y
}

public fun ".open-at0"<b,e1,e2>( i: ev-index, f : () -> e1 b ) : e2 b {
public noinline fun ".open-at0"<b,e1,e2>( i: ev-index, f : () -> e1 b ) : e2 b {
val w = evv-swap-create1(i)
val y = cast-ev0(f)()
evv-set(w)
if (yielding()) return yield-cont(fn(cont,res){ open-at1(i,cont,res) })
y
}

public fun ".open-at1"<a,b,e1,e2>( i: ev-index, f : a -> e1 b, x : a ) : e2 b {
public noinline fun ".open-at1"<a,b,e1,e2>( i: ev-index, f : a -> e1 b, x : a ) : e2 b {
val w = evv-swap-create1(i)
val y = cast-ev1(f)(x)
evv-set(w)
if (yielding()) return yield-cont(fn(cont,res){ open-at1(i,cont,res) })
y
}

public fun ".open-at2"<a1,a2,b,e1,e2> ( i: ev-index, f : (a1,a2) -> e1 b, x1 : a1, x2 : a2 ) : e2 b {
public noinline fun ".open-at2"<a1,a2,b,e1,e2> ( i: ev-index, f : (a1,a2) -> e1 b, x1 : a1, x2 : a2 ) : e2 b {
val w = evv-swap-create1(i)
val y = cast-ev2(f)(x1,x2)
evv-set(w)
if (yielding()) return yield-cont(fn(cont,res){ open-at1(i,cont,res) })
y
}

public fun ".open-at3"<a1,a2,a3,b,e1,e2> ( i: ev-index, f : (a1,a2,a3) -> e1 b, x1 : a1, x2 : a2, x3 : a3 ) : e2 b {
public noinline fun ".open-at3"<a1,a2,a3,b,e1,e2> ( i: ev-index, f : (a1,a2,a3) -> e1 b, x1 : a1, x2 : a2, x3 : a3 ) : e2 b {
val w = evv-swap-create1(i)
val y = cast-ev3(f)(x1,x2,x3)
evv-set(w)
if (yielding()) return yield-cont(fn(cont,res){ open-at1(i,cont,res) })
y
}

public fun ".open-at4"<a1,a2,a3,a4,b,e1,e2> ( i: ev-index, f : (a1,a2,a3,a4) -> e1 b, x1 : a1, x2 : a2, x3 : a3, x4 : a4 ) : e2 b {
public noinline fun ".open-at4"<a1,a2,a3,a4,b,e1,e2> ( i: ev-index, f : (a1,a2,a3,a4) -> e1 b, x1 : a1, x2 : a2, x3 : a3, x4 : a4 ) : e2 b {
val w = evv-swap-create1(i)
val y = cast-ev4(f)(x1,x2,x3,x4)
evv-set(w)
Expand All @@ -859,7 +859,7 @@ public fun ".open-at4"<a1,a2,a3,a4,b,e1,e2> ( i: ev-index, f : (a1,a2,a3,a4) ->
}


private fun open1<a,b,e1,e2>( indices : vector<ev-index>, f : a -> e1 b, x : a ) : e2 b {
private noinline fun open1<a,b,e1,e2>( indices : vector<ev-index>, f : a -> e1 b, x : a ) : e2 b {
val w = evv-swap-create(indices)
val y = cast-ev1(f)(x)
evv-set(w)
Expand Down
12 changes: 7 additions & 5 deletions lib/std/core/types.kk
View file
Original file line number Diff line number Diff line change
Expand Up @@ -181,6 +181,9 @@ fun hbox( x : a ) : hbox<a> {
Hbox(x)
}

noinline fun keep( x : a ) : a {
x
}

// ----------------------------------------------------------------------------
// Standard functions
Expand All @@ -204,12 +207,11 @@ fun (||)( x : bool, y : bool) : bool { // inlined in the compiler for short-circ
// inline extern (&&) : (bool,bool) -> bool { inline "(#1 && #2)" }
// inline extern (||) : (bool,bool) -> bool { inline "(#1 || #2)" }

// for efficiency we use extern here (for now)
// fun (!)( b : bool ) : bool = if (x) then false else true
// fun not( b : bool ) : bool = if (x) then false else true
fun (!)( b : bool ) : bool = if (b) then False else True
fun not( b : bool ) : bool = if (b) then False else True

inline extern not : (bool) -> bool { inline "!(#1)" }
inline extern (!) : (bool) -> bool { inline "!(#1)" }
//inline extern not : (bool) -> bool { inline "!(#1)" }
//inline extern (!) : (bool) -> bool { inline "!(#1)" }

// needed for markers in `std/core/hnd`.
inline extern zero32() : int32 { inline "0" }
Expand Down
18 changes: 9 additions & 9 deletions lib/std/num/double.kk
View file
Original file line number Diff line number Diff line change
Expand Up @@ -116,28 +116,28 @@ private extern make-neginf() : double {


// Is this value equal to NaN ?
inline extern is-nan : (double) -> bool {
inline extern is-nan(d:double) : bool {
c inline "isnan(#1)"
cs "double.IsNaN"
js "isNaN"
}

// Is this value equal to negative or positive infinity ?
extern is-inf : (double) -> bool {
extern is-inf(d:double) : bool {
c inline "isinf(#1)"
cs "double.IsInfinity"
js inline "((#1) === Infinity || (#1) === -Infinity)"
}

// Is this value equal to positive infinity ?
inline extern is-posinf : (double) -> bool {
inline extern is-posinf(d:double) : bool {
c inline "(isinf(#1) && !signbit(#1))"
cs "double.IsPositiveInfinity"
js inline "((#1) === Infinity)"
}

// Is this value equal to negative infinity ?
inline extern is-neginf : (double) -> bool {
inline extern is-neginf(d:double) : bool {
c inline "(isinf(#1) && signbit(#1))"
cs "double.IsNegativeInfinity"
js inline "((#1) === -Infinity)"
Expand Down Expand Up @@ -169,14 +169,14 @@ fun is-subnormal( d :double ) : bool {

// Round a double to its nearest integral value.
// If the value is halfway between two integers, the value is rounded to the even one.
inline extern round : (d:double) -> double {
inline extern round(d:double) : double {
c "round" // assume the rounding mode is set correctly by kklib
cs "Math.Round"
js "$std_core._double_round"
}

// Return the largest integer equal or less than `d`
inline extern floor : (d:double) -> double {
inline extern floor(d:double) : double {
c "floor"
cs "Math.Floor"
js "Math.floor"
Expand Down Expand Up @@ -236,22 +236,22 @@ extern fmadd( x : double, y : double, z : double ) : double {
// Return the square root of a value `d`
// Returns `nan` if `d == nan` or if `d` is negative.
// Returns `inf` if `d == inf` .
inline extern sqrt : (d:double) -> double {
inline extern sqrt(d:double) : double {
c "sqrt"
cs "Math.Sqrt"
js "Math.sqrt"
}


// Return the `d` raised to the power of `p`.
inline extern pow : (d:double, p:double) -> double {
inline extern pow(d:double, p:double) : double {
c "pow"
cs "Math.Pow"
js "Math.pow"
}

// Return the natural logarithm (in base _e_) of a `:double` `d`
inline extern log : (d:double) -> double {
inline extern log(d:double) : double {
c "log"
cs "Math.Log"
js "Math.log"
Expand Down
6 changes: 3 additions & 3 deletions package.yaml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,8 +28,8 @@ dependencies:
- process
- text
- time
- haskeline

- isocline >= 1.0.1
executables:
koka:
main: Main.hs
Expand All @@ -54,7 +54,7 @@ executables:
- -DKOKA_MAIN="koka"
- -DKOKA_VARIANT="release"
- -DKOKA_VERSION="2.2.0"
# - -DREADLINE=1 # to avoid using Haskeline
- -DREADLINE=0 # 1:getline, 2:readline, 3:haskeline, or 0:isocline
when:
- condition: os(windows)
cpp-options: -DWINDOWS
Expand Down
5 changes: 3 additions & 2 deletions src/Backend/C/FromCore.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -941,7 +941,7 @@ genDupDropCall isDup tp arg = if (isDup) then genDupDropCallX "dup" tp (parens a

genIsUniqueCall :: Type -> Doc -> [Doc]
genIsUniqueCall tp arg = case genDupDropCallX "is_unique" tp (parens arg) of
-- [call] -> [text "kk_likely" <.> parens call]
[call] -> [text "kk_likely" <.> parens call]
cs -> cs

genFreeCall :: Type -> Doc -> [Doc]
Expand Down Expand Up @@ -1999,10 +1999,11 @@ isInlineableExpr expr
TypeApp expr _ -> isInlineableExpr expr
TypeLam _ expr -> isInlineableExpr expr
Lit (LitString _)-> False

-- C has no guarantee on argument evaluation so we only allow a select few operations to be inlined
App (Var v (InfoExternal _)) [] -> getName v `elem` [nameYielding,nameReuseNull,nameCFieldHole]
-- App (Var v (InfoExternal _)) [arg] | getName v `elem` [nameBox,nameDup,nameInt32] -> isInlineableExpr arg
App (Var v _) [arg] | getName v `elem` [nameBox,nameInt32,nameReuse,nameIsUnique] -> isInlineableExpr arg
App (Var v _) [arg] | getName v `elem` [nameBox,nameInt32,nameReuse,nameReuseIsValid,nameIsUnique] -> isInlineableExpr arg

--App (Var _ (InfoExternal _)) args -> all isPureExpr args -- yielding() etc.

Expand Down
2 changes: 1 addition & 1 deletion src/Backend/C/ParcReuseSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -182,7 +182,7 @@ genReuseIfValid reuseName onValid onInvalid

genReuseIsValid :: TName -> Expr
genReuseIsValid reuseName
= App (Var (TName nameReuseIsValid typeReuseIsValid) (InfoExternal [(C,"#1!=NULL")])) [Var reuseName InfoNone]
= App (Var (TName nameReuseIsValid typeReuseIsValid) (InfoExternal [(C,"kk_likely(#1!=NULL)")])) [Var reuseName InfoNone]
where
typeReuseIsValid = TFun [(nameNil,typeReuse)] typeTotal typeBool

Expand Down
Loading

0 comments on commit 791bd12

Please sign in to comment.