...
 
Commits (20)
......@@ -9,7 +9,7 @@
.export _channel_code
.export EMPTY INT BOOL CHAR REAL FILE _STRING_ _ARRAY_ ARRAY
.export EMPTY INT BOOL CHAR REAL REAL32 INT32 FILE _STRING_ _ARRAY_ ARRAY
.export _reserve _cycle_in_spine _hnf
.export _type_error _match_error selector_m_error index_error
.export _print_graph _eval_to_nf
......@@ -37,10 +37,10 @@
.desc GRAPH _hnf _hnf 0 0 ""
.desc _ARRAY_ _hnf _hnf 0 0 "_ARRAY_"
.desc _STRING_ _hnf _hnf 0 0 "_STRING_"
|.desc STRING _hnf _hnf 0 "STRING"
|.desc FILE _hnf _hnf 0 "FILE"
.desc REAL _hnf _hnf 0 0 "REAL"
.desc INT _hnf _hnf 0 0 "INT"
.desc REAL32 _hnf _hnf 0 0 "REAL32"
.desc INT32 _hnf _hnf 0 0 "INT32"
.desc BOOL _hnf _hnf 0 0 "BOOL"
.desc CHAR _hnf _hnf 0 0 "CHAR"
......@@ -248,16 +248,6 @@ ea_S.1
jmp_eval_upd
.pe
.o 1 0
o_S.1
get_node_arity 0
pushI 1
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.descs d_S.2 n_S.2 _ 2 0 "_S.2"
.pb "_S.2"
.n -1 d_S.2 ea_S.2
......@@ -309,21 +299,6 @@ ea_S.2_
jmp_eval_upd
.pe
.o 1 0
o_S.2
get_node_arity 0
eqI_b 2 0
jmp_false o_S.2_
pop_b 1
repl_arg 2 2
.d 1 0
rtn
o_S.2_
repl_arg 3 2
pop_b 1
.d 1 0
rtn
.descs d_S.3 n_S.3 _ 4 0 "_S.3"
.pb "_S.3"
.n -1 d_S.3 ea_S.3
......@@ -360,17 +335,8 @@ ea_S.3
jmp_eval_upd
.pe
.o 1 0
o_S.3
get_node_arity 0
pushI 3
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.descs d_S.4 n_S.4 _ 5 0 "_S.4"
.pb "_S.4"
.n -1 d_S.4 ea_S.4
.o 1 0
n_S.4
......@@ -403,18 +369,10 @@ ea_S.4
update_a 0 1
pop_a 1
jmp_eval_upd
.o 1 0
o_S.4
get_node_arity 0
pushI 4
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.pe
.descs d_S.5 n_S.5 _ 6 0 "_S.5"
.pb "_S.5"
.n -1 d_S.5 ea_S.5
.o 1 0
n_S.5
......@@ -447,18 +405,10 @@ ea_S.5
update_a 0 1
pop_a 1
jmp_eval_upd
.o 1 0
o_S.5
get_node_arity 0
pushI 5
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.pe
.descs d_S.6 n_S.6 _ 7 0 "_S.6"
.pb "_S.6"
.n -1 d_S.6 ea_S.6
.o 1 0
n_S.6
......@@ -491,18 +441,7 @@ ea_S.6
update_a 0 1
pop_a 1
jmp_eval_upd
.o 1 0
o_S.6
get_node_arity 0
pushI 6
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.pe
.desc d_Sr.1 n_Sr.1 o_Sr.1 1 0 "_Sr.1"
......@@ -1415,33 +1354,31 @@ _print__array2
print_sc "{"
push_b 0
eq_desc_b BOOL 0
jmp_true _print_bool_array
eqI_b 0 0
jmp_true _print_array_a
push_b 0
eq_desc_b INT 0
eqD_b BOOL 0
jmp_true _print_bool_array
eqD_b INT 0
jmp_true _print_int_array
push_b 0
eq_desc_b REAL 0
eqD_b REAL 0
jmp_true _print_real_array
eqD_b INT32 0
jmp_true _print_int32_array
eqD_b REAL32 0
jmp_true _print_real32_array
pop_b 1
pushI 0
push_a 0
push_arraysize _ 0 1
jmp _print_record_array
push_b 2
update_b 2 3
update_b 1 2
update_b 0 1
_print_array_a
pop_b 1
pushI 0
eqI
jmp_false _print_record_array
push_a 0
push_arraysize _ 0 1
jmp _print_array_lp2
.o 1 2 i i
_print_array_lp1
......@@ -1763,11 +1700,7 @@ _no_comma_3
push_a 0
select REAL 0 2
create
fillR_b 0 0
pop_b 2
print_symbol_sc 0
pop_a 1
print_real
push_b 1
incI
......@@ -1781,6 +1714,68 @@ _print_real_array_lp2
pop_b 2
print_sc "}"
jmp _print_brackets
_print_int32_array
pop_b 1
pushI 0
push_a 0
push_arraysize INT32 0 1
jmp _print_int32_array_lp2
.o 1 2 i i
_print_int32_array_lp1
eqI_b 0 1
jmp_true _no_comma_4
print_sc ","
_no_comma_4
push_b 1
push_a 0
select INT32 0 1
print_int
push_b 1
incI
update_b 0 2
pop_b 1
decI
_print_int32_array_lp2
eqI_b 0 0
jmp_false _print_int32_array_lp1
pop_a 1
pop_b 2
print_sc "}"
jmp _print_brackets
_print_real32_array
pop_b 1
push_a 0
pushI 0
push_arraysize REAL32 0 2
jmp _print_real32_array_lp2
.o 1 2 i i
_print_real32_array_lp1
eqI_b 0 1
jmp_true _no_comma_5
print_sc ","
_no_comma_5
push_b 1
push_a 0
select REAL32 0 2
print_real
push_b 1
incI
update_b 0 2
pop_b 1
decI
_print_real32_array_lp2
eqI_b 0 0
jmp_false _print_real32_array_lp1
pop_a 1
pop_b 2
print_sc "}"
jmp _print_brackets
_print_nil
print_sc "[]"
......@@ -2197,33 +2192,31 @@ _eval__array
_eval__array2
push_r_args_b 0 0 2 2 1
push_b 0
eq_desc_b BOOL 0
jmp_true _eval_bool_array
eqI_b 0 0
jmp_true _eval_array_a
push_b 0
eq_desc_b INT 0
eqD_b BOOL 0
jmp_true _eval_bool_array
eqD_b INT 0
jmp_true _eval_int_array
push_b 0
eq_desc_b REAL 0
eqD_b REAL 0
jmp_true _eval_real_array
eqD_b INT32 0
jmp_true _eval_int32_array
eqD_b REAL32 0
jmp_true _eval_real32_array
pop_b 1
pushI 0
push_a 0
push_arraysize _ 0 1
jmp _eval_record_array
push_b 2
update_b 2 3
update_b 1 2
update_b 0 1
_eval_array_a
pop_b 1
pushI 0
eqI
jmp_false _eval_record_array
push_a 0
push_arraysize _ 0 1
jmp _eval_array_lp2
.o 1 2 i i
_eval_array_lp1
......@@ -2334,9 +2327,11 @@ _eval_char_array
.d 0 0
rtn
_eval_real_array
_eval_bool_array
_eval_int_array
_eval_real_array
_eval_int32_array
_eval_real32_array
pop_b 1
pop_a 1
.d 0 0
......
......@@ -91,4 +91,7 @@ LeaveCriticalSection
WaitForMultipleObjects
SetCurrentDirectoryA
GetLogicalDrives
MoveFileA
\ No newline at end of file
MoveFileA
HeapFree
HeapReAlloc
SystemTimeToTzSpecificLocalTime
\ No newline at end of file
......@@ -90,3 +90,8 @@ GetShortPathNameA@12
UnmapViewOfFile@8
OpenProcess@12
InterlockedIncrement
GetProcessHeap@0
HeapAlloc@12
HeapFree@12
HeapReAlloc@16
SystemTimeToTzSpecificLocalTime@12
\ No newline at end of file
# StdEnv-doc
This is an annotated version of [Clean][]'s [StdEnv][] library for use in
[Cloogle][].
All code is copyright © 1998 University of Nijmegen.
[Clean]: http://clean.cs.ru.nl
[Cloogle]: https://cloogle.org
[StdEnv]: https://svn.cs.ru.nl/repos/clean-libraries/trunk/Libraries/StdEnv/
system module StdBool
/**
* Class instances and basic functions for the Bool type.
*/
// ****************************************************************************************
// Concurrent Clean Standard Library Module Version 3.0
// Copyright 2019 University of Nijmegen
......@@ -16,8 +20,30 @@ instance fromBool {#Char} :: !Bool -> {#Char} :== code { .d 0 1 b ; jsr Bto
// Additional Logical Operators:
/**
* Logical negation.
*
* @param The boolean to negate
* @result True if the parameter was False; False if True
*/
not :: !Bool -> Bool :== code { notB }
// Not arg1
(||) infixr 2 :: !Bool Bool -> Bool // Conditional or of arg1 and arg2
(&&) infixr 3 :: !Bool Bool -> Bool // Conditional and of arg1 and arg2
/**
* Logical disjunction. The second parameter is not strict and will not be
* evaluated if the first parameter is True.
*
* @param First boolean
* @param Second boolean
* @result True iff at least one of the parameters is True
*/
(||) infixr 2 :: !Bool Bool -> Bool
/**
* Logical conjunction. The second parameter is not strict and will not be
* evaluated if the first parameter is False.
*
* @param First boolean
* @param Second boolean
* @result True iff both parameters are True
*/
(&&) infixr 3 :: !Bool Bool -> Bool
system module StdChar
/**
* Class instances and basic functions for the Char type.
*/
// ****************************************************************************************
// Concurrent Clean Standard Library Module Version 3.0
// Copyright 2019 University of Nijmegen
......@@ -24,20 +28,116 @@ instance fromChar {#Char} :: !Char -> {#Char} :== code { CtoAC }
// Additional conversions:
digitToInt :: !Char -> Int // Convert Digit into Int
toUpper :: !Char -> Char // Convert Char into an uppercase Char
toLower :: !Char -> Char // Convert Char into a lowercase Char
/**
* Converts a character from ['0'..'9'] to an integer.
*
* @param The character
* @result 0-9 if the character was from ['0'..'9'], otherwise another Int
*/
digitToInt :: !Char -> Int
/**
* Converts a character to uppercase.
*
* @param The character
* @result The same character, with bit 5 cleared
*/
toUpper :: !Char -> Char
/**
* Converts a character to lowercase.
*
* @param The character
* @result The same character, with bit 5 set
*/
toLower :: !Char -> Char
// Tests on Characters:
isUpper :: !Char -> Bool // True if arg1 is an uppercase character
isLower :: !Char -> Bool // True if arg1 is a lowercase character
isAlpha :: !Char -> Bool // True if arg1 is a letter
isAlphanum :: !Char -> Bool // True if arg1 is an alphanumerical character
isDigit :: !Char -> Bool // True if arg1 is a digit
isOctDigit :: !Char -> Bool // True if arg1 is a digit
isHexDigit :: !Char -> Bool // True if arg1 is a digit
isSpace :: !Char -> Bool // True if arg1 is a space, tab etc
isControl :: !Char -> Bool // True if arg1 is a control character
isPrint :: !Char -> Bool // True if arg1 is a printable character
isAscii :: !Char -> Bool // True if arg1 is a 7 bit ASCII character
/**
* Check for uppercase
*
* @param The character
* @result True iff the parameter is from ['A'..'Z']
*/
isUpper :: !Char -> Bool
/**
* Check for lowercase
*
* @param The character
* @result True iff the parameter is from ['a'..'z']
*/
isLower :: !Char -> Bool
/**
* Check for an alphabetic character
*
* @param The character
* @result True iff the parameter is from ['a'..'z'] ++ ['A'..'Z']
*/
isAlpha :: !Char -> Bool
/**
* Check for an alphabetic or numerical character
*
* @param The character
* @result True iff the parameter is from ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']
*/
isAlphanum :: !Char -> Bool
/**
* Check for a numerical character
*
* @param The character
* @result True iff the parameter is from ['0'..'9']
*/
isDigit :: !Char -> Bool
/**
* Check for an octal digit
*
* @param The character
* @result True iff the parameter is from ['0'..'7']
*/
isOctDigit :: !Char -> Bool
/**
* Check for a hexadecimal digit
*
* @param The character
* @result True iff the parameter is from ['0'..'9'] ++ ['a'..'f'] ++ ['A'..'F']
*/
isHexDigit :: !Char -> Bool
/**
* Check for whitespace
*
* @param The character
* @result True iff the parameter is one of ' ', '\t', '\n', '\r', '\f', '\v'
*/
isSpace :: !Char -> Bool
/**
* Check for an ASCII control character
*
* @param The character
* @result True iff the parameter is from ['\x00'..'\x1f'] ++ ['\x7f']
*/
isControl :: !Char -> Bool
/**
* Check for a printable ASCII character
*
* @param The character
* @result True iff the parameter is from [' '..'~']
*/
isPrint :: !Char -> Bool
/**
* Check for a 7-bit ASCII character
*
* @param The character
* @result True iff the integer value of the parameter is less than 128
*/
isAscii :: !Char -> Bool
definition module StdCharList
/**
* Basic functions for manipulating lists of characters.
*/
// ****************************************************************************************
// Concurrent Clean Standard Library Module Version 2.0
// Copyright 1998 University of Nijmegen
// ****************************************************************************************
cjustify :: !.Int ![.Char] -> .[Char] // Center [Char] in field with width arg1
ljustify :: !.Int ![.Char] -> .[Char] // Left justify [Char] in field with width arg1
rjustify :: !.Int ![.Char] -> [Char] // Right justify [Char] in field with width arg1
/**
* Center-align a text with spaces, s.t. the right margin is 0 or 1 spaces
* longer than the left margin.
*
* @param The minimum length of the result
* @param The text to center
* @result A list of max(|param 2|, param 1), with param 2 surrounded by spaces
*/
cjustify :: !.Int ![.Char] -> .[Char]
/**
* Left-align a text with spaces
*
* @param The minimum length of the result
* @param The text to align
* @result A list of max(|param 2|, param 1), with spaces appended to param 2
*/
ljustify :: !.Int ![.Char] -> .[Char]
/**
* Right-align a text with spaces
*
* @param The minimum length of the result
* @param The text to align
* @result A list of max(|param 2|, param 1), with spaces prepended to param 2
*/
rjustify :: !.Int ![.Char] -> [Char]
/**
* Concatenate a list of texts, interspersing it with newlines
*
* @param The texts
* @result All texts concatenated, with newlines in between
*/
flatlines :: ![[u:Char]] -> [u:Char]
flatlines :: ![[u:Char]] -> [u:Char] // Concatenate by adding newlines
mklines :: ![Char] -> [[Char]] // Split in lines removing newlines
/**
* Split a text on newlines
*
* @param The text
* @result A list of texts without newlines
*/
mklines :: ![Char] -> [[Char]]
spaces :: !.Int -> .[Char] // Make [Char] containing n space characters
/**
* A list of a number of ' ' characters
*
* @param The number of characters
* @result A list of param 1 spaces
*/
spaces :: !.Int -> .[Char]
definition module StdClass
/**
* Meta-classes with derived functions.
*/
// ****************************************************************************************
// Concurrent Clean Standard Library Module Version 2.0
// Copyright 1998 University of Nijmegen
......@@ -12,40 +16,73 @@ from StdBool import not
// For the time-being, macro definitions are used for this purpose
// This may cause misleading error messages in case of type errors
//* Meta-class describing interval types with an absolute zero.
class PlusMin a | + , - , zero a
//* Meta-class describing ratio types.
class MultDiv a | * , / , one a
//* Meta-class describing arithmetical types.
class Arith a | PlusMin , MultDiv , abs , sign , ~ a
//* Meta-class describing types that can be incremented and decremented.
class IncDec a | + , - , one , zero a
where
//* Increment a value by one.
inc :: !a -> a | + , one a
inc x :== x + one
//* Decrement a value by one.
dec :: !a -> a | - , one a
dec x :== x - one
//* Meta-class describing types that can be enumerated.
class Enum a | < , IncDec a
/**
* Equality.
* @var The type for which values can be equated
*/
class Eq a | == a
where
/**
* Inequality.
* @result True iff the parameters are not equal
*/
(<>) infix 4 :: !a !a -> Bool | Eq a
(<>) x y :== not (x == y)
/**
* Ordering.
* @var The type that can be ordered.
*/
class Ord a | < a
where
/**
* Greater than.
* @result True iff the first value is strictly greater than the second value.
*/
(>) infix 4 :: !a !a -> Bool | Ord a
(>) x y :== y < x
/**
* Smaller than or equal to.
* @result True iff the first value is smaller than or equal to the second value.
*/
(<=) infix 4 :: !a !a -> Bool | Ord a
(<=) x y :== not (y<x)
/**
* Greater than or equal to.
* @result True iff the first value is greater than or equal to the second value.
*/
(>=) infix 4 :: !a !a -> Bool | Ord a
(>=) x y :== not (x<y)
//* The minimum of two values.
min::!a !a -> a | Ord a
min x y :== case (x<y) of True = x; _ = y
//* The maximum of two values.
max::!a !a -> a | Ord a
max x y :== case (x<y) of True = y; _ = x
definition module StdDebug
/**
* Functions that write intermediate results to stderr for debugging purposes.
*/
// ********************************************************
// Concurrent Clean Standard Library Module Version 2.0
// Copyright 1998 University of Nijmegen
......@@ -12,16 +16,48 @@ from StdString import instance toString {#Char},instance toString Int
// The following functions should only be used for debugging,
// because these functions have side effects
trace :: !msg .a -> .a | toString msg // write toString msg to stderr
// before evaluating a
special msg={#Char}; msg=Int
trace_n :: !msg .a -> .a | toString msg // write toString msg and newline to stderr
// before evaluating a
special msg={#Char}; msg=Int
trace_t :: !msg -> Bool | toString msg // write toString msg to stderr
// result is True
special msg={#Char}; msg=Int
trace_tn :: !msg -> Bool | toString msg // write toString msg and newline to stderr
// result is True
special msg={#Char}; msg=Int
/**
* Write a message to stderr before returning a value.
*
* @param The message to write to stderr
* @param The value to return
* @result Param 2
*/
trace :: !msg .a -> .a | toString msg special msg={#Char}; msg=Int
/**
* Write a message and a newline to stderr before returning a value.
*
* @param The message to write to stderr
* @param The value to return
* @result Param 2
*/
trace_n :: !msg .a -> .a | toString msg special msg={#Char}; msg=Int
/**
* Write a message to stderr and return True. This is useful in guards, for
* example:
*
* ```
* square x
* | trace_t x = x * x
* ```
*
* @param The message to write to stderr
* @result True
*/
trace_t :: !msg -> Bool | toString msg special msg={#Char}; msg=Int
/**
* Write a message and a newline to stderr and return True. This is useful in
* guards, for example:
*
* ```
* square x
* | trace_tn x = x * x
* ```
*
* @param The message to write to stderr
* @result True
*/
trace_tn :: !msg -> Bool | toString msg special msg={#Char}; msg=Int
definition module StdEnum
/**
* This module must be imported if dotdot expressions are used.
* Then, the following constructs can be used:
*
* - `[from .. ]` -> `{{_from}} from`
* - `[from .. to]` -> `{{_from_to}} from to`
* - `[from, then .. ]` -> `{{_from_then}} from then`
* - `[from, then .. to]` -> `{{_from_then_to}} from then to`
*/
// ****************************************************************************************
// Concurrent Clean Standard Library Module Version 2.0
// Copyright 1998 University of Nijmegen
// ****************************************************************************************
/*
This module must be imported if dotdot expressions are used
[from .. ] -> _from from
[from .. to] -> _from_to from to
[from, then .. ] -> _from_then from then
[from, then .. to] -> _from_then_to from then to
*/
import _SystemEnum
......@@ -40,7 +40,7 @@
.desc REAL _hnf _hnf 0 0 "REAL"
.desc INT _hnf _hnf 0 0 "INT"
.desc REAL32 _hnf _hnf 0 0 "REAL32"
.desc INT32 _hnf _hnf 0 0 "INT32"
.desc INT32 _hnf _hnf 0 0 "INT32"
.desc BOOL _hnf _hnf 0 0 "BOOL"
.desc CHAR _hnf _hnf 0 0 "CHAR"
......@@ -248,16 +248,6 @@ ea_S.1
jmp_eval_upd
.pe
.o 1 0
o_S.1
get_node_arity 0
pushI 1
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.descs d_S.2 n_S.2 _ 2 0 "_S.2"
.pb "_S.2"
.n -1 d_S.2 ea_S.2
......@@ -309,21 +299,6 @@ ea_S.2_
jmp_eval_upd
.pe
.o 1 0
o_S.2
get_node_arity 0
eqI_b 2 0
jmp_false o_S.2_
pop_b 1
repl_arg 2 2
.d 1 0
rtn
o_S.2_
repl_arg 3 2
pop_b 1
.d 1 0
rtn
.descs d_S.3 n_S.3 _ 4 0 "_S.3"
.pb "_S.3"
.n -1 d_S.3 ea_S.3
......@@ -360,17 +335,8 @@ ea_S.3
jmp_eval_upd
.pe
.o 1 0
o_S.3
get_node_arity 0
pushI 3
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.descs d_S.4 n_S.4 _ 5 0 "_S.4"
.pb "_S.4"
.n -1 d_S.4 ea_S.4
.o 1 0
n_S.4
......@@ -403,18 +369,10 @@ ea_S.4
update_a 0 1
pop_a 1
jmp_eval_upd
.o 1 0
o_S.4
get_node_arity 0
pushI 4
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.pe
.descs d_S.5 n_S.5 _ 6 0 "_S.5"
.pb "_S.5"
.n -1 d_S.5 ea_S.5
.o 1 0
n_S.5
......@@ -447,18 +405,10 @@ ea_S.5
update_a 0 1
pop_a 1
jmp_eval_upd
.o 1 0
o_S.5
get_node_arity 0
pushI 5
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.pe
.descs d_S.6 n_S.6 _ 7 0 "_S.6"
.pb "_S.6"
.n -1 d_S.6 ea_S.6
.o 1 0
n_S.6
......@@ -491,18 +441,7 @@ ea_S.6
update_a 0 1
pop_a 1
jmp_eval_upd
.o 1 0
o_S.6
get_node_arity 0
pushI 6
push_arg_b 0
update_a 0 1
pop_a 1
.d 1 0
rtn
.pe
.desc d_Sr.1 n_Sr.1 o_Sr.1 1 0 "_Sr.1"
......@@ -1391,33 +1330,31 @@ _print__array2
print_sc "{"
push_b 0
eq_desc_b BOOL 0
jmp_true _print_bool_array
eqI_b 0 0
jmp_true _print_array_a
push_b 0
eq_desc_b INT 0
eqD_b BOOL 0
jmp_true _print_bool_array
eqD_b INT 0
jmp_true _print_int_array
push_b 0
eq_desc_b REAL 0
eqD_b REAL 0
jmp_true _print_real_array
eqD_b INT32 0
jmp_true _print_int32_array
eqD_b REAL32 0
jmp_true _print_real32_array
pop_b 1
pushI 0
push_a 0
push_arraysize _ 0 1
jmp _print_record_array
push_b 2
update_b 2 3
update_b 1 2
update_b 0 1
_print_array_a
pop_b 1
pushI 0
eqI
jmp_false _print_record_array
push_a 0
push_arraysize _ 0 1
jmp _print_array_lp2
.o 1 2 i i
_print_array_lp1
......@@ -1737,11 +1674,7 @@ _no_comma_3
push_a 0
select REAL 0 2
create
fillR_b 0 0
pop_b 1
print_symbol_sc 0
pop_a 1
print_real
push_b 1
incI
......@@ -1755,6 +1688,68 @@ _print_real_array_lp2
pop_b 2
print_sc "}"
jmp _print_brackets
_print_int32_array
pop_b 1
pushI 0
push_a 0
push_arraysize INT32 0 1
jmp _print_int32_array_lp2
.o 1 2 i i
_print_int32_array_lp1
eqI_b 0 1
jmp_true _no_comma_4
print_sc ","
_no_comma_4
push_b 1
push_a 0
select INT32 0 1
print_int
push_b 1
incI
update_b 0 2
pop_b 1
decI
_print_int32_array_lp2
eqI_b 0 0
jmp_false _print_int32_array_lp1
pop_a 1
pop_b 2
print_sc "}"
jmp _print_brackets
_print_real32_array
pop_b 1
push_a 0
pushI 0
push_arraysize REAL32 0 2
jmp _print_real32_array_lp2
.o 1 2 i i
_print_real32_array_lp1
eqI_b 0 1
jmp_true _no_comma_5
print_sc ","
_no_comma_5
push_b 1
push_a 0
select REAL32 0 2
print_real
push_b 1
incI
update_b 0 2
pop_b 1
decI
_print_real32_array_lp2
eqI_b 0 0
jmp_false _print_real32_array_lp1
pop_a 1
pop_b 2
print_sc "}"
jmp _print_brackets
_print_nil
print_sc "[]"
......@@ -2169,33 +2164,31 @@ _eval__array
_eval__array2
push_r_args_b 0 0 2 2 1
push_b 0
eq_desc_b BOOL 0
jmp_true _eval_bool_array
eqI_b 0 0
jmp_true _eval_array_a
push_b 0
eq_desc_b INT 0
eqD_b BOOL 0
jmp_true _eval_bool_array
eqD_b INT 0
jmp_true _eval_int_array
push_b 0
eq_desc_b REAL 0
eqD_b REAL 0
jmp_true _eval_real_array
eqD_b INT32 0
jmp_true _eval_int32_array
eqD_b REAL32 0
jmp_true _eval_real32_array
pop_b 1
pushI 0
push_a 0
push_arraysize _ 0 1
jmp _eval_record_array
push_b 2
update_b 2 3
update_b 1 2
update_b 0 1
_eval_array_a
pop_b 1
pushI 0
eqI
jmp_false _eval_record_array
push_a 0
push_arraysize _ 0 1
jmp _eval_array_lp2
.o 1 2 i i
_eval_array_lp1
......@@ -2306,9 +2299,11 @@ _eval_char_array
.d 0 0
rtn
_eval_real_array
_eval_bool_array
_eval_int_array
_eval_real_array
_eval_int32_array
_eval_real32_array
pop_b 1
pop_a 1
.d 0 0
......
definition module StdEnv
/**
* Clean's official Standard Environment library.
*/
// ****************************************************************************************
// Concurrent Clean Standard Library Module Version 3.0
// Copyright 2018 Radboud University
......
system module StdFile
/**
* Functions to manipulate the file system with the File type.
*/
// ****************************************************************************************
// Concurrent Clean Standard Library Module Version 3.0
// Copyright 2019 University of Nijmegen
......@@ -7,110 +11,206 @@ system module StdFile
// File modes synonyms
FReadText :== 0 // Read from a text file
FWriteText :== 1 // Write to a text file
FAppendText :== 2 // Append to an existing text file
FReadData :== 3 // Read from a data file
FWriteData :== 4 // Write to a data file
FAppendData :== 5 // Append to an existing data file
//* File mode: read text
FReadText :== 0
//* File mode: write text
FWriteText :== 1
//* File mode: append text
FAppendText :== 2
//* File mode: read data
FReadData :== 3
//* File mode: write data
FWriteData :== 4
//* File mode: append data
FAppendData :== 5
// Seek modes synonyms
FSeekSet :== 0 // New position is the seek offset
FSeekCur :== 1 // New position is the current position plus the seek offset
FSeekEnd :== 2 // New position is the size of the file plus the seek offset
//* Seek mode: the new position is the seek offset
FSeekSet :== 0
:: *Files
//* Seek mode: the new position is the current position plus the seek offset
FSeekCur :== 1
// Acces to the FileSystem (Files)
//* Seek mode: the new position is the size of the file plus the seek offset
FSeekEnd :== 2
/**
* The filesystem environment, independent from *World. This type can only be
* used through the FileSystem and FileEnv classes.
*/
:: *Files
/**
* Access to the filesystem.
*
* @var The unique type that is used to ensure purity.
*/
class FileSystem f where
/**
* Opens a file for the first time in a certain mode.
* @param The filename
* @param The mode (read / write / append; text / data)
* @param The {{`FileSystem`}} (usually {{`World`}})
* @result A boolean indicating success
* @result The {{`File`}}
* @result The new {{`FileSystem`}}
*/
fopen :: !{#Char} !Int !*f -> (!Bool,!*File,!*f)
/* Opens a file for the first time in a certain mode (read, write or append, text or data).
The boolean output parameter reports success or failure. */
/**
* Closes a file.
* @param The {{`File`}}
* @param The {{`FileSystem`}}
* @result A boolean indicating success
* @result The new {{`FileSystem`}}
*/
fclose :: !*File !*f -> (!Bool,!*f)
/* Closes a file */
//* Open the 'Console' for reading and writing.
stdio :: !*f -> (!*File,!*f)
/* Open the 'Console' for reading and writing. */
/**
* With `sfopen` a file can be opened for reading more than once. On a file
* opened by `sfopen` only the operations beginning with `sf` can be used.
* The `sf...` operations work just like the corresponding `f...`
* operations. They can't be used for files opened with {{`fopen`} or
* {{`freopen`}}.
*
* @param The filename
* @param The mode (read; text / data)
* @param The {{`FileSystem`}} (usually {{`World`}})
* @result A boolean indicating success
* @result The new {{`File`}}
* @result The new {{`FileSystem`}}
*/
sfopen :: !{#Char} !Int !*f -> (!Bool,!File,!*f)
/* With sfopen a file can be opened for reading more than once.
On a file opened by sfopen only the operations beginning with sf can be used.
The sf... operations work just like the corresponding f... operations.
They can't be used for files opened with fopen or freopen. */
instance FileSystem Files
instance FileSystem World
/**
* An environment in which files can be dealt with.
*
* @var The unique type that is used to ensure purity.
*/
class FileEnv env where
accFiles :: !.(*Files -> (.x,*Files)) !*env -> (!.x,!*env)
appFiles :: !.(*Files -> *Files) !*env -> *env
instance FileEnv World
// openfiles :: !*World -> (!*Files,!*World) // no longer supported
// closefiles :: !*Files !*World -> *World // no longer supported
/**
* Re-opens an open file in a possibly different mode.
* @param The file
* @param The new mode
* @result A boolean indicating successful closing before reopening
* @result The new file
*/
freopen :: !*File !Int -> (!Bool,!*File) :== code { .d 0 3 f i ; jsr reopenF ; .o 0 3 b f }
/* Re-opens an open file in a possibly different mode.
The boolean indicates whether the file was successfully closed before reopening. */
// Reading from a File:
/**
* Reads a character from a text file or a byte from a datafile.
* @result A boolean indicating success
* @result The read character
*/
freadc :: !*File -> (!Bool,!Char,!*File) :== code { .d 0 2 f ; jsr readFC ; .o 0 4 b c f }
/* Reads a character from a text file or a byte from a datafile.
The boolean indicates succes or failure */
/**
* Reads an Integer from a textfile by skipping spaces, tabs and newlines and
* then reading digits, which may be preceeded by a plus or minus sign.
* From a datafile `freadi` will just read four bytes (a Clean Int).
* @result A boolean indicating success
* @result The read integer
*/
freadi :: !*File -> (!Bool,!Int,!*File) :== code { .d 0 2 f ; jsr readFI ; .o 0 4 b i f }
/* Reads an Integer from a textfile by skipping spaces, tabs and newlines and
then reading digits, which may be preceeded by a plus or minus sign.
From a datafile freadi will just read four bytes (a Clean Int). */
/**
* Reads a Real from a textfile by skipping spaces, tabs and newlines and then
* reading a character representation of a Real number.
* From a datafile `freadr` will just read eight bytes (a Clean Real).
* @result A boolean indicating success
* @result The read real
*/
freadr :: !*File -> (!Bool,!Real,!*File) :== code { .d 0 2 f ; jsr readFR ; .o 0 5 b r f }
/* Reads a Real from a textfile by skipping spaces, tabs and newlines and then
reading a character representation of a Real number.
From a datafile freadr will just read eight bytes (a Clean Real). */
/**
* Reads n characters from a text or data file, which are returned as a String.
* If the file doesn't contain n characters the file will be read to the end
* of the file. An empty String is returned if no characters can be read.
* @param The file
* @param The amount of characters to read
* @result The read string
* @result The file
*/
freads :: ! *File !Int -> (!*{#Char},!*File) :== code { .d 0 3 f i ; jsr readFS ; .o 1 2 f }
/* Reads n characters from a text or data file, which are returned as a String.
If the file doesn't contain n characters the file will be read to the end
of the file. An empty String is returned if no characters can be read. */
/**
* Reads `n` characters from a text or data file, which are returned in the
* string `arg3` at positions `arg1`..`arg1+arg2-1`. If the file doesn't
* contain `arg2` characters the file will be read to the end of the file, and
* the part of the string `arg3` that could not be read will not be changed.
*
* @param The start of the substring to modify
* @param The length of the substring
* @param The string to modify
* @result The number of characters read
* @result The modified string
*/
freadsubstring :: !Int !Int !*{#Char} !*File -> (!Int,!*{#Char},!*File) :== code { .d 1 4 i i f ; jsr readFString ; .o 1 3 i f }
/*
Reads n characters from a text or data file, which are returned in the string
arg3 at positions arg1..arg1+arg2-1. If the file doesn't contain arg2 characters
the file will be read to the end of the file, and the part of the string arg3 that
could not be read will not be changed. The number of characters read, the modified
string and the file are returned.
*/
/**
* Reads a line from a textfile, including a newline character, except for the
* last line. `freadline` cannot be used on data files.
*/
freadline :: !*File -> (!*{#Char},!*File) :== code { .d 0 2 f ; jsr readLineF ; .o 1 2 f }
/* Reads a line from a textfile. (including a newline character, except for the last
line) freadline cannot be used on data files. */
// Writing to a File:
/**
* Writes a character to a textfile.
* To a datafile fwritec writes one byte (a Clean Char).
*/
fwritec :: !Char !*File -> *File :== code { .d 0 3 c f ; jsr writeFC ; .o 0 2 f }
/* Writes a character to a textfile.
To a datafile fwritec writes one byte (a Clean Char). */
/**
* Writes an Integer (its textual representation) to a text file. To a datafile
* fwritei writes four bytes (a Clean Int).
*/
fwritei :: !Int !*File -> *File :== code { .d 0 3 i f ; jsr writeFI ; .o 0 2 f }
/* Writes an Integer (its textual representation) to a text file.
To a datafile fwritei writes four bytes (a Clean Int). */
/**
* Writes a Real (its textual representation) to a text file. To a datafile
* fwriter writes eight bytes (a Clean Real).
*/
fwriter :: !Real !*File -> *File :== code { .d 0 4 r f ; jsr writeFR ; .o 0 2 f }
/* Writes a Real (its textual representation) to a text file.
To a datafile fwriter writes eight bytes (a Clean Real). */
//* Writes a String to a text or data file.
fwrites :: !{#Char} !*File -> *File :== code { .d 1 2 f ; jsr writeFS ; .o 0 2 f }
/* Writes a String to a text or data file. */
/**
* Writes the characters at positions `arg1`..`arg1+arg2-1` of string `arg3` to
* a text or data file.
*/
fwritesubstring :: !Int !Int !{#Char} !*File -> *File :== code { .d 1 4 i i f ; jsr writeFString ; .o 0 2 f }
/* Writes the characters at positions arg1..arg1+arg2-1 of string arg3 to
a text or data file. */
/**
* Overloaded write to file. This allows you to chain write operations, like:
* `# f = f <<< "X is: " <<< x <<< "; y is: " <<< y <<< "\n"`
*
* @var The type that can be written to a file
* @param The File
* @param The thing to write
* @result The new File
*/
class (<<<) infixl a :: !*File !a -> *File
/* Overloaded write to file */
instance <<< Int :: !*File !Int -> *File :== code { push_b 2 ; update_b 2 3 ; update_b 1 2 ; updatepop_b 0 1 ; .d 0 3 i f ; jsr writeFI ; .o 0 2 f }
instance <<< Char :: !*File !Char -> *File :== code { push_b 2 ; update_b 2 3 ; update_b 1 2 ; updatepop_b 0 1 ; .d 0 3 c f ; jsr writeFC ; .o 0 2 f }
......@@ -119,24 +219,35 @@ instance <<< Real :: !*File !Real -> *File :== code { push_b 3 ; push_b 3
// Testing:
/**
* @result Whether end-of-file has been reached
*/
fend :: !*File -> (!Bool,!*File) :== code { .d 0 2 f ; jsr endF ; .o 0 3 b f }
/* Tests for end-of-file. */
/**
* @result Whether an error has occurred during previous file I/O operations
*/
ferror :: !*File -> (!Bool,!*File) :== code { .d 0 2 f ; jsr errorF ; .o 0 3 b f }
/* Has an error occurred during previous file I/O operations? */
/**
* @result The current position of the file pointer as an Integer. This
* position can be used later on for the fseek function.
*/
fposition :: !*File -> (!Int,!*File) :== code { .d 0 2 f ; jsr positionF ; .o 0 3 i f }
/* returns the current position of the file poInter as an Integer.
This position can be used later on for the fseek function. */
/**
* Move to a different position in the file
*
* @param The offset
* @param A seek mode ({{`FSeekSet`}}, {{`FSeekCur`}} or {{`FSeekEnd`}})
* @result True iff the seek was successful
*/
fseek :: !*File !Int !Int -> (!Bool,!*File) :== code { .d 0 4 f i i ; jsr seekF ; .o 0 3 b f }
/* Move to a different position in the file, the first Integer argument is the offset,
the second argument is a seek mode. (see above). True is returned if successful. */
// Predefined files.
//* Open the 'Errors' file for writing only. May be opened more than once.
stderr :: *File :== code { .d 0 0 ; jsr stderrF ; .o 0 2 f }
/* Open the 'Errors' file for writing only. May be opened more than once. */
// Opening and reading Shared Files:
......@@ -155,7 +266,8 @@ sfposition :: !File -> Int :== code { .d 0 2 f ; jsr positionSF ; .o
// Convert a *File into:
//* Change a file so that from now it can only be used with `sf...` operations.
fshare :: !*File -> File :== code { .d 0 2 f ; jsr shareF ; .o 0 2 f }
/* Change a file so that from now it can only be used with sf... operations. */
//* Flush all I/O operations on a file.
fflush :: !*File -> (!Bool,!*File) :== code { .d 0 2 f ; jsr flushF ; .o 0 3 bf }
definition module StdFunc
/**
* A number of general functions and functions dealing with functions.
*/
// ****************************************************************************************
// Concurrent Clean Standard Library Module Version 3.0
// Copyright 2018 Radboud University
......@@ -9,15 +13,38 @@ import StdFunctions
// Some handy functions for transforming unique states:
seq :: ![.(.s -> .s)] .s -> .s // fn-1 (..(f1 (f0 x))..)
seqList :: ![St .s .a] .s -> ([.a],.s) // fn-1 (..(f1 (f0 x))..)
/**
* Iterate a list of state functions.
*
* @param The functions
* @param The initial state
* @result The final state
*/
seq :: ![.(.s -> .s)] .s -> .s
/**
* Iterate a list of state functions with result
*
* @param The functions
* @param The initial state
* @result A list of results from the state function and the final state
*/
seqList :: ![St .s .a] .s -> ([.a],.s)
//* A function that updates a state and produces a result.
:: St s a :== s -> *(a,s)
// monadic style:
(`bind`) infix 0 // :: w:(St .s .a) v:(.a -> .(St .s .b)) -> u:(St .s .b), [u <= v, u <= w]
/**
* Monadic bind for the {{`St`}} type.
* @type w:(St .s .a) v:(.a -> .(St .s .b)) -> u:(St .s .b), [u <= v, u <= w]
*/
(`bind`) infix 0
(`bind`) f g :== \st0 -> let (r,st1) = f st0 in g r st1
// return :: u:a -> u:(St .s u:a)
/**
* Monadic return for the {{`St`}} type.
* @type u:a -> u:(St .s u:a)
*/
return r :== \s -> (r,s)
......@@ -5,16 +5,29 @@ definition module StdFunctions
// Copyright 2018 Radboud University
// ****************************************************************************************
id :: !.a -> .a // identity function
const :: !.a .b -> .a // constant function
//* The identity function.
id :: !.a -> .a
//* Always returns the first argument.
const :: !.a .b -> .a
//flip :: !.(.a -> .(.b -> .c)) .b .a -> .c // Flip arguments
/**
* Flips the arguments of a function. This is useful in function compositions.
* @type !.(.a -> .(.b -> .c)) .b .a -> .c
*/
flip f a b :== f b a
(o) infixr 9 // :: u:(.a -> .b) u:(.c -> .a) -> u:(.c -> .b) // Function composition
/**
* Function composition: apply `f` after `g`.
* @type u:(.a -> .b) u:(.c -> .a) -> u:(.c -> .b)
*/
(o) infixr 9
(o) f g :== \ x -> f (g x)
twice :: !(.a -> .a) .a -> .a // f (f x)
while :: !(a -> .Bool) (a -> a) a -> a // while (p x) f (f x)
until :: !(a -> .Bool) (a -> a) a -> a // f (f x) until (p x)
iter :: !Int (.a -> .a) .a -> .a // f (f..(f x)..)
//* Apply the function argument twice.
twice :: !(.a -> .a) .a -> .a
//* Apply the second argument as long as the first argument holds.
while :: !(a -> .Bool) (a -> a) a -> a
//* Apply the second argument until the first argument holds.
until :: !(a -> .Bool) (a -> a) a -> a
//* Apply a function a number of times.
iter :: !Int (.a -> .a) .a -> .a
......@@ -64,6 +64,11 @@ derive bimap RECORD
derive bimap FIELD
derive bimap (->)
generic binumap a b | binumap b a :: a -> b
derive binumap c
derive binumap (->)
// HACK: dictionaries for all generics.
// It works since all generic classes have only one method and do not inherit
// from other classes
......
......@@ -21,6 +21,12 @@ bimap{|OBJECT|} fx _ (OBJECT x) = OBJECT (fx x)
bimap{|(->)|} _ ba fr _ f = comp3 fr f ba
generic binumap a b | binumap b a :: a ->b
binumap{|c|} x = x
binumap{|(->)|} _ ba fr _ f = comp3 fr f ba
comp3 :: !(.a -> .b) u:(.c -> .a) !(.d -> .c) -> u:(.d -> .b)
comp3 f g h
| is_id f
......
system module StdInt
/**
* Class instances and basic functions for the Int type.
*/
// ****************************************************************************************
// Concurrent Clean Standard Library Module Version 2.0
// Copyright 1998 University of Nijmegen
......@@ -49,17 +53,65 @@ instance lcm Int // Least common multiple
// Operators on Bits:
/**
* Bitwise disjunction.
*
* @param The first integer
* @param The second integer
* @result An integer with exactly those bits set that at least one of the parameters has set
*/
(bitor) infixl 6 :: !Int !Int -> Int :== code { or% }
// Bitwise Or of arg1 and arg2
/**
* Bitwise conjunction.
*
* @param The first integer
* @param The second integer
* @result An integer with exactly those bits set that both of the parameters have set
*/
(bitand) infixl 6 :: !Int !Int -> Int :== code { and% }
// Bitwise And of arg1 and arg2
/**
* Bitwise exclusive disjunction.
*
* @param The first integer
* @param The second integer
* @result An integer with exactly those bits set that exactly one of the parameters has set
*/ <