Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
755dccc9
Commit
755dccc9
authored
Oct 17, 2001
by
Diederik van Arkel
Browse files
Clean 2.0 changes remaining projects
parent
e736ddd7
Changes
10
Hide whitespace changes
Inline
Side-by-side
BatchBuild/IdeState.dcl
View file @
755dccc9
...
...
@@ -61,5 +61,11 @@ getCurrentLink :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentVers
::
!*(
PSt
*
General
)
->
(!
Int
,!*
PSt
*
General
)
getCurrentMeth
::
!*(
PSt
*
General
)
->
(!
CompileMethod
,!*
PSt
*
General
)
//-- boolean that indicates if user interaction is allowed
getInteract
::
!*(
PSt
*
General
)
->
(!
Bool
,!*
PSt
*
General
)
//-- log functions for batch build
writeLog
::
!
String
!*(
PSt
*
General
)
->
!*
PSt
*
General
abortLog
::
!
Bool
!
String
!*(
PSt
*
General
)
->
!*
PSt
*
General
BatchBuild/IdeState.icl
View file @
755dccc9
...
...
@@ -170,6 +170,9 @@ getCurrentMeth ps
#
(
ct
,
ps
)
=
accPLoc
(\
p
=:{
pm_targets
,
pm_curtarg
}->(
pm_targets
!!
pm_curtarg
,
p
))
ps
=
(
ct
.
target_meth
,
ps
)
getInteract
::
!*(
PSt
*
General
)
->
(!
Bool
,!*
PSt
*
General
)
getInteract
ps
=
(
False
,
ps
)
writeLog
::
!
String
!*(
PSt
*
General
)
->
!*
PSt
*
General
writeLog
message
ps
=
appPLoc
(\
ls
=:{
logfile
}
->
{
ls
&
logfile
=
writeLogfile
message
logfile
})
ps
...
...
BatchBuild/typewin.dcl
View file @
755dccc9
...
...
@@ -5,7 +5,7 @@ import StdWindowDef
import
StdPSt
//import IdeState
updateTypeWindow
::
!
String
[
Int
]
![
String
]
!*(
PSt
*
b
)
->
*
PSt
*
b
|
Typer
b
updateTypeWindow
::
!
Bool
!
String
[
Int
]
![
String
]
!*(
PSt
*
b
)
->
*
PSt
*
b
|
Typer
b
tw_safe_close
::
!*(
PSt
*
b
)
->
*
PSt
*
b
|
Typer
b
...
...
BatchBuild/typewin.icl
View file @
755dccc9
...
...
@@ -5,8 +5,8 @@ import StdWindowDef
import
StdPSt
//import IdeState
updateTypeWindow
::
!
String
[
Int
]
![
String
]
!*(
PSt
*
b
)
->
*
PSt
*
b
|
Typer
b
updateTypeWindow
_
_
_
ps
=
ps
updateTypeWindow
::
!
Bool
!
String
[
Int
]
![
String
]
!*(
PSt
*
b
)
->
*
PSt
*
b
|
Typer
b
updateTypeWindow
_
_
_
_
ps
=
ps
tw_safe_close
::
!*(
PSt
*
b
)
->
*
PSt
*
b
|
Typer
b
tw_safe_close
ps
=
ps
...
...
HeapProfile/ExtNotice.icl
View file @
755dccc9
...
...
@@ -11,19 +11,19 @@ import StdId, StdPSt, StdWindow, StdTimer
instance
Dialogs
Notice
where
openDialog
::
.
ls
(
Notice
.
ls
(
PSt
.
l
))
(
PSt
.
l
)
->
(!
ErrorReport
,
!
PSt
.
l
)
//
openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openDialog
ls
(
noticeToDialog
wId
okId
notice
)
ps
openModalDialog
::
.
ls
(
Notice
.
ls
(
PSt
.
l
))
(
PSt
.
l
)
->
(!(!
ErrorReport
,!
Maybe
.
ls
),!
PSt
.
l
)
//
openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openModalDialog
ls
(
noticeToDialog
wId
okId
notice
)
ps
getDialogType
::
(
Notice
.
ls
.
ps
)
->
WindowType
//
getDialogType :: (Notice .ls .ps) -> WindowType
getDialogType
_
=
"Notice"
...
...
@@ -65,19 +65,19 @@ okNotice text ps :== openNotice (Notice text (NoticeButton "OK" (\x->x)) []) ps
instance
Dialogs
TimedNotice
where
openDialog
::
.
ls
(
TimedNotice
.
ls
(
PSt
.
l
))
(
PSt
.
l
)
->
(!
ErrorReport
,
!
PSt
.
l
)
//
openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openDialog
ls
(
timednoticeToDialog
wId
okId
notice
)
ps
openModalDialog
::
.
ls
(
TimedNotice
.
ls
(
PSt
.
l
))
(
PSt
.
l
)
->
(!(!
ErrorReport
,!
Maybe
.
ls
),!
PSt
.
l
)
//
openModalDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openModalDialog
ls
(
timednoticeToDialog
wId
okId
notice
)
ps
getDialogType
::
(
TimedNotice
.
ls
.
ps
)
->
WindowType
//
getDialogType :: (TimedNotice .ls .ps) -> WindowType
getDialogType
_
=
"TimerNotice"
...
...
HeapProfile/ShowHeapProfile.dcl
View file @
755dccc9
...
...
@@ -9,7 +9,7 @@ import StdPicture, StdPrint
,
application_name
::
String
}
empty_progstate
::
.
PrintSetup
->
*
ProgState
[.
a
];
empty_progstate
::
PrintSetup
->
*
ProgState
[.
a
];
::
SizeByNodeKindElem
...
...
@@ -21,7 +21,7 @@ compare_function_name :: !.SizeByNodeKindElem !.SizeByNodeKindElem -> Bool;
compare_module_name
::
!.
SizeByNodeKindElem
!.
SizeByNodeKindElem
->
Bool
;
compare_heap_use
::
!.
SizeByNodeKindElem
!.
SizeByNodeKindElem
->
Bool
;
printTable
::
.
Font
.(
ProgState
[
SizeByNodeKindElem
])
*
a
->
*(.
ProgState
[
SizeByNodeKindElem
],*
a
)
|
PrintEnvironments
a
;
printTable
::
Font
.(
ProgState
[
SizeByNodeKindElem
])
*
a
->
*(.
ProgState
[
SizeByNodeKindElem
],*
a
)
|
PrintEnvironments
a
;
show_next_page
::
u
:(
ProgState
[.
SizeByNodeKindElem
])
*
a
->
*(
v
:
ProgState
[
SizeByNodeKindElem
],*
a
)
|
FileEnv
a
,
[
u
<=
v
];
show_prev_page
::
u
:(
ProgState
[.
SizeByNodeKindElem
])
*
a
->
*(
v
:
ProgState
[
SizeByNodeKindElem
],*
a
)
|
FileEnv
a
,
[
u
<=
v
];
...
...
HeapProfile/ShowHeapProfile.icl
View file @
755dccc9
...
...
@@ -65,7 +65,7 @@ empty_header = {
FileExists
_
=
code {
ccall
FileExists
"S-I"
}
}
;
import
expand_8_3_names_in_path
,
ArgEnv
;
//,handler;
/*
...
...
@@ -781,10 +781,10 @@ compute_sizes_by_node_kind :: !.Header .Descriptors !*{#.Char} !{#.Char} {#.Char
compute_sizes_by_node_kind
header
descriptors
heap
heap2
data
text
stack
#!
size_heap
=
size
heap
;
=
let
bits1
::.{#
Int
};
bits1
::
.{#
Int
};
bits1
=
createArray
((
size_heap
+63
)>>
6
)
0
;
bits2
::.{#
Int
};
bits2
::
.{#
Int
};
bits2
=
createArray
((
size
heap2
+63
)>>
6
)
0
;
in
size_stack
descriptors
0
NilSizeByNodeKind
bits1
bits2
heap
;
...
...
@@ -926,7 +926,7 @@ compute_sizes_by_node_kind header descriptors heap heap2 data text stack
// dus arrays met bijv. record als elementen worden niet ondersteund?
=
abort
"compute_size_graph_by_node_kind: array"
;
// waarom kom ik hier?
=
abort
"compute_size_graph_by_node_kind: arity 0"
;
=
abort
"compute_size_graph_by_node_kind: arity 0"
;
// arity <> 0
#
a_size
=
data
WORD
(
data_offset
+2
);
|
arity
>=
256
&&
a_size
==
0
...
...
@@ -1189,15 +1189,14 @@ where
draw_profile_line
background_box
name
heap_size
y_pos
picture
//*
#
picture
=
case
background_box
of
{
True
->
picture
>:
setPenColour
MyGrey
>:
FillRectangle
((
positions
!!
0
,
y_pos
-
line_height
+
delta_text
),(
positions
!!
5
,
y_pos
+
delta_text
))
>:
DrawLine
((
0
,
y_pos
+
delta_text
),
(
positions
!!
4
,
y_pos
+
delta_text
))
>:
setPenColour
Black
;
False
->
unfill
{
corner1
={
x
=
positions
!!
0
,
y
=
y_pos
-
line_height
+
delta_text
},
corner2
={
x
=
positions
!!
5
,
y
=
y_pos
+
delta_text
}}
picture
;
};
#
picture
=
case
background_box
of
True
->
picture
>:
setPenColour
MyGrey
>:
FillRectangle
((
positions
!!
0
,
y_pos
-
line_height
+
delta_text
),(
positions
!!
5
,
y_pos
+
delta_text
))
>:
DrawLine
((
0
,
y_pos
+
delta_text
),
(
positions
!!
4
,
y_pos
+
delta_text
))
>:
setPenColour
Black
;
False
->
unfill
{
corner1
={
x
=
positions
!!
0
,
y
=
y_pos
-
line_height
+
delta_text
},
corner2
={
x
=
positions
!!
5
,
y
=
y_pos
+
delta_text
}}
picture
;
//*/
=
picture
>:
draw_clipped_string_at
(
positions
!!
0+5
,
y_pos
)
function_name
(
positions
!!
1
-
positions
!!
0-10
)
>:
draw_clipped_string_at
(
positions
!!
1+5
,
y_pos
)
module_name
(
positions
!!
2
-
positions
!!
1-10
)
...
...
@@ -1234,7 +1233,7 @@ where
::
ProgState
a
=
{
node_size_list
::
a
,
node_size_sum
::
Int
,
printingSetup
::
PrintSetup
,
application_name
::
String
};
empty_progstate
::
.
PrintSetup
->
*
ProgState
[.
a
];
empty_progstate
::
PrintSetup
->
*
ProgState
[.
a
];
empty_progstate
default_ps
=
{
ProgState
|
node_size_list
=[],
...
...
@@ -1529,7 +1528,7 @@ open_file_function file_name s io
= p_open_file_function2 file_name s io;
*/
printTable
::
.
Font
.(
ProgState
[
SizeByNodeKindElem
])
*
a
->
*(.
ProgState
[
SizeByNodeKindElem
],*
a
)
|
PrintEnvironments
a
;
printTable
::
Font
.(
ProgState
[
SizeByNodeKindElem
])
*
a
->
*(.
ProgState
[
SizeByNodeKindElem
],*
a
)
|
PrintEnvironments
a
;
printTable
printFont
s
=:{
node_size_list
,
node_size_sum
,
printingSetup
,
application_name
}
env
#
(
usedPrintSetup
,
env
)
=
print
True
True
generate_pages
printingSetup
env
;
=
({
s
&
printingSetup
=
usedPrintSetup
},
env
);
...
...
HeapProfile/ioutil.dcl
View file @
755dccc9
...
...
@@ -21,7 +21,7 @@ noPS :: .(.a -> .b) !(.a,.c) -> (.b,.c)
drawLeft
::
!.
Point2
a
!*
Picture
->
*
Picture
|
toString
a
drawCenter
::
!.
Point2
a
!*
Picture
->
*
Picture
|
toString
a
drawRight
::
!.
Point2
a
!*
Picture
->
*
Picture
|
toString
a
setCheckControlItem
::
!
.
Id
.
Index
!.
Bool
!*(
IOSt
.
a
)
->
*
IOSt
.
a
;
setCheckControlItem
::
!
Id
.
Index
!.
Bool
!*(
IOSt
.
a
)
->
*
IOSt
.
a
;
zip3
::![.
a
]
[.
b
]
[.
c
]
->
[(.
a
,.
b
,.
c
)]
//unzip3 ::![(.a,.b,.c)] -> ([.a],[.b],[.c]) // now in ObjectIO/commondef
getPenAttributeFont
::
![.
PenAttribute
]
->
FontDef
;
...
...
HeapProfile/ioutil.icl
View file @
755dccc9
...
...
@@ -95,7 +95,7 @@ drawRight {x,y} info picture
(
width
,
picture
)
=
getPenFontStringWidth
text
picture
=
drawAt
{
x
=
x
-
width
,
y
=
y
}
text
picture
setCheckControlItem
::
!
.
Id
.
Index
!.
Bool
!*(
IOSt
.
a
)
->
*
IOSt
.
a
setCheckControlItem
::
!
Id
.
Index
!.
Bool
!*(
IOSt
.
a
)
->
*
IOSt
.
a
setCheckControlItem
id
idx
True
io
=
markCheckControlItems
id
[
idx
]
io
setCheckControlItem
id
idx
False
io
=
unmarkCheckControlItems
id
[
idx
]
io
...
...
TimeProfile/ExtNotice.icl
View file @
755dccc9
...
...
@@ -11,19 +11,19 @@ import StdId, StdPSt, StdWindow, StdTimer
instance
Dialogs
Notice
where
openDialog
::
.
ls
(
Notice
.
ls
(
PSt
.
l
))
(
PSt
.
l
)
->
(!
ErrorReport
,
!
PSt
.
l
)
//
openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openDialog
ls
(
noticeToDialog
wId
okId
notice
)
ps
openModalDialog
::
.
ls
(
Notice
.
ls
(
PSt
.
l
))
(
PSt
.
l
)
->
(!(!
ErrorReport
,!
Maybe
.
ls
),!
PSt
.
l
)
//
openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openModalDialog
ls
(
noticeToDialog
wId
okId
notice
)
ps
getDialogType
::
(
Notice
.
ls
.
ps
)
->
WindowType
//
getDialogType :: (Notice .ls .ps) -> WindowType
getDialogType
_
=
"Notice"
...
...
@@ -65,19 +65,19 @@ okNotice text ps :== openNotice (Notice text (NoticeButton "OK" (\x->x)) []) ps
instance
Dialogs
TimedNotice
where
openDialog
::
.
ls
(
TimedNotice
.
ls
(
PSt
.
l
))
(
PSt
.
l
)
->
(!
ErrorReport
,
!
PSt
.
l
)
//
openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openDialog
ls
(
timednoticeToDialog
wId
okId
notice
)
ps
openModalDialog
::
.
ls
(
TimedNotice
.
ls
(
PSt
.
l
))
(
PSt
.
l
)
->
(!(!
ErrorReport
,!
Maybe
.
ls
),!
PSt
.
l
)
//
openModalDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openModalDialog
ls
(
timednoticeToDialog
wId
okId
notice
)
ps
getDialogType
::
(
TimedNotice
.
ls
.
ps
)
->
WindowType
//
getDialogType :: (TimedNotice .ls .ps) -> WindowType
getDialogType
_
=
"TimerNotice"
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment