Last active
August 29, 2015 14:16
-
-
Save amosr/3284cff8cd1b34355a22 to your computer and use it in GitHub Desktop.
ddc php backend
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module List | |
-- (actually List.ds but changed extension for syntax highlighting) | |
import foreign c value | |
q_string_concat : String -> String -> String | |
where | |
-- | A `Maybe` may contain a value, or not. | |
data Maybe (a : Data) where | |
Nothing : Maybe a | |
Just : a -> Maybe a | |
-- | Standard Cons-lists. | |
data List (a : Data) where | |
Nil : List a | |
Cons : a -> List a -> List a | |
-- Constructors --------------------------------------------------------------- | |
-- | Construct a list containing a single element. | |
singleton (x : a) : List a | |
= Cons x Nil | |
-- | Construct a list of the given length where all elements are' | |
-- the same value. | |
replicate (n : Nat) (x : a) : List a | |
| eq# n 0 = Nil | |
| otherwise = Cons x (replicate (sub# n 1) x) | |
-- | Construct a range of values. | |
enumFromTo (start : Nat) (end : Nat) : List Nat | |
| ge# start end = singleton start | |
| otherwise = Cons start (enumFromTo (add# start 1) end) | |
-- | Append two lists. | |
append (xx yy : List a) : List a | |
= case xx of | |
Nil -> yy | |
Cons x xs -> Cons x (append xs yy) | |
-- | Reverse the elements of a list. | |
-- This is a naive O(n^2) version for testing purposes. | |
reverse (xx : List a) : List a | |
= case xx of | |
Nil -> Nil | |
Cons x xs -> append (reverse xs) (singleton x) | |
-- Projections ---------------------------------------------------------------- | |
-- | Take the length of a list. | |
length (xx : List a) : Nat | |
= case xx of | |
Nil -> 0 | |
Cons x xs -> add# 1 (length xs) | |
-- Combinators ---------------------------------------------------------------- | |
-- | Apply a worker function to every element of a list, yielding a new list. | |
map (f : a -> b) (xx : List a) : List b | |
= case xx of | |
Nil -> Nil | |
Cons x xs -> Cons (f x) (map f xs) | |
-- | Apply a stateful worker function to every element of a list, | |
-- yielding a new list. | |
-- The worker is applied to the source elements left-to-right. | |
mapS (f : a -> S e b) (xx : List a) : S e (List b) | |
= box case xx of | |
Nil -> Nil | |
Cons x xs -> Cons (run f x) (run mapS f xs) | |
-- | Apply a function to all elements of a list, yielding nothing. | |
forS (xx : List a) (f : a -> S e Unit) : S e Unit | |
= box case xx of | |
Nil -> () | |
Cons x xs | |
-> do run f x | |
run forS xs f | |
-- | Reduce a list with a binary function and zero value, | |
-- from left to right. | |
foldl (f : b -> a -> b) (z : b) (xx : List a) : b | |
= case xx of | |
Nil -> z | |
Cons x xs -> foldl f (f z x) xs | |
-- | Keep only those elements that match the given predicate. | |
filter (p : a -> Bool) (xx : List a) : List a | |
= case xx of | |
Nil -> Nil | |
Cons x xs | |
-> if p x | |
then Cons x (filter p xs) | |
else filter p xs | |
concat_strings (xs : List String) : String | |
= foldl q_string_concat "" xs |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<?php | |
class Nothing { | |
function __construct() { | |
$this->tag = "Nothing"; | |
} | |
} | |
class Just { | |
function __construct($_1) { | |
$this->_1 = $_1; | |
$this->tag = "Just"; | |
} | |
} | |
class Nil { | |
function __construct() { | |
$this->tag = "Nil"; | |
} | |
} | |
class Cons { | |
function __construct($_1, $_2) { | |
$this->_1 = $_1; | |
$this->_2 = $_2; | |
$this->tag = "Cons"; | |
} | |
} | |
/* Let SourcePos {sourcePosSource = "<top level>", sourcePosLine = 1, sourcePosColumn = 1} */ | |
function singleton($x) { | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 20, sourcePosColumn = 4} */ | |
$x0 = new Nil(); | |
return new Cons($x, $x0); | |
}function replicate($n, $x) { | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 26, sourcePosColumn = 2} */ | |
$x1 = ($n == 0); | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 26, sourcePosColumn = 2} */ | |
$SCRUT = $x1; | |
if ($SCRUT == true) { | |
return new Nil(); | |
} | |
else{ | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 27, sourcePosColumn = 27} */ | |
$x2 = ($n - 1); | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 27, sourcePosColumn = 19} */ | |
$x3 = replicate($x2, $x); | |
return new Cons($x, $x3); | |
} | |
}function enumFromTo($start, $end) { | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 32, sourcePosColumn = 2} */ | |
$x4 = ($start >= $end); | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 32, sourcePosColumn = 2} */ | |
$SCRUT = $x4; | |
if ($SCRUT == true) { | |
return singleton($start); | |
} | |
else{ | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 33, sourcePosColumn = 31} */ | |
$x5 = ($start + 1); | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 33, sourcePosColumn = 19} */ | |
$x6 = enumFromTo($x5, $end); | |
return new Cons($start, $x6); | |
} | |
}function append($xx, $yy) { | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 38, sourcePosColumn = 4} */ | |
$SCRUT = $xx; | |
if ($SCRUT->tag == "Nil") { | |
return $yy; | |
} | |
elseif ($SCRUT->tag == "Cons") { | |
$x = $SCRUT->_1; | |
$xs = $SCRUT->_2; | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 40, sourcePosColumn = 28} */ | |
$x7 = append($xs, $yy); | |
return new Cons($x, $x7); | |
} | |
}function reverse($xx) { | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 45, sourcePosColumn = 4} */ | |
$SCRUT = $xx; | |
if ($SCRUT->tag == "Nil") { | |
return new Nil(); | |
} | |
elseif ($SCRUT->tag == "Cons") { | |
$x = $SCRUT->_1; | |
$xs = $SCRUT->_2; | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 47, sourcePosColumn = 28} */ | |
$x8 = reverse($xs); | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 47, sourcePosColumn = 28} */ | |
$x9 = singleton($x); | |
return append($x8, $x9); | |
} | |
}function length($xx) { | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 53, sourcePosColumn = 4} */ | |
$SCRUT = $xx; | |
if ($SCRUT->tag == "Nil") { | |
return 0; | |
} | |
elseif ($SCRUT->tag == "Cons") { | |
$x = $SCRUT->_1; | |
$xs = $SCRUT->_2; | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 55, sourcePosColumn = 28} */ | |
$x10 = length($xs); | |
return (1 + $x10); | |
} | |
}function map($f, $xx) { | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 60, sourcePosColumn = 4} */ | |
$SCRUT = $xx; | |
if ($SCRUT->tag == "Nil") { | |
return new Nil(); | |
} | |
elseif ($SCRUT->tag == "Cons") { | |
$x = $SCRUT->_1; | |
$xs = $SCRUT->_2; | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 62, sourcePosColumn = 28} */ | |
$x11 = $f($x); | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 62, sourcePosColumn = 28} */ | |
$x12 = map($f, $xs); | |
return new Cons($x11, $x12); | |
} | |
}function mapS($f, $xx) { | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 69, sourcePosColumn = 8} */ | |
$SCRUT = $xx; | |
if ($SCRUT->tag == "Nil") { | |
return new Nil(); | |
} | |
elseif ($SCRUT->tag == "Cons") { | |
$x = $SCRUT->_1; | |
$xs = $SCRUT->_2; | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 71, sourcePosColumn = 28} */ | |
$x13 = $f($x); | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 71, sourcePosColumn = 28} */ | |
$x14 = mapS($f, $xs); | |
return new Cons($x13, $x14); | |
} | |
}function forS($xx, $f) { | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 76, sourcePosColumn = 8} */ | |
$SCRUT = $xx; | |
if ($SCRUT->tag == "Nil") { | |
return 1; | |
} | |
elseif ($SCRUT->tag == "Cons") { | |
$x = $SCRUT->_1; | |
$xs = $SCRUT->_2; | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 80, sourcePosColumn = 17} */ | |
$f($x); | |
return forS($xs, $f); | |
} | |
}function foldl($f, $z, $xx) { | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 87, sourcePosColumn = 4} */ | |
$SCRUT = $xx; | |
if ($SCRUT->tag == "Nil") { | |
return $z; | |
} | |
elseif ($SCRUT->tag == "Cons") { | |
$x = $SCRUT->_1; | |
$xs = $SCRUT->_2; | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 89, sourcePosColumn = 28} */ | |
$x15 = $f($z, $x); | |
return foldl($f, $x15, $xs); | |
} | |
}function filter($p, $xx) { | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 94, sourcePosColumn = 4} */ | |
$SCRUT = $xx; | |
if ($SCRUT->tag == "Nil") { | |
return new Nil(); | |
} | |
elseif ($SCRUT->tag == "Cons") { | |
$x = $SCRUT->_1; | |
$xs = $SCRUT->_2; | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 97, sourcePosColumn = 13} */ | |
$x16 = $p($x); | |
/* Case SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 97, sourcePosColumn = 13} */ | |
$SCRUT = $x16; | |
if ($SCRUT == true) { | |
/* Let SourcePos {sourcePosSource = "packages/ddc-core-babel/Test.ds", sourcePosLine = 98, sourcePosColumn = 22} */ | |
$x17 = filter($p, $xs); | |
return new Cons($x, $x17); | |
} | |
else{ | |
return filter($p, $xs); | |
} | |
} | |
}function concat_strings($xs) { | |
return foldl(DDC::curry(q_string_concat, 2), "", $xs); | |
} | |
?> |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment