...
 
Commits (935)
Clean System Files
_Tests
_Tests.*
*.o
*-sapl
*-www
*-data
*.prj
*.prp
* Time Profile.pcl
*.exe
a.out
test:
test-nightly:
before_script:
- install_clean.sh bundle-complete && apt-get update -qq && apt-get install -y -qq build-essential
- install_clean.sh bundle-complete
- apt-get update -qq
- apt-get install -y -qq build-essential git coreutils libmariadb-dev libsnappy-dev libsqlite3-dev
- make -C src/cdeps install
- git clone https://gitlab.science.ru.nl/clean-compiler-and-rts/compiler tests/linux64/compiler
- make -j -C tests/linux64/compiler/main/Unix
- make -j -C tests/linux64/compiler/backendC/CleanCompilerSources -f Makefile.linux64
- mkdir -p tests/linux64/compiler/backend/Clean\ System\ Files
- ln -fs ../../backendC/CleanCompilerSources/backend.a tests/linux64/compiler/backend/Clean\ System\ Files/backend_library
image: "camilstaps/clean:nightly"
script:
- make -C tests/linux64
- COCLPATH=./compiler make -C tests/linux64 run
- cleantest -r testproperties --options '-IL;Dynamics;-d;src/libraries/OS-Independent;-P;OutputTestEvents;-T;Tests 100000;-T;MaxStringLength 500;-T;Bent;-C;-h;-C;100m;-r' --junit junit.xml
artifacts:
when: always
paths:
- junit.xml
reports:
junit: junit.xml
# Clean documentation
Cloogle indexes documentation of the syntax elements it stores, through
functions in `Clean.Doc`. Docblocks are comments that start with `/**` and have
a leading asterisk on every line (leading whitespace is ignored). The first
part of the docblock is taken as a general description. Below the description,
documentation fields can be added with `@`. Currently, documentation fields
should have only one line.
An example is below:
```clean
/**
* Apply a function to every element in a list.
*
* @param The function
* @param The list
* @result The new list
*/
map :: (a -> b) [a] -> [b]
```
`@result` can be given multiple times for tuples.
For short documentation items, doclines, starting with `//*` can be used. When
documenting a constructor, or record field, they should be placed *after* the
item they document. For example:
```clean
/**
* A date in the Gregorian calendar
*/
:: Date =
{ day :: Int //* The day of the month, starting with 1
, month :: Int //* The month (January is 1)
, year :: Int //* The year
}
```
To add several lines of documentation to a constructor or record field, several
doclines can be used:
```clean
:: MyType
= MyConstructor args // ...
//* This constructor may require some more explanation,
//* which is added on several lines.
```
Doclines can also be added *above* a function, type, or class definition:
```clean
//* The identity function.
id :: .a -> .a
```
## Markup in documentation
Some simple Markdown-inspired markup is allowed in documentation:
- `` `foo` `` renders `foo` in monospaced font.
- Code blocks can be surrounded by `` ``` `` on separate lines. The start of a
code block can indicate the language (for highlighting purposes), as in
`` ```clean ``.
- `{{bar}}` marks `bar` as a defined entity (that can be searched for).
- Double newlines distinguish paragraphs; single newlines are ignored unless
followed by a hyphen.
## Documentation fields
The tables below describe which fields and documentation types can be used for
different syntax elements, and what they should document. An extension, to
document test properties, is discussed below.
What fields are accepted for what syntax elements is defined by the records in
`Clean.Doc`; how they are parsed in the instances of the generic function
`docBlockToDoc`. The below is merely a convenient representation of the same
information.
| | Description | `@param` | `@result` | `@type` | `@var` | `@representation` | `@throws` | `@complexity`
|--------------|-------------|----------|-----------|---------|--------|-------------------|-----------|--------------
| Class | ![][y] | ![][y]<sup>1</sup> | ![][y]<sup>1</sup> | | ![][y] | |
| Class member | ![][y] | ![][y] | ![][y] | | | | ![][y] | ![][y]
| Constructor | ![][y] | | | | | | |
| Function | ![][y] | ![][y] | ![][y] | | | | ![][y] | ![][y]
| Generic | ![][y] | ![][y] | ![][y] | | ![][y] | | |
| Instance | ![][y] | | | | | | |
| Macro | ![][y] | ![][y] | ![][y] | ![][y]<sup>2</sup> | | | |
| Module | ![][y] | | | | | | |
| Record field | ![][y] | | | | | | |
| Type | ![][y] | | | | ![][y] | ![][y], for type synonyms | |
<sup>1: only for shorthand classes like `class zero a :: a`, where there is no
other place for the documentation of the class member.</sup>
<sup>2: for simple macros (depending on what the type deriver in
`Clean.Types.CoclTransform` can do), Cloogle will derive the type if it is not
given.</sup>
| Field | Description
|-------------------|-------------
| `@complexity` | E.g. "O(n log n)".
| `@param` | Parameters of a function(-like). Name a parameter using `@param name: description`.
| `@representation` | The representation of a synonym type.
| `@result` | The result of a function.
| `@return` | A deprecated synonym of `@result`.
| `@throws` | iTasks exceptions that can be thrown.
| `@type` | The type of a macro (without name and `::`).
| `@var` | Type variables of types, classes and generics.
### Property documentation
With [clean-test-properties][]' `testproperties` tool, [Gast][] test programs
can be generated with properties from docblocks. For this, several additional
fields can be used, which are further documented by [clean-test-properties][].
Our [standards](STANDARDS.md) require the use of tabs for indentation and spaces
for outlining. Because with properties code is included in documentation blocks,
using tabs for indentation would lead to tabs after spaces. To avoid this, we
use four spaces in this context instead. For example:
```clean
/**
* @property correctness: A.xs :: Set a:
* minList (toList xs) == findMin xs
*/
```
[clean-test-properties]: https://gitlab.science.ru.nl/clean-and-itasks/clean-test-properties
[Gast]: https://gitlab.science.ru.nl/clean-and-itasks/gast
[y]: http://i.stack.imgur.com/iro5J.png
......@@ -24,15 +24,22 @@ abbreviation should be written using only capitals (e.g. GUI,SQL,HTTP).
Function names should be written in lowerCamelCase. By starting types and
constructors with a capital and functions without one, the difference between
a constructor and a function is immediately clear for the reader of a program.
Generic function names should normally start with `g`, and the next character
should be a capital.
## Module names
For modules, the same guidelines apply as for naming types. Names should be
informative and preferably short. When a library module is not meant for direct
imports by end users, but should only used by experts in modules that for
example provide a more friendly interface, you should prefix the name of that
module with an underscore character (`_`) or place it in a separate `Internal`
submodule.
informative and preferably short.
- When a library module is not meant for direct imports by end users, but
should only used by experts in modules that for example provide a more
friendly interface, you should prefix the name of that module with an
underscore character (`_`) or place it in a separate `Internal` submodule.
- When a module (mainly) provides generic functions for functionality that
could also be reasonably implemented differently, it should be prefixed with
`Gen`.
## Argument order
......@@ -63,11 +70,11 @@ id x = x
```
Several JavaDoc like parameters are supported such as `@param`, `@result`,
`@type`, `@var` and `@representation`. More info about this can be found
[here](https://github.com/clean-cloogle/Cloogle#clean-documentation).
We use `@complexity` for the complexity order. Some other special fields are
used, like `@gin-icon`, but one should be reluctant with inventing new field
names. If there is a general use case, adding it can be discussed.
`@type`, `@var` and `@representation`. More info about this can be found in
[DOCUMENTATION.md](DOCUMENTATION.md). We use `@complexity` for the complexity
order. Some other special fields are used, like `@gin-icon`, but one should be
reluctant with inventing new field names. If there is a general use case,
adding it can be discussed.
## Layout
......@@ -89,12 +96,14 @@ collisions, adhere to the following conventions:
Implementation modules may import anything they like.
## Implementing class instances and generic derives
## Implementing class instances and generic derives
Clean Platform should, where applicable, provide instances for the types it provides for classes defined in StdEnv, Gast, and Platform itself.
The applicable instances for the _general_ classes should be exported in the module of the type and not of the class.
This means that for example the `Functor` instance of `Maybe` should be defined in `Data.Maybe` and not in `Data.Functor`.
For _specific_ classes the instances for types should be exported in submodules.
For example, `JSONEncode` for `Map` should be exported in `Data.Map.JSONEncode` and not in `Data.Map` nor in `Text.JSON`.
For example, `JSONEncode` for `Map` should be exported in `Data.Map.GenJSON` and not in `Data.Map` nor in `Text.GenJSON`.
This rule also holds for types that have multiple valid instances such as the `Monoid` for `Int`.
_general_ classes are:
......@@ -103,15 +112,16 @@ _general_ classes are:
- [ ] `Monoid, Semigroup` from `Data.Monoid`
- [ ] `Monad` from `Control.Monad` and applicable monads from `Control.Monad.*`
- [ ] `Applicative, Alternative` from `Control.Applicative`
- [ ] `gEq{|*|}` from `Data.Generics.GenEq`
- [ ] `gDefault{|*|}` from `Data.Generics.GenDefault`
- [ ] `GenFDomain` from `Data.Generics.GenFDomain`
- [ ] `gEq{|*|}` from `Data.GenEq`
- [ ] `gDefault{|*|}` from `Data.GenDefault`
- [ ] `GenFDomain` from `Data.GenFDomain`
- [ ] everything from `StdOverloaded`
- [ ] ...
_specific_ classes are for example:
- [ ] `JSONEncode, JSONDecode` from `Text.JSON`
- [ ] `ggen, genShow` from `Gast`
- [ ] ...
......
CC=gcc
OBJS:=systemsignal.o
all: $(OBJS)
install: $(OBJS)
mkdir -p ../libraries/OS-Independent/Clean\ System\ Files/
cp -v $(OBJS) ../libraries/OS-Independent/Clean\ System\ Files/
#include <stdlib.h>
#include <signal.h>
static long signal_state[NSIG] = {0};
#ifdef _WIN32
static void signal_handler(int sig)
{
#else
static void signal_handler(int sig, siginfo_t *si, void *unused)
{
(void)si;
(void)unused;
#endif
signal_state[sig] = 1;
}
void signal_install(long signum, long *ok, long *handler)
{
#ifdef _WIN32
*ok = signal(signum, signal_handler) == SIG_ERR;
#else
struct sigaction act;
act.sa_flags = SA_SIGINFO;
sigemptyset(&act.sa_mask);
act.sa_sigaction = signal_handler;
*ok = sigaction(signum, &act, NULL);
#endif
*handler = signum;
}
void signal_poll(long handler, long *ok, long *state, long *handlerr)
{
*ok = 1;
if(0 < handler && handler < NSIG){
*handlerr = handler;
*state = signal_state[handler];
signal_state[handler] = 0;
*ok = 0;
}
}
int signal_ignore(long signum)
{
return signal(signum, SIG_IGN) == SIG_ERR;
}
......@@ -4,6 +4,7 @@ Environments
EnvironmentName: Clean Platform
EnvironmentPaths
Path: {Application}\Libraries\StdEnv
Path: {Application}\Platform\src\libaries\Platform-x86
Path: {Application}\Platform\src\libraries\OS-Independent
Path: {Application}\Platform\src\libraries\OS-Independent\Data
Path: {Application}\Platform\src\libraries\OS-Independent\Database
......
......@@ -4,6 +4,7 @@
Path: {Application}/lib/StdEnv
Path: {Application}/lib/Generics
Path: {Application}/lib/StdLib
Path: {Application}/lib/clean-platform/Platform-x86
Path: {Application}/lib/clean-platform/OS-Independent
Path: {Application}/lib/clean-platform/OS-Independent/Data
Path: {Application}/lib/clean-platform/OS-Independent/Database
......
......@@ -4,6 +4,7 @@
Path: {Application}/lib/StdEnv
Path: {Application}/lib/Generics
Path: {Application}/lib/StdLib
Path: {Application}/lib/clean-platform/Platform-x86
Path: {Application}/lib/clean-platform/OS-Independent
Path: {Application}/lib/clean-platform/OS-Independent/Data
Path: {Application}/lib/clean-platform/OS-Independent/Database
......
module client
import StdEnv
import Data.Error
import Data.Maybe
import Network.IP
import System.Socket
import System.Socket.Ipv4
Start :: *World -> (MaybeOSError String, *World)
Start w
= case socket SocketStream w of
(Error e, w) = (Error e, w)
(Ok sockfd, w)
#! (merr, sockfd) = connect {ipv4_socket_port=8124,ipv4_socket_addr=Just (fromString "127.0.0.1")} sockfd
| isError merr = (liftError merr, w)
#! (merr, sockfd) = recv 128 [] sockfd
| isError merr = (merr, w)
# (Ok msg) = merr
# (merr, w) = close sockfd w
| isError merr = (liftError merr, w)
= (Ok msg, w)
module server
import StdDebug
import StdEnv
import Data.Error
import Data.Maybe
import System.Socket
import System.Socket.Ipv4
Start :: *World -> (MaybeOSError (), *World)
Start w
= case socket SocketStream w of
(Error e, w) = (Error e, w)
(Ok sockfd, w)
#! (merr, sockfd) = bind {ipv4_socket_port=8124,ipv4_socket_addr=Nothing} sockfd
| isError merr = (merr, w)
#! (merr, sockfd) = listen 3 sockfd
| isError merr = (merr, w)
= case accept sockfd of
(Error e, sockfd) = (Error e, w)
(Ok (sock, addr), sockfd)
# (merr, sock) = send "Hello world!" [] sock
| isError merr = (liftError merr, w)
# (merr, w) = close sock w
| isError merr = (merr, w)
# (merr, w) = close sockfd w
| isError merr = (merr, w)
= (Ok (), w)
#include <stdio.h>
#include <stddef.h>
#ifdef _WIN32
#include <winsock2.h>
#include <ws2tcpip.h>
#else
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <sys/un.h>
#endif
int main(void)
{
printf("AF_INET :== %lu\n", AF_INET);
#ifdef linux
printf("AF_UNIX :== %lu\n", AF_UNIX);
#endif
printf("AF_INET6 :== %lu\n", AF_INET6);
printf("AF_IPX :== %lu\n", AF_IPX);
printf("AF_APPLETALK :== %lu\n", AF_APPLETALK);
printf("AF_IRDA :== %lu\n", AF_IRDA);
printf("SOCK_STREAM :== %lu\n", SOCK_STREAM);
printf("SOCK_DGRAM :== %lu\n", SOCK_DGRAM);
printf("MSG_DONTROUTE :== %lu\n", MSG_DONTROUTE);
printf("MSG_OOB :== %lu\n", MSG_OOB);
printf("MSG_PEEK :== %lu\n", MSG_PEEK);
printf("MSG_WAITALL :== %lu\n", MSG_WAITALL);
printf("\nsockaddr_in offsets:\n");
printf("sin_family: %lu\n", offsetof(struct sockaddr_in, sin_family));
printf("sin_port: %lu\n", offsetof(struct sockaddr_in, sin_port));
printf("sin_addr: %lu\n", offsetof(struct sockaddr_in, sin_addr));
printf("in_addr offsets:\n");
printf("s_addr: %lu\n", offsetof(struct in_addr, s_addr));
#ifdef linux
printf("\nsockaddr_un offsets:\n");
printf("sun_family: %lu\n", offsetof(struct sockaddr_un, sun_family));
printf("sun_path: %lu\n", offsetof(struct sockaddr_un, sun_path));
#endif
printf("\nsockaddr_in6 offsets:\n");
printf("sin6_family: %lu\n",
offsetof(struct sockaddr_in6, sin6_family));
printf("sin6_port: %lu\n", offsetof(struct sockaddr_in6, sin6_port));
printf("sin6_flowinfo: %lu\n",
offsetof(struct sockaddr_in6, sin6_flowinfo));
printf("sin6_addr: %lu\n", offsetof(struct sockaddr_in6, sin6_addr));
printf("sin6_scope_id: %lu\n",
offsetof(struct sockaddr_in6, sin6_scope_id));
printf("in6_addr offsets:\n");
printf("s6_addr: %lu\n", offsetof(struct in6_addr, s6_addr));
#ifdef _WIN32
printf("sizeof(WSADATA): %lu\n", sizeof(WSADATA));
#endif
return 0;
}
definition module System.OS
OS_NAME :== "Android (32-bit)"
OS_PATH_SEPARATOR :== '/'
OS_NEWLINE :== "\n"
IF_POSIX_OR_WINDOWS posix windows :== posix
IF_WINDOWS win other :== other
IF_WINDOWS32 win other :== other
IF_WINDOWS64 win other :== other
IF_POSIX posix other :== posix
IF_LINUX linux other :== linux
IF_LINUX32 linux other :== linux
IF_LINUX64 linux other :== other
IF_MAC mac other :== other
IF_ANDROID android other :== android
implementation module System.OS
definition module System._Platform
import System.Platform
//* @type Platform
CURRENT_PLATFORM :== Android32
implementation module System._Platform
definition module System.OS
OS_NAME :== "Android (64-bit)"
OS_PATH_SEPARATOR :== '/'
OS_NEWLINE :== "\n"
IF_POSIX_OR_WINDOWS posix windows :== posix
IF_WINDOWS win other :== other
IF_WINDOWS32 win other :== other
IF_WINDOWS64 win other :== other
IF_POSIX posix other :== posix
IF_LINUX linux other :== linux
IF_LINUX32 linux other :== other
IF_LINUX64 linux other :== linux
IF_MAC mac other :== other
IF_ANDROID android other :== android
implementation module System.OS
definition module System._Platform
import System.Platform
//* @type Platform
CURRENT_PLATFORM :== Android64
implementation module System._Platform
definition module System._Posix
from System._Pointer import :: Pointer
from StdInt import IF_INT_64_OR_32
from System.Time import :: Tm
WNOHANG :== 0x00000001
WUNTRACED :== 0x00000002
MAXPATHLEN :== 1024
DIRENT_D_NAME_OFFSET :== 19
S_IFMT :== 0170000
S_IFIFO :== 0010000
S_IFCHR :== 0020000
S_IFDIR :== 0040000
S_IFBLK :== 0060000
S_IFREG :== 0100000
S_IFLNK :== 0120000
S_IFSOCK :== 0140000
S_IFWHT :== 0160000
STDIN_FILENO :== 0
STDOUT_FILENO :== 1
STDERR_FILENO :== 2
FIONREAD :== 0x541B
F_SETFD :== 2
O_CLOEXEC :== 02000000
//Posix API calls
errno :: !*w -> (!Int,!*w)
strerr :: !Int -> Pointer
stat :: !{#Char} !{#Char} !*w -> (!Int,!*w)
unlink :: !{#Char} !*w -> (!Int,!*w)
fork :: !*w -> (!Int,!*w)
execvp :: !{#Char} !{#Pointer} !*w -> (!Int,!*w)
waitpid :: !Int !{#Int} !Int !*w -> (!Int,!*w)
exit :: !Int !*w -> (!.a,!*w)
getcwd :: !{#Char} !Int !*w -> (!Pointer,!*w)
chdir :: !{#Char} !*w -> (!Int,!*w)
mkdir :: !{#Char} !Int !*w -> (!Int,!*w)
rmdir :: !{#Char} !*w -> (!Int,!*w)
rename :: !{#Char} !{#Char} !*w -> (!Int,!*w)
opendir :: !{#Char} !*w -> (!Pointer,!*w)
closedir :: !Pointer !*w -> (!Int,!*w)
readdir :: !Pointer !*w -> (!Pointer,!*w)
pipe :: !Pointer !*w -> (!Int, !*w)
dup2 :: !Int !Int !*w -> (!Int, !*w)
close :: !Int !*w -> (!Int, !*w)
ioctl :: !Int !Int !Pointer !*w -> (!Int, !*w)
// variant requiring an argument as third parameter
fcntlArg :: !Int !Int !Int !*w -> (!Int, !*w)
read :: !Int !Pointer !Int !*w -> (!Int, !*w)
write :: !Int !{#Char} !Int !*w -> (!Int, !*w)
select_ :: !Int !Pointer !Pointer !Pointer !Pointer !*w -> (!Int, !*w)
kill :: !Int !Int !*w -> (!Int, !*w)
//Memory (impure)
malloc :: !Int -> Pointer
free :: !Pointer -> Int
freeSt :: !Pointer !*w -> *w
memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
//Posix datastructures
:: Stat =
{ st_dev :: !Int
, st_ino :: !Int
, st_mode :: !Int
, st_nlink :: !Int
, st_uid :: !Int
, st_gid :: !Int
, st_rdev :: !Int
, st_size :: !Int
, st_blocks :: !Int
, st_blksize :: !Int
, st_ctimespec :: !Int
, st_mtimespec :: !Int
, st_atimespec :: !Int
}
//Mapping to/from byte arrays
unpackStat :: !{#Char} -> Stat
sizeOfStat :: Int
implementation module System._Posix
import System._Pointer, System.Time
import StdInt
errno :: !*w -> (!Int,!*w)
errno world = (getErrno,world)
where
getErrno :: Int
getErrno = readInt4S errnoAddr 0
errnoAddr :: Pointer
errnoAddr = code {
ccall __errno ":p"
}
strerr :: !Int -> Pointer
strerr world = code {
ccall strerror "I:p"
}
stat :: !{#Char} !{#Char} !*w -> (!Int,!*w)
stat path buf world = code {
ccall stat "ss:I:A"
}
unlink :: !{#Char} !*w -> (!Int,!*w)
unlink path world = code {
ccall unlink "s:I:A"
}
fork :: !*w -> (!Int,!*w)
fork world = code {
ccall fork ":I:A"
}
execvp :: !{#Char} !{#Pointer} !*w -> (!Int,!*w)
execvp name argv world = code {
ccall execvp "sA:I:A"
}
waitpid :: !Int !{#Int} !Int !*w -> (!Int,!*w)
waitpid pid status_p options world = code {
ccall waitpid "IAI:I:A"
}
exit :: !Int !*w -> (!.a,!*w)
exit num world = code {
ccall exit "I:p:A"
}
getcwd :: !{#Char} !Int !*w -> (!Pointer,!*w)
getcwd buf size_t world = code {
ccall getcwd "sI:p:A"
}
chdir :: !{#Char} !*w -> (!Int,!*w)
chdir name world = code {
ccall chdir "s:I:A"
}
mkdir :: !{#Char} !Int !*w -> (!Int,!*w)
mkdir name mode world = code {
ccall mkdir "sI:I:A"
}
rmdir :: !{#Char} !*w -> (!Int,!*w)
rmdir name world = code {
ccall rmdir "s:I:A"
}
rename :: !{#Char} !{#Char} !*w -> (!Int,!*w)
rename old new world = code {
ccall rename "ss:I:A"
}
opendir :: !{#Char} !*w -> (!Pointer,!*w)
opendir path world = code {
ccall opendir "s:p:A"
}
closedir :: !Pointer !*w -> (!Int,!*w)
closedir dir world = code {
ccall closedir "p:I:A"
}
readdir :: !Pointer !*w -> (!Pointer,!*w)
readdir dir world = code {
ccall readdir "p:p:A"
}
pipe :: !Pointer !*w -> (!Int, !*w)
pipe arr world = code {
ccall pipe "p:I:A"
}
dup2 :: !Int !Int !*w -> (!Int, !*w)
dup2 old new world = code {
ccall dup2 "II:I:A"
}
close :: !Int !*w -> (!Int, !*w)
close fd world = code {
ccall close "I:I:A"
}
ioctl :: !Int !Int !Pointer !*w -> (!Int, !*w)
ioctl fd op ptr world = code {
ccall ioctl "IIp:I:A"
}
fcntlArg :: !Int !Int !Int !*w -> (!Int, !*w)
fcntlArg fd op arg world = code {
ccall fcntl "III:I:A"
}
read :: !Int !Pointer !Int !*w -> (!Int, !*w)
read fd buffer nBuffer world = code {
ccall read "IpI:I:A"
}
write :: !Int !{#Char} !Int !*w -> (!Int, !*w)
write fd buffer nBuffer world = code {
ccall write "IsI:I:A"
}
select_ :: !Int !Pointer !Pointer !Pointer !Pointer !*w -> (!Int, !*w)
select_ nfds readfds writefds exceptfds timeout world = code {
ccall select "Ipppp:I:A"
}
kill :: !Int !Int !*w -> (!Int, !*w)
kill pid sig world = code {
ccall kill "II:I:A"
}
malloc :: !Int -> Pointer
malloc num = code {
ccall malloc "p:p"
}
free :: !Pointer -> Int
free ptr = code {
ccall free "p:I"
}
freeSt :: !Pointer !*w -> *w
freeSt ptr world = code {
ccall free "p:V:A"
}
memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
memcpy_string_to_pointer p s n = code {
ccall memcpy "psp:p"
}
//Mapping to/from byte arrays
unpackStat :: !{#Char} -> Stat
unpackStat s =
{ st_dev = IF_INT_64_OR_32 (unpackInt8 s 0) (unpackInt4S s 0 /*8 bytes*/)
, st_ino = IF_INT_64_OR_32 (unpackInt8 s 8) (unpackInt4S s 96)
, st_mode = IF_INT_64_OR_32 (unpackInt4S s 24) (unpackInt4S s 16)
, st_nlink = IF_INT_64_OR_32 (unpackInt8 s 16) (unpackInt4S s 20)
, st_uid = IF_INT_64_OR_32 (unpackInt4S s 28) (unpackInt4S s 24)
, st_gid = IF_INT_64_OR_32 (unpackInt4S s 32) (unpackInt4S s 28)
, st_rdev = IF_INT_64_OR_32 (unpackInt8 s 40) (unpackInt4S s 32 /*8 bytes*/)
, st_size = IF_INT_64_OR_32 (unpackInt8 s 48) (unpackInt4S s 44)
, st_blocks = IF_INT_64_OR_32 (unpackInt8 s 64) (unpackInt4S s 64)
, st_blksize = IF_INT_64_OR_32 (unpackInt8 s 56) (unpackInt4S s 56)
, st_atimespec = IF_INT_64_OR_32 (unpackInt8 s 72 /*16 bytes*/) (unpackInt4S s 72 /*8 bytes*/)
, st_mtimespec = IF_INT_64_OR_32 (unpackInt8 s 88 /*16 bytes*/) (unpackInt4S s 80 /*8 bytes*/)
, st_ctimespec = IF_INT_64_OR_32 (unpackInt8 s 104 /*16 bytes*/) (unpackInt4S s 88 /*8 bytes*/)
}
sizeOfStat :: Int
sizeOfStat = 104
This diff is collapsed.
This diff is collapsed.
definition module Clean.ModuleFinder
/**
* This module provides functionality to search for Clean modules in the file
* system.
*/
from System.FilePath import :: FilePath
from System.Options import :: Option
from System.OSError import :: OSError, :: OSErrorMessage, :: OSErrorCode
/**
* Options to tweak the searching for Clean modules.
*/
:: ModuleFindingOptions =
{ include_paths :: ![FilePath] //* Complete paths to search in (clm's `-I`)
, include_libraries :: ![String] //* Libraries to search in (combined with CLEAN_HOME; clm's `-IL`)
, clean_home :: !FilePath //* Override CLEAN_HOME
, include_applications :: !Bool //* Whether to include modules that do not have a definition module or not
}
/**
* Get the default {{`ModuleFindingOptions`}}. This requires the World because
* {{`clean_home`}} needs to be set correctly, for which the `CLEAN_HOME`
* environment variable is read.
*/
defaultModuleFindingOptions :: !*World -> *(!ModuleFindingOptions, !*World)
/**
* An option description ({{System.Options}}) for {{`ModuleFindingOptions`}},
* supporting clm's `-I` and `-IL`, as well as long forms, possibility to
* override `CLEAN_HOME`, etc.
*/
moduleFindingOptionDescription :: Option ModuleFindingOptions
/**
* Find a specific module in the file system.
*
* @param The module name
* @param The options to search for the module
* @result A list of all matching file paths
*/
findModule :: !String !ModuleFindingOptions !*World -> *(![FilePath], !*World)
/**
* Find all modules in the file system.
*
* @param The options to search for modules
* @result {{`OSError`}}s that occurred during searching
* @result File paths of all modules found
*/
findAllModules :: !ModuleFindingOptions !*World -> *(![OSError], ![FilePath], !*World)
implementation module Clean.ModuleFinder
import StdArray
import StdList
import StdString
import Clean.Parse.ModuleName
import Data.Error
from Data.Func import $, mapSt
import System.Directory
import System.Environment
import System.File
import System.FilePath
import System.Options
import System.OS
import Text
defaultModuleFindingOptions :: !*World -> *(!ModuleFindingOptions, !*World)
defaultModuleFindingOptions w
# (home,w) = getEnvironmentVariable "CLEAN_HOME" w
# home = fromMaybe (IF_WINDOWS "C:\\Clean" "/opt/clean") home
# opts =
{ include_paths = []
, include_libraries = ["StdEnv"]
, clean_home = home
, include_applications = False
}
= (opts, w)
moduleFindingOptionDescription :: Option ModuleFindingOptions
moduleFindingOptionDescription = Options
[ Shorthand "-I" "--include" $ Option
"--include"
(\dir opts -> Ok {opts & include_paths=opts.include_paths ++ [dir]})
"DIR"
"Add DIR to the include path"
, Shorthand "-IL" "--include-library" $ Option
"--include-library"
(\lib opts -> Ok {opts & include_libraries=opts.include_libraries ++ [lib]})
"LIB"
"Add CLEAN_HOME/lib/LIB to the include path"
, Shorthand "-H" "--clean-home" $ Option
"--clean-home"
(\h opts -> Ok {opts & clean_home=h})
"PATH"
"Set CLEAN_HOME to PATH (used to find libraries)"
, Flag
"--include-applications"
(\opts -> Ok {opts & include_applications=True})
"Include modules for which no definition module exists"
]
baseDirectories :: !ModuleFindingOptions -> [FilePath]
baseDirectories opts =
opts.include_paths ++
[opts.clean_home </> "lib" </> lib \\ lib <- opts.include_libraries]
findModule :: !String !ModuleFindingOptions !*World -> *(![FilePath], !*World)
findModule mod opts w
# (exis,w) = mapSt fileExists candidates w
= ([p \\ p <- candidates & exi <- exis | exi], w)
where
moddir = {if (c == '.') pathSeparator c \\ c <-: mod}
candidates = [dir </> moddir +++ ext \\ dir <- baseDirectories opts]
with ext = if opts.include_applications ".icl" ".dcl"
findAllModules :: !ModuleFindingOptions !*World -> *(![OSError], ![FilePath], !*World)
findAllModules opts w
# (errs,(paths,w)) = mapSt (\d -> scanDirectory` (collect d) d) (baseDirectories opts) ([], w)
= (flatten errs,paths,w)
where
scanDirectory` f dir (st,w) = (err, (st`,w`)) where (err, st`, w`) = scanDirectory f st dir w
collect dir fp fi seen w
| endsWith (if opts.include_applications ".icl" ".dcl") fp
# (modname, w) = guessModuleName fp w
| isError modname = (seen, w)
# modname = fromOk modname
| isNothing modname = (seen, w)
# modname = fromJust modname
# expected = {if (c == pathSeparator) '.' c \\ c <-: fp % (size dir`, size fp - 5)}
with dir` = dir </> ""
| modname == expected
= ([fp:seen], w)
= (seen, w)
| otherwise
= (seen, w)
definition module Clean.Parse
/**
* A small wrapper around the parser of the Clean compiler.
* You will need to have the source of the Clean compiler available in your path.
*/
from Data.Error import :: MaybeError
from Data.Maybe import :: Maybe
from System.FilePath import :: FilePath
from hashtable import :: HashTable
from Heap import :: Heap
from syntax import :: Module, :: ParsedDefinition, :: ParsedModule
/**
* Parse a Clean module.
*
* @param The path to the file to parse
* @result
* The parsed module and the corresponding hash table.
* When the result is an {{`Error`}}, there is a descriptive error message.
*/
readModule :: !FilePath !*World -> *(!MaybeError String (ParsedModule, HashTable), !*World)
implementation module Clean.Parse
// NOTE: be VERY restrictive with adding imports here, because this may break
// the module when the compiler changes.
import Clean.Parse.ModuleName
import Data.Error
import Data.Maybe
import System.File
import System.FilePath
from Text import class Text(endsWith), instance Text String
from hashtable import :: BoxedIdent{boxed_ident}, :: HashTable,
:: IdentClass(IC_Module), :: QualifiedIdents(NoQualifiedIdents),
putIdentInHashTable, set_hte_mark, newHashTable
from parse import wantModule
import syntax
readModule :: !FilePath !*World -> *(!MaybeError String (ParsedModule, HashTable), !*World)
readModule filename w
# (modname,w) = guessModuleName filename w
| isError modname = (Error (toString (fromError modname)), w)
# modname = fromMaybe (takeFileName (dropExtension filename)) (fromOk modname)
# ht = newHashTable newHeap
# ht = set_hte_mark (if icl 1 0) ht
# (ok,f,w) = fopen filename FReadText w
| not ok = (Error ("Couldn't open " +++ filename), w)
# (mod_id, ht) = putIdentInHashTable modname (IC_Module NoQualifiedIdents) ht
# ((b1,b2,pm,ht,f),w) = accFiles (wantModule` f "" icl mod_id.boxed_ident NoPos True ht stderr) w
# (ok,w) = fclose f w
| not ok = (Error ("Couldn't close " +++ filename), w)
= (Ok (pm, ht), w)
where
icl = endsWith "icl" filename
wantModule` :: !*File !{#Char} !Bool !Ident !Position !Bool !*HashTable !*File !*Files
-> ((!Bool,!Bool,!ParsedModule, !*HashTable, !*File), !*Files)
wantModule` f s b1 i p b2 ht io fs
# (b1,b2,pm,ht,f,fs) = wantModule f s b1 i p b2 ht io fs
= ((b1,b2,pm,ht,f),fs)
definition module Clean.Parse.Comments
/**
* Functions to deal with (documentation) comments in Clean programs.
* You will need the Clean compiler in your path.
* This module is up to date to revision 3056 of the itask compiler.
*/
from StdFile import class FileSystem
from Data.Error import :: MaybeError
from Data.Maybe import :: Maybe
from System.File import :: FileError
from System.FilePath import :: FilePath
from syntax import :: Ident, :: Module, :: ParsedConstructor,
:: ParsedDefinition, :: ParsedModule, :: ParsedSelector, :: Position
/**
* A comment in a Clean program.
*/
:: CleanComment =
{ line :: !Int
, column :: !Int
, level :: !Maybe Int //* Nothing for single-line comments, otherwise the nesting level
, content :: !String //* All content except `//` or `/*` and `*/`
, multiline :: !Bool
}
/**
* Scan all comments from a Clean program given the filename.
* Also see {{`scanCommentsFile`}}.
*/
scanComments :: !FilePath !*env -> *(!MaybeError FileError [CleanComment], !*env) | FileSystem env
/**
* Scan all comments from a Clean program given a readable {{`File`}}.
* Also see {{`scanComments`}}.
*/
scanCommentsFile :: !*File -> *(!MaybeError FileError [CleanComment], !*File)
/**
* Clean comments linked to the definitions in a {{`ParsedModule`}} of the
* Clean compiler.
*/
:: CollectedComments
:: CommentIndex
emptyCollectedComments :: CollectedComments
/**
* Get the comment content for an identifier.
*/
getComment :: !a !CollectedComments -> Maybe String | commentIndex a
class commentIndex a :: !a -> Maybe CommentIndex
instance commentIndex (Module a), ParsedDefinition, ParsedSelector, ParsedConstructor
/**
* Match a list of comments (see {{`scanComments`}}) to a {{`ParsedModule`}}
* (see {{`readModule`}} in {{`Clean.Parse`}}).
*/
collectComments :: ![CleanComment] !ParsedModule -> CollectedComments
This diff is collapsed.
definition module Clean.Parse.ModuleName
from Data.Error import :: MaybeError
from Data.Maybe import :: Maybe
from System.File import :: FileError
from System.FilePath import :: FilePath
/**
* Guess the module name of a Clean file.
*
* @param The path to the Clean file
* @result
* `Error`, if the file could not be read;
* `Ok Nothing`, if the module name could not be guessed;
* `Ok (Just name)` in case of success.
*/
guessModuleName :: !FilePath !*World -> *(!MaybeError FileError (Maybe String), !*World)
implementation module Clean.Parse.ModuleName
import StdBool
import StdChar
import StdClass
import StdFile
import StdList
import Data.Error
import Data.Maybe
import System.File
import System.FilePath
guessModuleName :: !FilePath !*World -> *(!MaybeError FileError (Maybe String), !*World)
guessModuleName filename w
# (s,w) = readFile filename w
| isError s = (Error (fromError s), w)
# modname = getModuleName (fromString (fromOk s))
= (Ok modname, w)
// A reasonably accurate simple scanner to get the module name from the file
getModuleName :: ![Char] -> Maybe String
getModuleName ['definition':c:cs] | isSpace c = justModule cs
getModuleName ['implementation':c:cs] | isSpace c = justModule cs
getModuleName ['system':c:cs] | isSpace c = justModule cs
getModuleName [c:cs] | isSpace c = getModuleName cs
getModuleName ['//':cs] = getModuleName (dropWhile ((<>) '\n') cs)
getModuleName ['/*':cs] = getModuleName (skipMultiLineComment cs)
getModuleName cs = justModule cs
justModule :: ![Char] -> Maybe String
justModule ['module':c:cs] | isSpace c = justModuleName cs
justModule [c:cs] | isSpace c = justModule cs
justModule ['//':cs] = justModule (dropWhile ((<>) '\n') cs)
justModule ['/*':cs] = justModule (skipMultiLineComment cs)
justModule _ = Nothing
justModuleName :: ![Char] -> Maybe String
justModuleName cs
# (_,cs) = span isSpace cs
# (name,_) = span (\c -> c <> '/' && c <> ';' && not (isSpace c)) cs
= case name of
[] -> Nothing
_ -> Just (toString name)
skipMultiLineComment :: ![Char] -> [Char]
skipMultiLineComment ['*/':cs] = cs
skipMultiLineComment ['/*':cs] = skipMultiLineComment (skipMultiLineComment cs)
skipMultiLineComment [c:cs] = skipMultiLineComment cs
skipMultiLineComment [] = []
definition module Clean.PrettyPrint
/**
* Pretty-printer for types in the Clean compiler.
*/
from syntax import
:: AType,
:: ParsedDefinition,
:: ParsedExpr,
:: Rhs,
:: Type,
:: TypeContext
/**
* Pretty-printer.
*
* @var The type to print
*/
class cpp t where
/**
* Normal pretty-printer.
* @param The value to print
* @result A string representation of the parameter
*/
cpp :: !t -> String
/**
* Pretty-printer which places parentheses around the result if necessary.
* @param The value to print
* @result A string representation of the parameter
*/
cppp :: !t -> String
instance cpp