diff --git a/.gitignore b/.gitignore index 2d13a2c9..8c53ec64 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ __pycache__ .ropeproject report.xml +/base/pop/getpoploglib/scrapbook/ diff --git a/base/pop/getpoploglib/auto/$.p b/base/pop/getpoploglib/auto/$.p new file mode 100644 index 00000000..78af7477 --- /dev/null +++ b/base/pop/getpoploglib/auto/$.p @@ -0,0 +1,66 @@ +section dollar => $; + +;;; Initially tried with '$_' and hit a lot of problems with '$_{'. +lconstant autoload_prefix = 'dollar_'; +lconstant autoload_class_suffix = '_key'; + +;;; This procedure provides an extension mechanism for the $ITEM syntax. +;;; It maps from 'items' from the Pop-11 itemizer (words, string, numbers) +;;; or keys (word_key, string_key, number keys) into code-planting +;;; procedures. + +define lconstant lookup( item ); + if item.isword then + lvars w = consword( autoload_prefix <> item.word_string ); + lvars wid = word_identifier( w, pop_section, true ); + if wid then + wid.valof + else + if sys_autoload( w ) then + word_identifier( w, pop_section, true ).valof + else + false + endif + endif + else + lvars w = consword( autoload_prefix <> item.datakey.class_name.word_string <> autoload_class_suffix ); + lvars wid = word_identifier( w, pop_section, true ); + [try to autoload ^w] => + if sys_autoload( w ) then + [ succeeded] => + word_identifier( w, pop_section, true ).valof + else + false + endif; + endif +enddefine; + +define lconstant is_viable_shell_variable( w ); + returnif( w.datalength <= 0 )( false ); + lvars w1 = subscrw( 1, w ); + returnunless( w1.isalphacode or w1 == `_` )( false ); + lvars i; + for i from 2 to w.datalength do + lvars ch = subscrw( i, w ); + returnunless( ch.isalphacode or ch.isnumbercode or ch == `_` )( false ) + endfor; + return( true ) +enddefine; + +define global syntax $ ; + lvars item = readitem(); + if item.isword and item.is_viable_shell_variable then + sysPUSHQ( item.word_string ); + sysCALL -> pop_expr_inst; + "systranslate" -> pop_expr_item; + else + lvars p = lookup( item ); + if p then + p( item ) + else + mishap( 'Unexpected item after $', [^item] ) + endif + endif +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/assert.p b/base/pop/getpoploglib/auto/assert.p new file mode 100644 index 00000000..d2c0b44a --- /dev/null +++ b/base/pop/getpoploglib/auto/assert.p @@ -0,0 +1 @@ +uses define_unittest; \ No newline at end of file diff --git a/base/pop/getpoploglib/auto/define_unittest.p b/base/pop/getpoploglib/auto/define_unittest.p new file mode 100644 index 00000000..3a7f0889 --- /dev/null +++ b/base/pop/getpoploglib/auto/define_unittest.p @@ -0,0 +1,424 @@ +compile_mode :pop11 +strict; + +section $-unittest => + define_testsuite ;;; used for defining test collections + define_unittest ;;; used for defining unit tests + assert ;;; used for defining unit tests + expect_mishap ;;; used for defining unit tests + with_data ;;; used for defining unit tests with scenario data + register_unittest ;;; exported because of code-planting +; + + +constant unittest_suffix = '.test.p'; + +;;; --- expecting mishaps --- + +vars mishap_happened = false; + +vars _expect_mishap = false; + +define global active:1 expect_mishap(); + _expect_mishap; +enddefine; + +define updaterof active:1 expect_mishap( saved ); + saved -> _expect_mishap; + if not(saved) and not( mishap_happened ) do + mishap( 'Expected mishap was skipped', [] ) + endif; +enddefine; + +;;; --- test discovery and execution --- + +vars unittest_passes = undef; ;;; Part of test-execution. +vars unittest_failures = undef; ;;; Part of test-execution. +vars current_unittest = undef; ;;; Part of test-execution. + +;;; Part of test-discovery, although may be re-invoked during execution. +;;; At top-level do nothing. This will be dlocalised during test-discovery. +define vars register_unittest( u ); +enddefine; + +;;; Part of test-execution. +;;; This is defensive - we only want to run unit tests inside an appropriate +;;; dynamic context. +define vars run_unittest( p ); + mishap( 'Trying to trace unit tests with context (this should never happen)', [] ) +enddefine; + +defclass failureinfo { + failureinfo_unittest, + failureinfo_message, + failureinfo_idstring, + failureinfo_argv +}; + +;;; Part of test-execution. +;;; This will only be invoked at top-level and hence outside of a test +;;; context, so it is OK for it to simply mishap. +define vars fail_unittest( info ); + mishap( 'Unittest failed', [] ) +enddefine; + +define fail_unittest_during_execution( info ); + unittest_failures( info ); + exitfrom( run_unittest ) +enddefine; + +;;; This is the normal way to run a unit test & we will dlocalise run_unittest +;;; to its value. +define run_unittest_during_execution( p ); + + define lconstant is_expected_mishap( mess, idstring, severity, args ); + if isstartstring( 'unittest-assert:', idstring ) then + false + elseif expect_mishap == true then + true + elseif expect_mishap.isstring then + idstring = expect_mishap or mess = expect_mishap + elseif expect_mishap.isregexp then + expect_mishap( 1, idstring, false, false ) or expect_mishap( 1, mess, false, false ) + elseif expect_mishap.isprocedure and not( expect_mishap.isregexp ) then + expect_mishap( mess, idstring, severity, args ) + else + false + endif; + enddefine; + + define dlocal pop_exception_final( N, mess, idstring, severity ); + returnunless( severity == `E` or severity == `R` )( false ); + true -> mishap_happened; + lvars args = conslist( N ); + lvars is_expected = is_expected_mishap( mess, idstring, severity, args ); + if is_expected then + exitto( run_unittest ); + else + chain( consfailureinfo( current_unittest, mess, idstring, args ), fail_unittest ) + endif; + enddefine; + + dlocal current_unittest = p; + dlocal mishap_happened = false; + p(); + unittest_passes( p ); +enddefine; + +define discover_unittests( p ); + dlocal register_unittest = new_list_builder(); + erasenum(#| p() |#); + return( register_unittest( termin ) ) +enddefine; + +define run_all_unittests( unittest_list ); + dlocal unittest_passes = new_list_builder(); + dlocal unittest_failures = new_list_builder(); + [% applist( unittest_list, run_unittest ) %] -> _; ;;; defensive. + ( unittest_passes( termin ), unittest_failures( termin ) ) +enddefine; + + +;;; --- Discovery --- + +;;; This is a class to collect the results from discovery - especially inside VED. +defclass discovered { + discovered_unittests, + discovered_files_cache +}; + +define newdiscovered( unittests ); + consdiscovered( unittests, false ) +enddefine; + +define discovered_files( d ); + if d.discovered_files_cache then + d.discovered_files_cache + else + lvars t = ( + newanyproperty( + [], 8, 1, 8, + syshash, nonop =, "perm", + false, false + ) + ); + lvars u; + for u in d.discovered_unittests do + lvars ( parent, linenum ) = pdorigin( u ); + if parent.isstring do + true -> t( parent ) + endif + endfor; + nc_listsort( [% fast_appproperty( t, erase ) %], alphabefore ) ->> d.discovered_files_cache; + endif +enddefine; + + +;;; --- Syntax --- + +vars procedure unittest_sysVARS = sysVARS; + +define read_declaration( defdec ) -> ( pdrname, props, is_global, declarator ); + lvars attributes = ( + [% + repeat + lvars item = nextreaditem(); + if item == termin then + mishap( 'Unexpected end of input in unittest definition', [] ) + endif; + lvars id = identprops( item ); + quitunless( id.isword ); + quitunless( isstartstring( "syntax", id ) ); + quitif( item == ";" or item == "(" ); + readitem() + endrepeat + %] + ); + readitem() -> pdrname; + + false -> is_global; + defdec -> declarator; + + lvars a; + for a in attributes do + if a == "global" then + true -> is_global + elseif a == "lconstant" then + sysLCONSTANT -> declarator; + elseif a == "lvars" then + sysLVARS -> declarator; + elseif a == "constant" then + sysCONSTANT -> declarator; + elseif a == "vars" then + sysVARS -> declarator; + else + mishap( 'Unexpected syntax word', [^a] ) + endif + endfor; + + if pdrname == ";" or item == "(" then + pdrname :: proglist -> proglist; + sysNEW_LVAR() -> pdrname; + false -> is_global; + procedure( w, n ); endprocedure -> declarator; + "anonymous_unittest" -> props; + else + pdrname -> props + endif; +enddefine; + +define core_define_unittest(); + lvars ( pdrname, props, is_global, declarator ) = read_declaration( unittest_sysVARS ); + + lvars captured_popfilename = popfilename or vedpathname; + lvars captured_poplinenum = poplinenum; + + declarator( pdrname, 0 ); + if is_global then sysGLOBAL( pdrname, is_global ) endif; + sysPROCEDURE( props, 0 ); + dlocal unittest_sysVARS = sysLVARS; + sysLOCAL( "ident $-unittest$-mishap_happened" ); + ;;; Main body. + sysCALLQ( pop11_comp_procedure( "enddefine", false, pdrname and pdrname >< "_body" or "unittest_body" ) ); + sysPASSIGN( sysENDPROCEDURE(), pdrname ); + + sysPUSHQ( captured_popfilename ); + sysPUSHQ( captured_poplinenum ); + sysPUSH( pdrname ); + sysUCALL( "pdorigin" ); + + return( pdrname ); +enddefine; + +define :define_form global unittest; + lvars pdrname = core_define_unittest(); + sysPUSH( pdrname ); + sysCALL( "register_unittest" ); +enddefine; + +;;; with_data +;;; [0 1] +;;; [1 2] +;;; define :unittest foo( x, y ); +;;; enddefine; +define syntax with_data; + + define register_closures( data, pdr ); + lvars d; + for d in data do + register_unittest( pdr(% d.explode %) ) + endfor + enddefine; + + dlocal pop_new_lvar_list; + lvars data = sysNEW_LVAR(); + sysPUSH( "popstackmark" ); + until pop11_try_nextitem( "define" ) do + pop11_comp_expr(); + enduntil; + pop11_need_nextreaditem( ":" ) -> _; + pop11_need_nextreaditem( "unittest" ) -> _; + sysCALL( "sysconslist" ); + sysPOP( data ); + lvars pdrname = core_define_unittest(); + sysPUSH( data ); + sysPUSH( pdrname ); + sysCALLQ( register_closures ); +enddefine; + + +;;; --- Syntax: testsuite + +define :define_form global testsuite; + lvars ( pdrname, props, is_global, declarator ) = read_declaration( unittest_sysVARS ); + pop11_need_nextreaditem( ";" ) -> _; + declarator( pdrname, 0 ); + if is_global then sysGLOBAL( pdrname, is_global ) endif; + sysPROCEDURE( props, 0 ); + dlocal unittest_sysVARS = sysLVARS; + pop11_comp_stmnt_seq_to( "enddefine" ) -> _; + sysPASSIGN( sysENDPROCEDURE(), pdrname ); + sysCALL( pdrname ); +enddefine; + + +;;; --- Syntax: assert --- + +;;; Return a copy of the expanded portion of a partially expanded +;;; dynamic list without causing any further expansion. +define lconstant only_expanded( L ); + [% + while L.ispair and not( L.fast_back.isprocedure ) do + L.fast_destpair -> L + endwhile; + %] +enddefine; + +;;; -peek_expr_to- does not consume any input nor plant any code but expands -proglist- +;;; by exactly one Pop-11 expression and returns the expanded portion. +define lconstant peek_expr_to( closing_keyword ); + dlocal pop_syntax_only = true; + dlocal proglist_state; + lvars old_proglist = proglist; + pop11_comp_expr_to( closing_keyword ) -> _; + old_proglist.only_expanded; +enddefine; + +define global syntax assert(); + + define lconstant check_assertion( N, filename, linenum, expr ); + if N == 0 then + mishap( 0, 'No results from assertion', 'unittest-assert:stack-empty' ) + elseif N > 1 then + mishap( N, 'Too many results from assertion', 'unittest-assert:stack-many' ) + else + lvars result = (); + unless result do + mishap( #| filename, linenum, expr |#, 'Assertion failed', 'unittest-assert:unittest-fail' ) + endunless + endif + enddefine; + + dlocal pop_new_lvar_list; + lvars t = sysNEW_LVAR(); + sysCALL( "stacklength" ); + sysPOP( t ); + lvars expr = peek_expr_to( ";" ); + pop11_comp_expr(); + sysCALL( "stacklength" ); + sysPUSH( t ); + sysCALL( "fi_-" ); + sysPUSHQ( popfilename ); + sysPUSHQ( poplinenum ); + sysPUSHQ( expr ); + sysCALLQ( check_assertion ); +enddefine; + + +;;; --- Common reporting --- + +define r_pdprops( u ); + while u.isclosure and not( u.pdprops ) do + u.pdpart -> u + endwhile; + lvars props = u.pdprops; + while props.islist and not( null( props ) ) do + props.hd -> props + endwhile; + props; +enddefine; + +define pr_show_failures( passes, failures ); + dlocal poplinewidth = false; + dlocal pop_pr_quotes = false; + nprintf( 'Test results at: ' <> sysdaytime() ); + nl(1); + + lvars i, n; + for i, n in failures, list_from(1) do + lvars ( u, msg, idstring, args ) = i.destfailureinfo; + if idstring = 'unittest-assert:unittest-fail' then + lvars name = u.r_pdprops; + nprintf( '%p.\tFailed : %p', [^n ^name] ); + if u.isclosure then + nprintf( '\tData : %p', [[% u.explode %]]) + endif; + lvars (filename, linenumber, assert_expr, _n) = args.destlist; + if hasstartstring( filename, current_directory ) then + allbutfirst( datalength(current_directory) + 1, filename ) -> filename; + endif; + printf( '\tExpression: ' ); + applist( [assert ^^assert_expr], procedure(); dlocal pop_pr_quotes = true; spr() endprocedure ); + nl(1); + nprintf( '\tLine num : %p', [ ^linenumber ] ); + nprintf( '\tFile name : %p', [ ^filename ] ); + else + lvars name = u.r_pdprops; + lvars ( parent, linenum ) = u.pdorigin; + nprintf( '%p.\tUnit test : %p', [^n ^name] ); + nprintf( '\tMessage : %p', [ ^msg ] ); + unless args.null do + npr( '\tInvolving : ' ); + lvars a; + for a in args do + nprintf( '\t *\t%p', [^a] ) + endfor; + endunless; + if parent then + if linenum then + nprintf( '\tLine num : %p', [ ^linenum ] ); + endif; + if parent.isstring then + if hasstartstring( parent, current_directory ) then + allbutfirst( datalength(current_directory) + 1, parent ) -> parent; + endif; + nprintf( '\tFrom : %p', [ ^parent ] ); + endif; + endif; + endif; + nl( 1 ); + endfor; +enddefine; + +define pr_show_discovered( d ); + dlocal poplinewidth = false; + dlocal pop_pr_quotes = false; + nprintf( 'Test discovery at: ' <> sysdaytime() ); + nl( 1 ); + + nprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] ); + lvars file, n; + for file, n in d.discovered_files, list_from(1) do + nprintf( '%p. %p', [% n, file %] ); + endfor; + nl(1); + + nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] ); + lvars u, n; + for u, n in d.discovered_unittests, list_from(1) do + nprintf( '%p. %p', [% n, u %] ); + endfor; + nl(1); + +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/destdict_keys.p b/base/pop/getpoploglib/auto/destdict_keys.p new file mode 100644 index 00000000..c54d06c0 --- /dev/null +++ b/base/pop/getpoploglib/auto/destdict_keys.p @@ -0,0 +1,11 @@ +compile_mode :pop11 +strict; + +uses dict + +section $-dict => destdict_keys; + +define global constant procedure destdict_keys( dict ); + dict.dict_keys.destvector +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/destdict_values.p b/base/pop/getpoploglib/auto/destdict_values.p new file mode 100644 index 00000000..84dcb9ff --- /dev/null +++ b/base/pop/getpoploglib/auto/destdict_values.p @@ -0,0 +1,11 @@ +compile_mode :pop11 +strict; + +uses dict + +section $-dict => destdict_values; + +define global constant procedure destdict_values( dict ); + dict.dict_values.destvector +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/dict_concat.p b/base/pop/getpoploglib/auto/dict_concat.p new file mode 100644 index 00000000..3de1e3ec --- /dev/null +++ b/base/pop/getpoploglib/auto/dict_concat.p @@ -0,0 +1,58 @@ +compile_mode :pop11 +strict; + +uses dict + +section $-dict => dict_concat; + +define global constant procedure dict_concat( d1, d2 ); + lvars ( d1keys, d1values, d1length ) = d1.destdict.dup.datalength; + lvars ( d2keys, d2values, d2length ) = d2.destdict.dup.datalength; + lvars plist, d1i = 1, d2i = 1; + [% + repeat + if d1i > d1length then + ;;; Accept all of the remaining d2 items. + lvars i; + for i from d2i to d2length do + conspair( + subscrv( i, d2keys ), + subscrv( i, d2values ) + ) + endfor; + quitloop + elseif d2i > d2length then + ;;; Accept all of the remaining d1 items. + lvars i; + for i from d2i to d1length do + conspair( + subscrv( i, d1keys ), + subscrv( i, d1values ) + ) + endfor; + quitloop + endif; + lvars d1item = subscrv( d1i, d1keys ); + lvars d2item = subscrv( d2i, d2keys ); + lvars cmp = alphabefore( d1item, d2item ); + if cmp == true then + conspair( d1item, subscrv( d1i, d1values ) ); + d1i fi_+ 1 -> d1i; + elseif cmp == 1 then + conspair( d2item, subscrv( d2i, d2values ) ); + d1i fi_+ 1 -> d1i; + d2i fi_+ 1 -> d2i; + else + conspair( d2item, subscrv( d2i, d2values ) ); + d2i fi_+ 1 -> d2i; + endif + endrepeat + %] -> plist; + lvars keys = {% applist( plist, front ) %}; + lvars values = {% applist( plist, back ) %}; + while plist.ispair do + sys_grbg_destpair( sys_grbg_destpair( plist ) -> plist ) -> (_, _); + endwhile; + consdict( keys.dict_table, values ); +enddefine; + +endsection; \ No newline at end of file diff --git a/base/pop/getpoploglib/auto/dollar_{.p b/base/pop/getpoploglib/auto/dollar_{.p new file mode 100644 index 00000000..7314df69 --- /dev/null +++ b/base/pop/getpoploglib/auto/dollar_{.p @@ -0,0 +1,19 @@ +compile_mode :pop11 +strict; + +section; + +;;; Idiom for 'silently load a lib defining a class if not loaded already'. +if identprops("dict_key") then + loadlib("dict") +endif; + +;;; +;;; Pop-11 really does not like the identifier dollar_{ so we need to force +;;; the assignment with some low-level code. +;;; +ident_declare( "'dollar_{'", "syntax", 0 ); +procedure(word) with_props 'dollar_{'; + $-dict$-compile_newdict_to( "}" ) -> _; +endprocedure -> idval( identof( "'dollar_{'" ) ); + +endsection; diff --git a/base/pop/getpoploglib/auto/expect_mishap.p b/base/pop/getpoploglib/auto/expect_mishap.p new file mode 100644 index 00000000..d2c0b44a --- /dev/null +++ b/base/pop/getpoploglib/auto/expect_mishap.p @@ -0,0 +1 @@ +uses define_unittest; \ No newline at end of file diff --git a/base/pop/getpoploglib/auto/frozval_closure_slot.p b/base/pop/getpoploglib/auto/frozval_closure_slot.p new file mode 100644 index 00000000..97a4beba --- /dev/null +++ b/base/pop/getpoploglib/auto/frozval_closure_slot.p @@ -0,0 +1,7 @@ +compile_mode :pop11 +strict; + +section; + +uses frozval_names + +endsection; diff --git a/base/pop/getpoploglib/auto/frozval_names.p b/base/pop/getpoploglib/auto/frozval_names.p new file mode 100644 index 00000000..88436998 --- /dev/null +++ b/base/pop/getpoploglib/auto/frozval_names.p @@ -0,0 +1,58 @@ +section $-frozval_names => + frozval_names + frozval_stack_slot + frozval_closure_slot; + +constant procedure frozval_slot_table = + newanyproperty( [], 8, 1, 8, false, false, "tmpval", false, false ); + +;;; Given a word and a 'bound' closure, returns the index of the word +;;; when addressed using subscr_stack. +define global constant procedure frozval_stack_slot( word, closure ); + lvars slots = frozval_slot_table( closure ); + if slots then + lvars i, item; + for item with_index i in_vector slots do + returnif( word == item )( datalength( closure ) - i + 1 ) + endfor + endif; + mishap( 'Unrecognised slot name', [^word ^closure] ) +enddefine; + +;;; Given a word and a 'bound' closure, returns the index of the frozval. +define global constant procedure frozval_closure_slot( word, closure ); + lvars slots = frozval_slot_table( closure ); + if slots then + lvars i, item; + for item with_index i in_vector slots do + returnif( word == item )( i ) + endfor + endif; + mishap( 'Unrecognised slot name', [^word ^closure] ) +enddefine; + + +define frozval_names( closure ); + unless closure.isclosure do + mishap( 'Expecting closure', [^closure] ) + endunless; + lvars slots = frozval_slot_table( closure ); + if slots then + destvector( slots ) + else + 0 + endif +enddefine; + +define updaterof frozval_names( N, closure ); + unless closure.isclosure do + mishap( 'Expecting closure', [^closure] ) + endunless; + lvars slots = consvector( N ); + if datalength( slots ) /== datalength( closure ) then + mishap( 'Mismatch in the number of names and the size of closure', [^N ^closure] ) + endif; + slots -> frozval_slot_table( closure ); +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/frozval_stack_slot.p b/base/pop/getpoploglib/auto/frozval_stack_slot.p new file mode 100644 index 00000000..b75c032c --- /dev/null +++ b/base/pop/getpoploglib/auto/frozval_stack_slot.p @@ -0,0 +1 @@ +uses-by_name frozval_names (frozval_stack_slot); diff --git a/base/pop/getpoploglib/auto/list_from.p b/base/pop/getpoploglib/auto/list_from.p new file mode 100644 index 00000000..92b63e6b --- /dev/null +++ b/base/pop/getpoploglib/auto/list_from.p @@ -0,0 +1,11 @@ +compile_mode :pop11 +strict; + +section; + +;;; list_from( n: num ) -> [ n, n+1, ... ] +;;; list_from( item, p: item -> item ) -> [ item, p(item), p(p(item)), ... ] +define global list_from() with_nargs 1; + repeater_from( /* take args from stack */ ).pdtolist +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/new_list_builder.p b/base/pop/getpoploglib/auto/new_list_builder.p new file mode 100644 index 00000000..a3305616 --- /dev/null +++ b/base/pop/getpoploglib/auto/new_list_builder.p @@ -0,0 +1,66 @@ +compile_mode :pop11 +strict; + +section; + +define lconstant list_builder( item, first_pair_ref, last_pair_ref ); + if item == termin then + lvars first_pair = fast_cont( first_pair_ref ); + lvars result = fast_back( first_pair ); + nil -> fast_back( first_pair ); + first_pair -> fast_cont( last_pair_ref ); + result + else + lvars last_pair = fast_cont( last_pair_ref ); + conspair( item, nil ) ->> fast_back( last_pair ) -> fast_cont( last_pair_ref ) + endif +enddefine; + +define global new_list_builder(); + lvars first_pair = conspair( _, nil ); + lvars last_pair = first_pair; + list_builder(% consref( first_pair ), consref( last_pair ) %) +enddefine; + +define global is_list_builder( p ); + p.isclosure and p.pdpart == list_builder +enddefine; + +define global list_builder_copylist( p ); + if p.is_list_builder then + copylist( frozval( 1, p ).cont.back ) + else + mishap( 'List builder required', [^p] ) + endif +enddefine; + +define global list_builder_push_front( item, p ); + if p.is_list_builder then + lvars r = frozval( 1, p ); + lvars s = frozval( 2, p ); + lvars same = r.cont == s.cont; + conspair( item, r.cont.back ) -> r.cont.back; + if same then + r.cont.back -> s.cont + endif + else + mishap( 'List builder required', [^p] ) + endif +enddefine; + +define global list_builder_push_back( item, p ); + if p.is_list_builder then + p( item ) + else + mishap( 'List builder required', [^p] ) + endif +enddefine; + +define global list_builder_newlist( p ); + if p.is_list_builder then + p( termin ) + else + mishap( 'List builder required', [^p] ) + endif +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/newdict_from_assoclist.p b/base/pop/getpoploglib/auto/newdict_from_assoclist.p new file mode 100644 index 00000000..232433ee --- /dev/null +++ b/base/pop/getpoploglib/auto/newdict_from_assoclist.p @@ -0,0 +1,21 @@ +compile_mode :pop11 +strict; + +section $-dict => newdict_from_assoclist; + +uses dict + +define global constant procedure newdict_from_assoclist( list ); + lvars keys = []; + lvars values = {% + lvars p, n = 0; + for p in list do + n fi_+ 1 -> n; + lvars ( k, v ) = p.dest.hd; + conspair( conspair( k, n ), keys ) -> keys; + v ;;; put values in historical order into a vector. + endfor + %}; + newdict_internal( keys, values ) +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/newdict_from_twinlists.p b/base/pop/getpoploglib/auto/newdict_from_twinlists.p new file mode 100644 index 00000000..1fac043c --- /dev/null +++ b/base/pop/getpoploglib/auto/newdict_from_twinlists.p @@ -0,0 +1,22 @@ +compile_mode :pop11 +strict; + +section $-dict => newdict_from_twinlists; + +uses dict + +define global constant procedure newdict_from_twinlists( keys_list, values_list ); + lvars keys = []; + lvars values = {% + lvars n = 0; + until keys_list.null or values_list.null do + n fi_+ 1 -> n; + lvars k = keys_list.fast_destpair -> keys_list; + lvars v = values_list.fast_destpair -> values_list; + conspair( conspair( k, n ), keys ) -> keys; + v ;;; put values in historical order into a vector. + enduntil + %}; + newdict_internal( keys, values ); +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/nulldict.p b/base/pop/getpoploglib/auto/nulldict.p new file mode 100644 index 00000000..a7af46fc --- /dev/null +++ b/base/pop/getpoploglib/auto/nulldict.p @@ -0,0 +1,7 @@ +compile_mode :pop11 +strict; + +section $-dict => nulldict; + +global constant nulldict = consdict( {}.dup ); + +endsection; diff --git a/base/pop/getpoploglib/auto/partapply_dict.p b/base/pop/getpoploglib/auto/partapply_dict.p new file mode 100644 index 00000000..b162a370 --- /dev/null +++ b/base/pop/getpoploglib/auto/partapply_dict.p @@ -0,0 +1,12 @@ +compile_mode :pop11 +strict; + +section; + +uses dict + +define global constant procedure partapply_dict( procedure p, dict ) -> c; + consclosure( p, dict.destdict_values ) -> c; + dict.destdict_keys -> c.frozval_names; +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/partapply_override.p b/base/pop/getpoploglib/auto/partapply_override.p new file mode 100644 index 00000000..f04a017b --- /dev/null +++ b/base/pop/getpoploglib/auto/partapply_override.p @@ -0,0 +1,30 @@ +compile_mode :pop11 +strict; + +uses frozval_names +uses dict + +section $-frozval_names => partapply_override; + +define partapply_override( procedure pdr, new_frozvals ) -> c; + dlvars c; + consclosure( pdr.pdpart, #| pdr.explode |#) -> c; + frozval_slot_table( pdr ) -> frozval_slot_table( c ); + if new_frozvals.islist then + lvars i, n = 0; + for i in new_frozvals do + n fi_+ 1 -> n; + i -> frozval( n, c ) + endfor; + elseif new_frozvals.isdict then + appdict( + new_frozvals, + procedure( k, v ); + v -> frozval( frozval_closure_slot( k, c ), c ) + endprocedure + ), + else + mishap( 'Unexpected replacement frozen values', [^new_frozvals] ) + endif +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/pdorigin.p b/base/pop/getpoploglib/auto/pdorigin.p new file mode 100644 index 00000000..10c4d814 --- /dev/null +++ b/base/pop/getpoploglib/auto/pdorigin.p @@ -0,0 +1,23 @@ +compile_mode :pop11 +strict; + +#_TERMIN_IF DEF pdorigin + +section; + +lconstant procedure pdorigin_table = + newanyproperty( + [], 8, 1, 8, + false, false, "tmpval", + conspair( false, false ), + false + ); + +define global constant procedure pdorigin( procedure p ); + pdorigin_table( p ).destpair +enddefine; + +define updaterof pdorigin( file, linenum, procedure p ); + conspair( file, linenum ) -> pdorigin_table( p ) +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/pop11_comp_N.p b/base/pop/getpoploglib/auto/pop11_comp_N.p new file mode 100644 index 00000000..a946c67e --- /dev/null +++ b/base/pop/getpoploglib/auto/pop11_comp_N.p @@ -0,0 +1,52 @@ +compile_mode :pop11 +strict; + +section; + +define lconstant check_0( before ); + lvars after = stacklength(); + unless after == before then + lvars k = after fi_- before; + if k < 0 then + mishap( 'Expression consumed values, zero stack change required', [] ) + else + lvars results = conslist( k ); + mishap( 'Expression returned too many results, exactly zero required', results ); + endif + endunless; +enddefine; + +define lconstant check_N( before, N ); + lvars after = stacklength(); + lvars k = after fi_- before; + unless k == N then + if k == 0 then + mishap( sprintf( 'Expression generated no results but %p required', [^N] ), [] ); + elseif k < 0 then + mishap( sprintf('Expression consumed values instead of returning % result(s)', [^N] ), [] ) + else + lvars results = conslist( k ); + mishap( sprintf( 'Expression returned too many results, exactly %p required', [^N] ), results ); + endif + endunless; +enddefine; + +lconstant procedure check_1 = check_N(% 1 %); + +define global constant procedure pop11_comp_N( action, N ); + dlocal pop_new_lvar_list; + lvars tmpvar = sysNEW_LVAR(); + sysCALL( "stacklength" ); + sysPOP( tmpvar ); + action(); + sysPUSH( tmpvar ); + if N == 0 then + sysCALLQ( check_0 ) + elseif N == 1 then + sysCALLQ( check_1 ); + else + sysPUSHQ( N ); + sysCALLQ( check_N ); + endif +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/read_variables.p b/base/pop/getpoploglib/auto/read_variables.p new file mode 100644 index 00000000..4b30490f --- /dev/null +++ b/base/pop/getpoploglib/auto/read_variables.p @@ -0,0 +1,29 @@ +compile_mode :pop11 +strict; + +section; + +;;; reads a (optionally comma separated) list of ordinary variables from +;;; the input stream. +define read_variables(); + [% + repeat + quitif( proglist.null ); + lvars item = proglist.hd; + quitunless( item.isword ); + if item == "," then + readitem().erase; + nextloop; + endif; + lvars id = identprops( item ); + quitunless( + id.isnumber or + id == "undef" or + id == "procedure" or + id == "macro" + ); + readitem(); + endrepeat + %] +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/repeater_from.p b/base/pop/getpoploglib/auto/repeater_from.p new file mode 100644 index 00000000..c682926b --- /dev/null +++ b/base/pop/getpoploglib/auto/repeater_from.p @@ -0,0 +1,25 @@ +compile_mode :pop11 +strict; + +section; + +;;; repeater_from( n: num ) +;;; repeater_from( item, p: item -> item ) +define global repeater_from( n ); + if n.isnumber then + procedure(); + n; + n + 1 -> n; + endprocedure + elseif n.isprocedure then + lvars p = n; + lvars n = (); + procedure(); + n; + p( n ) -> n + endprocedure + else + mishap( 'Unexpected argument', [^n] ) + endif +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/restack.p b/base/pop/getpoploglib/auto/restack.p new file mode 100644 index 00000000..fbc056bd --- /dev/null +++ b/base/pop/getpoploglib/auto/restack.p @@ -0,0 +1,274 @@ +;;; Summary: syntax word for manipulating top items of stack + +compile_mode :pop11 +strict; + +section; + +define lconstant oops( i ); lvars i; + mishap( 'RESTACK: INTERNAL ERROR (please report)', [^i] ) +enddefine; + +define lconstant sanity_check( inputs, outputs ) -> ( arity, indexes ); + lvars inputs, outputs, arity, indexes; + 0 -> arity; + lvars i, t; + for i on inputs do + if lmember( dest( i ) ) do + mishap( 'RESTACK: input variable used twice', [% hd(i) %] ) + else + arity + 1 -> arity; + endif + endfor; + [% + for i in outputs do + if lmember( i, inputs ) ->> t then + arity - length( t ) + 1 + else + mishap( 'RESTACK: variable not in input list', [^i] ) + endif + endfor; + %] -> indexes; +enddefine; + +;;; A plan consists of a series of instructions of the form +;;; [POP n], [PUSH n], [PUSHS], [ERASE], [SWAP m n], [CHECK n] +;;; These correspond to VM instructions, with the exception of [CHECK k] +;;; whose role is to check there are at least k items on the stack. +;;; +define lconstant naive_plan( arity, indexes ); lvars arity, indexes; + [% + lvars i; + for i from arity by -1 to 1 do + [POP ^i] + endfor; + for i in indexes do + [PUSH ^i] + endfor; + %] +enddefine; + +;;; This predicate is given a list of +;;; instruction types "types" and a particular instruction "this_inst". +;;; It checks whether or not the plan consists of a series of instructions +;;; of those types & then this_inst. The instructions after that don't +;;; matter. +;;; +define lconstant up_to_inst( plan, this_inst, types ); + lvars plan, types, this_inst; + lvars inst, count = 0; + for inst in plan do + if inst = this_inst then + return( count ) + elseunless lmember( hd( inst ), types ) then + return( false ) + endif; + count + 1 -> count; + endfor; + return( false ) +enddefine; + +;;; This is a little predicate on plans. Does the plan consist of a series of +;;; POP/ERASE instructions followed by a particular instruction? It returns +;;; either the number of PUSH/ERASE instructions or false. +define lconstant pops_then_inst( plan, this_inst ); lvars plan, this_inst; + up_to_inst( plan, this_inst, [POP ERASE] ) +enddefine; + +;;; A similar predicate to the preceding. This time, does the plan consist +;;; of a series of SWAP instructions followed by a particular instruction? +;;; It returns the number of SWAP instructions or false. +define lconstant swaps_then_inst( plan, this_inst ); lvars plan, this_inst; + up_to_inst( plan, this_inst, [SWAP] ) +enddefine; + +;;; Is there a check that can be eliminated through stack counting? +;;; We know there are at least K items on the stack. +define find_check( plan, k ); lvars plan, k; + lvars n = 0; + lvars i; + for i in plan do + n + 1 -> n; + quitif( k <= 0 ); + lvars type = i.hd; + if type == "ERASE" or type == "POP" then + k - 1 -> k + elseif type == "PUSHS" or type == "PUSH" then + k + 1 -> k + elseif type == "SWAP" then + ;;; Ignore this swap. + elseif type == "CHECK" then + return( n ) + else + oops( i ); + endif; + endfor; + return( false ); +enddefine; + +;;; Try to remove superfluous CHECK instructions by counting +;;; the number of items guaranteed to be on the stack. K is the +;;; number guaranteed. +;;; +define lconstant cull_checks( plan ); lvars plan; + + define lconstant decr( n ) -> n; lvars n; + n - 1 -> n; + if n < 0 then 0 -> n endif + enddefine; + + lvars K = 0; + lvars inst; + for inst in plan do + lvars type = inst.hd; + if type == "ERASE" or type == "POP" then + decr( K ) -> K; + elseif type == "PUSHS" or type == "PUSH" then + K + 1 -> K; + elseif type == "SWAP" then + max( K, max( inst(2), inst(3) ) ) -> K; + elseif type == "CHECK" then + nextif( K >= 1 ); + 1 -> K; + else + oops( inst ); + endif; + ;;; We push every instruction apart from that of CHECK. + ;;; CHECK will sometimes skip this by calling "nextif". + inst; + endfor; +enddefine; + +;;; Peephole optimisation of restacking plan. There are several different +;;; kinds of simple improvement made in this routine. +;;; 1. Any POP n without a subsequent PUSH n becomes an ERASE +;;; 2. POP n & PUSH n without subsequent references to n --> [CHECK] +;;; 3. POP n & POP/ERASE ... & PUSH n without a subsequent reference to n +;;; improved into a SWAP. +;;; 4. POP n & SWAPS... & PUSH n --> +SWAPS... & POP n & PUSH n +;;; 5. (PUSHS | PUSH n) & ERASE --> () +;;; 6. PUSH n & PUSH n ... --> PUSH n & PUSHS ... +;;; 7. SWAP a b & SWAP a b --> () +;;; 8. CHECK & ( CHECK/PUSHS/ERASE/POP n/SWAP a b) --> ( ... ) +define lconstant improved( plan ); lvars plan, n; + until null( plan ) do + lvars inst = plan.dest -> plan; + lvars ( type, arg ) = inst.dest; + lvars next_inst = if plan.null then [DUMMY] else plan.hd endif; + lvars ( next_type, next_arg ) = next_inst.dest; + if type == "POP" then + lvars index = arg( 1 ); + lvars push = [ PUSH ^index ]; + if not( member( push, plan ) ) then + [ ERASE ] + elseif + next_inst = push and + ( null( plan ) or not( member( push, plan.tl ) ) ) + then + plan.tl -> plan; + [CHECK] + elseif + next_inst /= push and + ( pops_then_inst( plan, push ) ->> n ) and + not( member( push, applynum( plan, tl, n+1 ) ) ) + then + [SWAP 1 ^(n+1)]; ;;; insert swap + plan( n ); ;;; move last POP/ERASE to start + repeat n - 1 times + plan.dest -> plan ;;; remaining POP/ERASE + endrepeat; + plan.tl -> plan; ;;; don't reuse last POP/ERASE + plan.tl -> plan; ;;; dispose of PUSH + elseif + next_inst /= push and + ( swaps_then_inst( plan, push ) ->> n ) + then + repeat n times + lvars swap_inst = plan.dest -> plan; + [SWAP % swap_inst(2)+1, swap_inst(3)+1 %] + endrepeat; + inst; + else + inst + endif + elseif type == "PUSH" or type == "PUSHS" then + if next_type == "ERASE" then + plan.tl -> plan + elseif type == "PUSH" and next_inst = inst then + inst; + while not(plan.null) and plan.hd = inst do + [PUSHS]; + plan.tl -> plan; + endwhile; + else + inst + endif + elseif type == "SWAP" then + if inst = next_inst then + ;;; two swaps in a row ... do nothing. + plan.tl -> plan; + else + lvars n = find_check( plan, max( arg(1), arg(2) ) ); + inst + endif + elseif type == "CHECK" then + if lmember( next_type, #_< [CHECK ERASE POP PUSHS SWAP] >_# ) then + /* nothing -- eliminate this instruction */ + else + inst + endif + else + inst + endif + enduntil; +enddefine; + +define lconstant optimise( plan ); lvars plan; + repeat + lvars i_plan = [% cull_checks( [% improved( plan ) %] ) %]; + returnif( i_plan = plan )( plan ); + i_plan -> plan; + endrepeat +enddefine; + +define lconstant plant( plan ); lvars plan; + dlocal pop_new_lvar_list; + + lvars table = [].newassoc; + + define lconstant local( arg ); lvars arg; + lvars index = arg.hd; + table( index ) or + ( sysNEW_LVAR() ->> table( index ) ) + enddefine; + + lvars inst; + for inst in plan do + lvars ( type, arg ) = inst.dest; + if type == "POP" then + sysPOP( arg.local ) + elseif type == "PUSH" then + sysPUSH( arg.local ) + elseif type == "PUSHS" then + sysPUSHS( undef ) + elseif type == "ERASE" then + sysERASE( undef ) + elseif type == "SWAP" then + sysSWAP( arg.dl ) + elseif type == "CHECK" then + sysPUSHS( undef ); + sysERASE( undef ) + else + oops( inst ) + endif + endfor; +enddefine; + +define syntax restack; + lvars inputs = read_variables(); + pop11_need_nextreaditem( "->" ).erase; + lvars outputs = read_variables(); + lvars ( arity, indexes ) = sanity_check( inputs, outputs ); + naive_plan( arity, indexes ).optimise.plant; +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/split_by_spaces.p b/base/pop/getpoploglib/auto/split_by_spaces.p new file mode 100644 index 00000000..d6002b15 --- /dev/null +++ b/base/pop/getpoploglib/auto/split_by_spaces.p @@ -0,0 +1,60 @@ +compile_mode :pop11 +strict; + +section; + +;;; +;;; split_by_spaces( s, [maxsplit], [constructor] ) -> constructor( N ) +;;; +define global procedure split_by_spaces() with_props 1; + lvars s, maxsplit, constructor; + + false -> maxsplit; + consvector -> constructor; + + if dup().isprocedure then + () -> constructor + endif; + + if dup().isinteger or dup() == false or dup() == _ do + () -> maxsplit; + if maxsplit == _ then + false -> maxsplit + endif + endif; + + () -> s; + unless s.isstring then + mishap( 'Invalid argument for splitstring', [ ^s ] ) + endunless; + if maxsplit == false or maxsplit == _ do + ;;; Stop maxsplit ever being a limit by making it 'very big'. + datalength(s) + 1 -> maxsplit; + endif; + + constructor(#| + lvars position = 1; + lvars count = 0; + repeat + skipchar( ` `, position, s ) -> position; + quitunless( position ); + + if count >= maxsplit then + substring( position, s.datalength - position + 1, s ); + quitloop + endif; + + lvars n = locchar( ` `, position, s); + if n then + substring( position, n - position, s ); + count fi_+ 1 -> count; + n -> position; + else + lvars len = s.datalength - position + 1; + substring( position, len, s ); + quitloop + endif + endrepeat + |#) +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/splitstring.p b/base/pop/getpoploglib/auto/splitstring.p new file mode 100644 index 00000000..dea5ead4 --- /dev/null +++ b/base/pop/getpoploglib/auto/splitstring.p @@ -0,0 +1,97 @@ +compile_mode :pop11 +strict; + +section; + +;;; +;;; splitstring( string, separator ) -> vector +;;; splitstring( string, separator, maxsplit: int_or_false, constructor: procedure ) -> constructor( N ) +;;; +define global splitstring() with_props 2; + lvars s, sep, maxsplit, procedure constructor; + + ;;; Set default values for optionals. + consvector -> constructor; + false -> maxsplit; + + ;;; Decode optional arguments directly from the stack. + if not(dup().isregexp) and dup().isprocedure then + () -> ( maxsplit, constructor ); + endif; + + () -> ( s, sep ); + + if sep.isstring then + if sep.datalength == 1 then + ;;; Take advantage of locchar. + subscrs( 1, sep ) -> sep + endif + elseunless sep.isinteger or sep.isregexp then + mishap( 'Invalid separator for split', [ ^sep ] ) + endif; + + unless s.isstring then + mishap( 'Invalid argument for splitstring', [ ^s ] ) + endunless; + + if maxsplit == false or maxsplit == _ do + ;;; Stop maxsplit ever being a limit by making it 'big enough'. + datalength(s) + 1 -> maxsplit; + endif; + + ;;; Deal separately with regular expressions and string/integer separators. + if sep.isregexp then + constructor(#| + lvars position = 1; + lvars count = 0; + lvars s_len = datalength( s ); + repeat + if position > s_len then + ''; + quitloop + endif; + lvars ( n, sep_n ) = if maxsplit > count then sep( position, s, false, false ) else false, false endif; + if n then + substring( position, n - position, s ); + count fi_+ 1 -> count; + n + sep_n -> position; + else + lvars len = s_len fi_- position fi_+ 1; + substring( position, s.datalength - position + 1, s ); + quitloop + endif + endrepeat + |#) + else + lvars ( procedure finder, sep_n ) = ( + if sep.isstring then + lvars d = sep.datalength; + if d == 0 then + mishap( 'Invalid empty separator argument', [^sep] ) + endif; + ( issubstring, datalength(sep) ) + elseif sep.isinteger then + ( locchar, 1 ) + else + mishap( 'Unexpected separator', [^sep] ) + endif + ); + constructor(#| + lvars position = 1; + lvars count = 0; + repeat + lvars n = (maxsplit > count) and finder( sep, position, s ); + if n then + substring( position, n - position, s ); + count fi_+ 1 -> count; + n + sep_n -> position; + else + lvars len = s.datalength - position + 1; + substring( position, len, s ); + quitloop + endif + endrepeat + |#) + endif +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/unittests_discover.p b/base/pop/getpoploglib/auto/unittests_discover.p new file mode 100644 index 00000000..46d73f8b --- /dev/null +++ b/base/pop/getpoploglib/auto/unittests_discover.p @@ -0,0 +1 @@ +uses unittests_run; diff --git a/base/pop/getpoploglib/auto/unittests_run.p b/base/pop/getpoploglib/auto/unittests_run.p new file mode 100644 index 00000000..79441ba8 --- /dev/null +++ b/base/pop/getpoploglib/auto/unittests_run.p @@ -0,0 +1,47 @@ +compile_mode :pop11 +strict; + +uses define_unittest; + +section $-unittest => + unittests_discover ;;; performs test-discovery at Pop-11 prompt + unittests_run ;;; performs test discovery-and-execution at Pop-11 prompt +; + +define find_unittest_files( location ); + if hasendstring( location, unittest_suffix ) then + [% location %] + elseif hasendstring( location, '.p' ) then + lvars dir = sys_fname_path( location ); + lvars name = sys_fname_nam( location ) <> unittest_suffix; + sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist; + elseif sysisdirectory( location ) then + lvars folder = sys_fname_path( location ); + sys_file_match( folder dir_>< '.../', '*' <> unittest_suffix, false, false ).pdtolist + else + [] + endif.expandlist +enddefine; + +define find_unittests( location ); + lvars files = find_unittest_files( location ); + lvars tests = applist(% files, loadcompiler %).discover_unittests; + return( newdiscovered( tests ) ) +enddefine; + +define unittests_discover( location ); + lvars d = find_unittests( location ); + pr_show_discovered( d ); +enddefine; + +define unittests_run( location ); + lvars d = find_unittests( location ); + + dlocal run_unittest = run_unittest_during_execution; + dlocal fail_unittest = fail_unittest_during_execution; + lvars disco = d.discovered_unittests; + lvars ( passes, failures ) = run_all_unittests( disco ); + + pr_show_failures( passes, failures ); +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/ved_discover.p b/base/pop/getpoploglib/auto/ved_discover.p new file mode 100644 index 00000000..37590841 --- /dev/null +++ b/base/pop/getpoploglib/auto/ved_discover.p @@ -0,0 +1 @@ +uses ved_test; diff --git a/base/pop/getpoploglib/auto/ved_test.p b/base/pop/getpoploglib/auto/ved_test.p new file mode 100644 index 00000000..1b367ca4 --- /dev/null +++ b/base/pop/getpoploglib/auto/ved_test.p @@ -0,0 +1,100 @@ +compile_mode :pop11 +strict; + +uses define_unittest; + +section $-unittest => + ved_test ;;; discovery and execution + ved_discover ;;; performs test-discovery +; + +;;; -- VED integration --- + +define select_scope_for_vedargument(); + if vedargument = '' then + if hasendstring( vedcurrent, unittest_suffix ) then + ved_l1 + elseif hasendstring( vedcurrent, '.p' ) then + lvars dir = sys_fname_path( vedcurrent ); + lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix; + procedure(); + lvars file; + for file in sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist do + vedputmessage( 'COMPILING ' >< file ); + pop11_compile( file ) + endfor + endprocedure + else + mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] ) + endif + elseif sysisdirectory( vedargument ) then + procedure( folder ); + lvars file; + for file in sys_file_match( folder dir_>< '.../', '*' <> unittest_suffix, false, false ).pdtolist do + vedputmessage( 'COMPILING ' >< file ); + pop11_compile( file ) + endfor + endprocedure(% vedargument %) + else + identfn(% [] %) + endif +enddefine; + +define test_discovery_in_ved(); + newdiscovered( discover_unittests( select_scope_for_vedargument() ) ) +enddefine; + +define show_failures( passes, failures ); + dlocal vedpositionstack; + + vededit( '*TEST RESULTS*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure ); + ved_clear(); + vedpositionpush(); + dlocal cucharout = vedcharinsert; + + pr_show_failures( passes, failures ); + + vedpositionpop(); +enddefine; + + +define ved_discover(); + dlocal vedpositionstack; + lvars d = test_discovery_in_ved(); + + vededit( '*TESTS DISCOVERED*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure ); + ved_clear(); + vedpositionpush(); + + dlocal cucharout = vedcharinsert; + + pr_show_discovered( d ); + + vedpositionpop(); +enddefine; + +define ved_test(); + lvars d = test_discovery_in_ved(); + dlocal run_unittest = run_unittest_during_execution; + dlocal fail_unittest = fail_unittest_during_execution; + lvars disco = d.discovered_unittests; + lvars ( passes, failures ) = run_all_unittests( disco ); + + unless null(failures) then + show_failures( passes, failures ) + endunless; + + lvars n_passes = passes.length; + lvars n_failures = failures.length; + dlocal pop_pr_quotes = false; + sprintf( + '%p pass%p, %p failure%p', + [% + n_passes, + if n_passes == 1 then '' else 'es' endif, ;;; singular v plural + n_failures, + if n_failures == 1 then '' else 's' endif ;;; singular v plural + %] + ).vedputmessage; +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/with_data.p b/base/pop/getpoploglib/auto/with_data.p new file mode 100644 index 00000000..d2c0b44a --- /dev/null +++ b/base/pop/getpoploglib/auto/with_data.p @@ -0,0 +1 @@ +uses define_unittest; \ No newline at end of file diff --git a/base/pop/getpoploglib/examples/.gitignore b/base/pop/getpoploglib/examples/.gitignore deleted file mode 100644 index e69de29b..00000000 diff --git a/base/pop/getpoploglib/examples/design_a.p b/base/pop/getpoploglib/examples/design_a.p new file mode 100644 index 00000000..766935f5 --- /dev/null +++ b/base/pop/getpoploglib/examples/design_a.p @@ -0,0 +1,24 @@ +;;; Try the following code. + +with + sorted = false +define demo( x, y ) -> list; + [% + lvars i; + for i in x do + if member( i, y ) then i endif + endfor + %] -> list; + if sorted then + list.sort -> list + endif; +enddefine; + + +demo( [ 4 3 2 1 ], [3 6 4 8] ) => + +with + sorted = true +do + demo( [ 4 3 2 1 ], [3 6 4 8] ) => + diff --git a/base/pop/getpoploglib/help/dict b/base/pop/getpoploglib/help/dict new file mode 100644 index 00000000..f3674552 --- /dev/null +++ b/base/pop/getpoploglib/help/dict @@ -0,0 +1,101 @@ +HELP DICT Stephen Leach Sep 2021 + +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +<<<<<<<<<<<<<<<<<<<<< >>>>>>>>>>>>>>>>>>>>>> +<<<<<<<<<<<<<<<<<<<<< DICTS >>>>>>>>>>>>>>>>>>>>>> +<<<<<<<<<<<<<<<<<<<<< >>>>>>>>>>>>>>>>>>>>>> +<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + +-------------- +1 Recognisers +-------------- + +is_null_dict(dict) -> bool + Returns true if dict is empty, false otherwise. + + +isdict(item) -> bool + Returns true if item is a dict, false otherwise. + + +--------------- +2 Constructors +--------------- + +newdict_from_assoclist(assoc_list) -> dict + This constructs a dict from an assoc-list i.e. a list of key/values + which are themselves a list of length 2 (or more). e.g. + + newdict_from_assoclist([[a 1] [b 2]]) + + will return a dict that maps the word "a" to 1 and "b" to 2. + + +newdict_from_twinlists(keys_list, values_list) -> dict + This constructs a dict from two lists, being a list of keys and + a parallel list of values. The lists are not required to be of equal + length, the first N items are taken when N is the lesser of the + two lengths. e.g. + + newdict_from_twinlists([a b], [1 2]) + + will return a dict that maps the word "a" to 1 and "b" to 2. + + +------------ +3 Accessors +------------ + +dict_destkeys( dict ) -> ( key1, key2, ..., keyN, N ) + This returns all the keys of a dict on the stack and a count of + the keys. The keys will be sorted in lexicographical order. + + +dist_destvalues( dict ) -> ( value1, value2, ..., valueN, N ) + This returns all the values of a dict on the stack and a count of + the values returned. The values are returned in the same order as + the keys. + + +dict( key ) -> value +value -> dict(key) +subscrdict(key, dict) -> value +value -> subscrdict(key, dict) + This returns or updates the value associated with the key in the + dict. subscrdict is the class_apply of the dict_key. + + +---------------- +4 Miscellaneous +---------------- + +appdict(dict, procedure ) + Applies the procedure p to each entry in the dict. The + procedure p is applied as: + + p(key, value) + + for each key/value association in dict. + + +dict_key -> key + Constant holding key structure for dict + + +dict_length(dict) -> N + Returns the number N of key/values pairs in dict. + + +nulldict -> dict + An instance of an empty dict object + + +partapply_dict(procedure, dict) -> closure + Returns a closure with named frozval-slots. See HELP * PARTAPPLY_DICT. + +partapply_override(closure, list|dict) -> closure + Copies a closure and updates the frozvals from the list or dict. + See HELP * PARTAPPLY_OVERRIDE. + + +--- Copyright (c) GetPoplog Sep 2021 ------------------------------------------- \ No newline at end of file diff --git a/base/pop/getpoploglib/help/list_from b/base/pop/getpoploglib/help/list_from new file mode 100644 index 00000000..b7196c98 --- /dev/null +++ b/base/pop/getpoploglib/help/list_from @@ -0,0 +1,41 @@ +HELP LIST_FROM Stephen Leach, Oct 2021 + + list_from( n: num ) -> [ n, n+1, n+2, ... ] + list_from( n: item, procedure p ) -> [ n, p(n), p(p(n)), ... ] + +This function is used to construct non-terminating lists. If called with a +single numerical argument it returns a list whose first member is n, and +whose next member is n+1, then n+2 etc. For example: + + Setpop + : vars list = list_from(1); + : list => + ** [...] + : list(1) => + ** 1 + : list(2) => + ** 2 + : list(3) => + ** 3 + : list => + ** [1 2 3 ...] + : + +If it is called with a procedure then the list that is returned contains +n, p(n), p(p(n)), etc. For example: + + Setpop + : vars L = list_from( 1, nonop *(% 2 %) ); + : L => + ** [...] + : L(1) => + ** 1 + : L(2) => + ** 2 + : L(3) => + ** 4 + : L(4) => + ** 8 + : L => + ** [1 2 4 8 ...] + : diff --git a/base/pop/getpoploglib/help/new_list_builder b/base/pop/getpoploglib/help/new_list_builder new file mode 100644 index 00000000..e530f7fa --- /dev/null +++ b/base/pop/getpoploglib/help/new_list_builder @@ -0,0 +1,81 @@ +HELP NEW_LIST_BUILDER Stephen Leach, Sept 2021 + + uses new_list_builder + + new_list_builder() -> builder + builder( item ) + builder( termin ) -> list + + is_list_builder( item ) -> bool + list_builder_push_front( item, builder ) + list_builder_push_back( item, builder ) + list_builder_copylist( builder ) -> list + list_builder_newlist( builder ) -> list + + + CONTENTS - (Use g to access required sections) + + -- Introduction + -- Predicates on List Builders + -- Constructing List Builders + -- Manipulating List Builders + + +-- Introduction ------------------------------------------------------- + +A list-builder is a consumer procedure that constructs a list from all the +items that it is applied to. It is particularly useful for building lists +by adding to the end of the list, although you can also add to the start of +the list as an alternative. + +The builder returns the list when it is applied to the special item . +For example: + + + Setpop + : vars b = new_list_builder(); + : b( 1 ); + : b( true ); + : b( 'three' ); + : b( termin ) => + ** [1 three] + : + + +-- Predicates on List Builders ---------------------------------------- + +List builders are closures so both isprocedure and isclosure is true +for any list builder. + +is_list_builder( item ) -> bool + Returns true if item is a list builder, false if not. + + +-- Constructing List Builders ----------------------------------------- + + +new_list_builder() -> list_builder + Returns a new, empty list builder. + + +-- Manipulating List Builders ----------------------------------------- + +list_builder_push_front( item, builder ) + Adds an item to the start of the list that is being built. + + +list_builder_push_back( item, builder ) + Adds an item to the end of the list that is being built. This + is the same as calling builder( item ) + + +list_builder_copylist( builder ) -> list + This takes a copy of the in-progress list that is being built. + Each time you take a copy you get a completely new list. + + +list_builder_newlist( builder ) -> list + This returns the in-progress list _and_ resets the builder back + to its initial empty state. + +--- Copyright GetPoplog (c) 2021. diff --git a/base/pop/getpoploglib/help/partapply_dict b/base/pop/getpoploglib/help/partapply_dict new file mode 100644 index 00000000..566b6f04 --- /dev/null +++ b/base/pop/getpoploglib/help/partapply_dict @@ -0,0 +1,30 @@ +HELP PARTAPPLY_DICT Stephen Leach, Sep 2021 + + partapply_dict( , ) -> closure + +This procedure produces a closure of an existing procedure (which may +itself be a closure). It takes two arguments - a procedure and a dict; +its result is a new procedure based upon the given procedure, but +requiring fewer arguments, the rightmost of the arguments of the new +procedure being supplied by the ordered values of the dict at the time +PARTAPPLY_DICT is called. e.g. + + vars Q = + partapply_dict( + procedure( x, a, b, c ) with_props quadratic; + ( a * x + b ) * x + c + endprocedure, + ${ a = 1, b = 2, c = 1 } + ); + + Q( 4 ) => + ** 25 + +The closure will have N named frozen values, where N is the size of the dict. +Named frozen values can be overridden (see HELP * PARTAPPLY_OVERRIDE) + + vars R = partapply_override( Q, ${ b = 0, c = -4 } ); + R( 4 ) => + ** 12 + +--- Copyright (c) GetPoplog Sep 2021 ------------------------------------------- \ No newline at end of file diff --git a/base/pop/getpoploglib/help/partapply_override b/base/pop/getpoploglib/help/partapply_override new file mode 100644 index 00000000..4f64f73f --- /dev/null +++ b/base/pop/getpoploglib/help/partapply_override @@ -0,0 +1,10 @@ +HELP PARTAPPLY_OVERRIDE Stephen Leach, Sep 2021 + + partapply_override( , ) -> closure + +This procedure takes a closure and creates a copy with updated frozvals. +The may be a list or a dict. If args are a list of length N then +the frozvals from 1 to N are replaced by the elements of args. + +If the args are a dict then the closure must have named frozvals and the +dict is used to update the corresponding frozvals. diff --git a/base/pop/getpoploglib/help/read_variables b/base/pop/getpoploglib/help/read_variables new file mode 100644 index 00000000..fc2b68df --- /dev/null +++ b/base/pop/getpoploglib/help/read_variables @@ -0,0 +1,6 @@ +HELP READ_VARIABLES Steve Knight, Jan 1991 + +read_variables() -> + +This routine reads a list of "ordinary" variables from the input stream, +optionally separated by commas. It stops when it reaches any syntax word. diff --git a/base/pop/getpoploglib/help/repeater_from b/base/pop/getpoploglib/help/repeater_from new file mode 100644 index 00000000..37ac5dab --- /dev/null +++ b/base/pop/getpoploglib/help/repeater_from @@ -0,0 +1,34 @@ +HELP REPEATER_FROM Stephen Leach, Oct 2021 + + repeater_from( n: num ) -> r + repeater_from( n: item, procedure p ) -> r + +This function is used to construct non-terminating repeaters. If called with a +single numerical argument it returns a repeater that generates n, then n+1, +then n+2 etc. For example: + + Setpop + : vars r = repeater_from(1); + : r() => + ** 1 + : r() => + ** 2 + : r() => + ** 3 + : + + +If it is called with a procedure then the repeater that is returned, when called, +will generate n, p(n), p(p(n)), etc. For example: + + Setpop + : vars r = repeater_from( false, not ); + : r() => + ** + : r() => + ** + : r() => + ** + : r() => + ** + : diff --git a/base/pop/getpoploglib/help/restack b/base/pop/getpoploglib/help/restack new file mode 100644 index 00000000..fdd3d4b3 --- /dev/null +++ b/base/pop/getpoploglib/help/restack @@ -0,0 +1,246 @@ +HELP RESTACK Steve Knight, Jan 1991 + +restack id ... -> id ... ; + + -- General Description + -- Examples + -- The Idiom of Pure Stack Operations + -- Negative Examples + -- Positive Examples + +-- General Description ------------------------------------------------ + +The purpose of the "restack" construct is to rearrange the topmost items on +the stack. For example, you can reverse the top three items on the stack by +writing + + restack x y z -> z y x; + +The syntax of restack is + restack -> +where stands for a sequence of words optionally separated +by commas. All the output-words must appear in the input-words and no +input-word can occur twice. + +The effect of a restack is equivalent to writing + procedure( ) -> ( ); + lvars , ; + endprocedure(); +But using -restack- is much more efficient as it plants in-line code. + + +-- Examples ----------------------------------------------------------- + + 1, 2, 3; restack a b c -> c a b => + ** 3 1 2 + + ;;; You can use restack to check the number of items on the stack! + restack x -> x; ;;; with nothing on the stack! + ;;; MISHAP - STE: STACK EMPTY (missing argument? missing result?) + + +-- The Idiom of Pure Stack Operations --------------------------------- + +(This section provides some background on the idiom that restack is written +to support. It is not essential.) + +Most of the time in Pop11, you don't have to be particularly interested in the +stack. In fact, many programmers try to ignore the stack altogether. +However, there are a number of interesting programming 'idioms' or techniques +that are made possible by deliberately exploiting the fact that the stack is +completely open to the programmer. + +A familiar idiom to Pop11 programmers is the use of the stack in combination +with list or vector brackets. For example, you might write the familiar +"flatten" or "fringe" function (that constructs a list of all the elements in +a tree, represented as a list of lists) like this + + define flatten( tree ); lvars tree; + define lconstant walk_fringe( t ); lvars t; + if t.islist then + applist( t, walk_fringe ) + else + t + endif + enddefine; + [% walk_fringe( tree ) %] + enddefine; + +But there are several other ideas in this area. How can you sum the elements +in a list? Obviously you could write a "for" loop. Try thinking about +this! + + applist( 0, [2 4 6], nonop + ) => + ** 12 + +One rich source of ideas is the programming language FORTH. FORTH is a very +low-level language which, like Pop11, has an 'open' stack. Rather remarkably, +FORTH procedures have no local variables(!!) Instead, the FORTH programmer +has to learn how to carefully manipulate the stack so that the values they +want are always on top of the stack (and in the right order) when they are +needed. + +To help them, the FORTH programmer has a number of simple stack manipulation +routines. The most frequently used ones are + dup which duplicates the value on top x -> x x + drop which removes the topmost value x -> + swap which swaps the top two values x y -> y x + rot which rotates the top three stack values x y z -> z x y + rot2 equal to two rot's x y z -> y z x + over which copies the second value to the top x y -> x y x +Pop11 has the first two, which are "dup" and "erase" but not the other +four. + +Now the lack of local variables is typically a "bad thing" -- at least +from the viewpoint of conveniently writing programs. However, when you +get used to this way of writing routines, it is quite easy and SOMETIMES +it is very elegant. It is this idiom of pure stack-manipulation that +restack helps you exploit on those occasions. + + +-- Negative Examples -------------------------------------------------- + +Just to get a flavour of this programming style, I've written a couple of +functions in this style. The first is the well-known factorial function and +the second finds the roots of quadratic equations. They aren't especially +pretty to look at -- their purpose is only to get you thinking in pure-stack +operations and to realise that it needs a different way of thinking. + +;;; remember, we're not allowed to use any local variables! +define factorial(); + ;;; we want to compare the top of the stack with 0. However, we'll + ;;; need it later. This means we must take a copy using dup. + if dup() = 0 then + ;;; in this case, we don't need the input value any more. We + ;;; drop it, using erase, and then push 1 as the result. + erase(); 1 + else + ;;; we've got the input value N on top of the stack. We now + ;;; want to compute N * factorial( N - 1 ). This is especially + ;;; easy. + dup() - 1; ;;; leaves N; N-1 on the stack + factorial(); ;;; N; factorial( N - 1 ) + *; ;;; then multiply + endif +enddefine; + +Here's an even more grotesque example - finding the roots of the quadratic +equation a*x**2 + b*x +c = 0. First, we write it out in ordinary Pop11 code. + + define roots( a, b, c ); lvars a, b, c; + lvars base = sqrt( b ** 2 - 4 * a * c ); + lvars denom = 2 * a; + (-b + base) / denom; + (-b - base) / denom; + enddefine; + +Here it is, rather perversely, done without any local variables. + + define swap( a, b ) -> ( b, a ); lvars a, b; enddefine; + define rot( a, b, c ) -> ( c, a, b ); lvars a, b, c; enddefine; + define rot2( a, b, c ) -> ( b, c, a ); lvars a, b, c; enddefine; + define over( a, b ) -> ( a, b, a ); lvars a, b; enddefine; + + define roots(); + ;;; a, b, c on the stack + rot2() * 2; ;;; b, c, denom + dup() * 2; ;;; b, c, denom, 4*a + rot2(); ;;; b, denom, 4*a, c + *; ;;; b, denom, 4*a*c + rot2(); ;;; denom, 4*a*c, b + negate(); ;;; denom, 4*a*c, -b + dup() * dup(); ;;; denom, 4*a*c, -b, b**2 + rot2() -; ;;; denom, -b, b**2 - 4*a*c + sqrt(); ;;; denom, -b, base + over(); over(); ;;; denom, -b, base, -b, base + +; ;;; denom, -b, base, -b+base + rot() -; ;;; denom, -b+base, -b-base + rot(); over(); ;;; -b-base, denom, -b+base, denom + /; ;;; -b-base, denom, root1 + rot() /; ;;; root1; root2 + enddefine; + +These examples show: + 1. writing such code requires thinking about programming + in a different way, + 2. you only need a handful of stack operators, + 3. pure stack operator code is not always appropriate! + + +-- Positive Examples -------------------------------------------------- + +Here are a few examples that illustrate pure stack operations more positively. +They are all quite simple and use the stack operators very sparingly to create +elegant solutions. + +The first example is strikingly elegant in its use of the stack. Suppose +you were asked to write a function to generate the first N fibonacci numbers +as a list. (These are the numbers in the series 1, 1, 2, 3, 5, 8, 13, ... +where each number is the sum of the previous two.) Almost everyone writes +code looking like this -- for simplicity of presentation, I'll assume that +N >= 2 + define fibs( n ); lvars n; + lvars a = 1, b = 1; + [% + a; b; + repeat n-2 times + lvars c = a + b; + b -> a; + c -> b; + c; + endrepeat + %] + enddefine; +However, all these variables simply get in the way. The pure stack based +approach brushes them aside! + define fibs( n ); lvars n; + [% 1; 1; repeat n-2 times over() + over() endrepeat %] + enddefine; + + +The second example uses "swap" to create an elegant solution. Suppose you had +a list of vectors, and you wanted the third element from all these vectors + e.g. index( [{a b c} {d e f} {g h i}] ) => + ** [c f i] +One might be tempted to write a "for" loop -- but that's the brute force +approach. You might write + maplist( L, procedure( v ); lvars v; v(3) endprocedure ) +but that's a rather bulky expression. What you could try is pure stack +manipulation + maplist( L, swap(% 3 %) <> apply ) +There are many examples of this kind, where the pure stack manipulation +combines nicely with the use of functional programming. + +The third example also illustrates a similar use of "swap". Our task is +to "reverse" a list. + define reverse( L ); lvars L; + applist( [], L, swap <> conspair ) + enddefine; + + +-- The Idea Behind Restack -------------------------------------------- + +The idea behind restack is simple. Rather than provide a collection of +operators, restack is a single syntax word that allows you to write any +pure stack operation in a convenient fashion. Because it is a syntax word +it can generate efficient in-line code, too. + +It is not the sort of construct that's likely to find everyday use. It is +a flexible and efficient tool that helps provide the basis for a general +stack use idiom. + +One good way of using -restack- would be to use it in combination with +lib plant_in_line. That way, you could define functions such as "over" +so that they plant in-line code when used in-line. + +uses plant_in_line; + +lvars macro over_pattern = [restack x y -> x y x]; + +define constant procedure over() with_nargs 2; + over_pattern +enddefine; + +sysplant(% nonmac over_pattern %) -> plant_in_line( over ); + +----------------------------------------------------------------------- diff --git a/base/pop/getpoploglib/help/splitstring b/base/pop/getpoploglib/help/splitstring new file mode 100644 index 00000000..5ac392dc --- /dev/null +++ b/base/pop/getpoploglib/help/splitstring @@ -0,0 +1,33 @@ +HELP SPLITSTRING Stephen Leach, Sep 2021 + + splitstring( string, separator ) -> vector + splitstring( string, separator, maxsplit: int_or_false, constructor: procedure ) -> constructor( N ) + +In the first form, -splitstring- returns a vector of the sub-strings in the +-string-, using -sep- as the delimiter. The delimiter can be specified as a +string, character or regexp. For example: + + Setpop + : splitstring( 'abc,def,ghi', `,` ) => + ** {'abc' 'def' 'ghi'} + : + +In the second form, a limit on the number of splits can be specified and also +a different constructor from -consvector-. The constructor should be a +procedure that expects the top of the stack to be a count of the items beneath +it. + +If maxsplit is given as an integer, at most maxsplit splits are done (thus, +the list will have at most maxsplit+1 elements). If maxsplit is not specified +or -false- or -pop_undef-, then there is no limit on the number of splits (all +possible splits are made). + +For example: + + Setpop + : splitstring( 'abc,def,ghi', `,`, 1, conslist ) => + ** ['abc' 'def,ghi'] + : + : splitstring( 'abc,def,ghi', `,`, _, conslist ) => + ** ['abc' 'def' 'ghi'] + : diff --git a/base/pop/getpoploglib/lib/dict.p b/base/pop/getpoploglib/lib/dict.p new file mode 100644 index 00000000..4aff9ae3 --- /dev/null +++ b/base/pop/getpoploglib/lib/dict.p @@ -0,0 +1,214 @@ +compile_mode :pop11 +strict; + +section $-dict => + dict_key isdict dict_length + subscr_dict appdict is_null_dict; + +#_IF not( isdefined( "dict_key" ) ) + +constant ejection_threshold = 1024; + +define constant procedure clear_half( prop ); + lvars clear_these = ( + [% + fast_appproperty( + prop, + procedure( k, v ); + if random(1.0) < 0.5 then k endif + endprocedure + ) + %] + ); + lvars k; + for k in clear_these do + fast_kill_prop_entry( k, prop ) -> _; + endfor; +enddefine; + +;;; This table is used to ensure keysets are not usually duplicated. +constant procedure dict_table = + newanyproperty( + [], 8, 1, 8, + syshash, nonop =, "tmpval", + false, + procedure( key, prop ); + ;;; Have we grown too big? + if datalength( prop ) > ejection_threshold then + clear_half( prop ) + endif; + key ->> prop( key ); + endprocedure + ); + +global constant dict_key = conskey( "dict", [ full full ] ); +global constant procedure isdict = dict_key.class_recognise; + +constant procedure destdict = dict_key.class_dest; +constant procedure consdict = dict_key.class_cons; + +;;; Not exported but retained for autoloading. +constant procedure dict_keys = class_access( 1, dict_key ); +"dict_keys" -> dict_keys.pdprops; + +;;; Not exported but retained for autoloading. +constant procedure dict_values = class_access( 2, dict_key ); +"dict_values" -> dict_values.pdprops; + +define global constant procedure dict_length( dict ); + dict.dict_values.datalength +enddefine; + +define lconstant find( w, dict ); + lvars lo = 1; + lvars hi = dict.dict_values.datalength; + repeat + if lo < hi then + lvars mid = ( lo fi_+ hi ) fi_>> 1; + lvars midkey = subscrv( mid, dict.dict_keys ); + lvars cmp = alphabefore( w, midkey ); + if cmp then + if cmp == 1 then + return( mid ) + else + mid fi_- 1 -> hi; + endif + else + mid fi_+ 1 -> lo; + endif + elseif lo == hi and w == subscrv( lo, dict.dict_keys ) then + return( hi ) + else + mishap( 'Trying to index dict with invalid', [ ^w ] ) + endif + endrepeat +enddefine; + +define global constant procedure subscr_dict( w, dict ); + subscrv( find( w, dict ), dict.dict_values ) +enddefine; + +define updaterof subscr_dict( item, w, dict ); + item -> subscrv( find( w, dict ), dict.dict_values ) +enddefine; + +subscr_dict -> class_apply( dict_key ); + +define global constant procedure appdict( dict, procedure p ); + lvars i, n = dict.dict_length; + for i from 1 to n do + p( + fast_subscrv( i, dict.dict_keys ), + fast_subscrv( i, dict.dict_values ) + ) + endfor; +enddefine; + +define global constant procedure is_null_dict( dict ); + dict.dict_values.datalength == 0 +enddefine; + +define prdict( dict ); + pr( '${' ); + unless dict.is_null_dict do pr( ' ' ) endunless; + dlvars first = true; + appdict( + dict, + procedure( k, v ); + unless first then + pr( ', ' ) + endunless; + pr( k ); + pr( '=' ); + pr( v ); + false -> first; + endprocedure + ); + unless dict.is_null_dict do pr( ' ' ) endunless; + pr( '}' ); +enddefine; + +prdict -> class_print( dict_key ); + + +define lconstant procedure check_duplicates( key_index_list ); + lvars tail; + for tail on key_index_list do + if fast_back( tail ).ispair then + if fast_front( fast_front( tail ) ) == fast_front( fast_front( fast_back( tail ) ) ) then + mishap( 'Trying to construct dict with non-unique key', [% front(front(tail)) %] ) + endif + endif + endfor; +enddefine; + +;;; +;;; This is a helper function for building dict objects. It takes a list +;;; of unsorted pairs (key, position) and a vector of values and +;;; _takes ownership of these_ i.e. no other references to these parameters +;;; are usable after this function has run. This allows the values vector to +;;; be sorted and the list of pairs to be returned to the heap. +;;; +;;; newdict_internal: [ pair< word, int > ] * { T } -> dict< T > +;;; +define constant newdict_internal( key_index_list, values_vector ); + nc_listsort( + key_index_list, + procedure( x, y ); alphabefore( x.front, y.front ) endprocedure + ) -> key_index_list; + check_duplicates( key_index_list ); + lvars sorted_keys_vector = {% applist( key_index_list, front ) %}; + lvars sorted_values_vector = fill( + lblock + lvars p; + for p in key_index_list do + subscrv( p.back, values_vector ) + endfor + endlblock, + values_vector ;;; !! reusing this vector !! + ); + ;;; Now we can free up the working store. + while key_index_list.ispair do + ( key_index_list.sys_grbg_destpair -> key_index_list ).sys_grbg_destpair -> _ -> _; + endwhile; + ;;; And deliver the result. + consdict( sorted_keys_vector.dict_table, sorted_values_vector ) +enddefine; + +;;; This is a non-exported helper function for writing syntax words. +define compile_newdict_to( closing_keyword ) -> actual_closer; + dlocal pop_new_lvar_list; + lvars keys = []; + lvars n = 0; + lvars tmpvars = {% + until pop11_try_nextreaditem( closing_keyword ) ->> actual_closer do + while pop11_try_nextreaditem( "," ) do endwhile; + n + 1 -> n; + lvars k = readitem(); ;;; TODO: must be a word + unless k.isword do + mishap( 'Expected word as dict key', [^k] ) + endunless; + conspair( k, n ) :: keys -> keys; + pop11_need_nextreaditem( "=" ) -> _; + dlvars tmpvar = sysNEW_LVAR(); + pop11_comp_N( procedure(); pop11_comp_expr(); sysPOP(tmpvar) endprocedure, 0 ); + tmpvar + enduntil; + %}; + nc_listsort( + keys, + procedure( x, y ); alphabefore( x.front, y.front ) endprocedure + ) -> keys; + check_duplicates( keys ); + sysPUSHQ( {% applist( keys, front ) %} ); + lvars p; + for p in keys do + sysPUSH( subscrv( p.back, tmpvars ) ) + endfor; + sysPUSHQ( tmpvars.datalength ); + sysCALL( "consvector" ); + sysCALLQ( consdict ); +enddefine; + +#_ENDIF + +endsection; diff --git a/base/pop/getpoploglib/lib/named_arguments.p b/base/pop/getpoploglib/lib/named_arguments.p new file mode 100644 index 00000000..079838b0 --- /dev/null +++ b/base/pop/getpoploglib/lib/named_arguments.p @@ -0,0 +1,125 @@ +compile_mode :pop11 +strict; + +section; + +;;; WARNING! +procedure(); + dlocal cucharout = cucharerr; + npr( ';;; EXPERIMENTAL LIBRARY WARNING - named_arguments' ) +endprocedure(); + +uses frozval_names; + +define recalculate_offsets( fn, data ); + lvars ( detect_dirty, names, refs ) = data.explode; + until names.null do + lvars name = names.dest -> names; + lvars ref = refs.dest -> refs; + lvars index = frozval_stack_slot( name, fn ); + index -> cont( ref ); + enduntil; + fn -> cont( detect_dirty ); +enddefine; + +define plant_replace_stack_values( fn_name, names, tmpvars, refs ); + + define lconstant update_stacked_values( fn_name, tmpvars, refs ); + unless tmpvars.null do + lvars tmpvar = tmpvars.dest -> tmpvars; + lvars ref = refs.dest -> refs; + sysPUSH( tmpvar ); + sysPUSHQ( ref ); + sysCALL( "fast_cont" ); + sysUCALL( "subscr_stack" ); + update_stacked_values( fn_name, tmpvars, refs ); + endunless + enddefine; + + lvars detect_dirty = consref( false ); + sysPUSHQ( detect_dirty ); + sysCALL( "fast_cont" ); + sysPUSH( fn_name ); + sysCALL( "==" ); + lvars label_update_stacked_values = sysNEW_LABEL(); + sysIFSO( label_update_stacked_values ); + + sysPUSH( fn_name ); + sysPUSHQ( {% detect_dirty, names, refs %} ); + sysCALLQ( recalculate_offsets ); + + sysLABEL( label_update_stacked_values ); + update_stacked_values( fn_name, tmpvars, refs ); +enddefine; + +define compile_with_define( bound_names, bound_tmpvars ); + dlocal pop_new_lvar_list; + lvars fn_name = proglist.dest -> proglist; + [ + define ^fn_name + % + pop11_need_nextitem( "(" ); + until proglist.null or proglist.hd == ")" do + proglist.dest -> proglist; + enduntil; + lvars nm; + for nm in bound_names do + ",", nm + endfor; + % + ^^proglist + ] -> proglist; + pop11_comp_expr(); + sysPUSH( fn_name ); + sysPUSH( "popstackmark" ); + applist( bound_tmpvars, sysPUSH ); + sysCALL( "sysconslist" ); + sysCALL( "partapply" ); + sysPOP( fn_name ); + sysPUSHQ( bound_names ); + sysCALL( "destlist" ); + sysPUSH( fn_name ); + sysUCALL( "frozval_names" ); +enddefine; + +define syntax with; + dlocal pop_new_lvar_list; + lvars bound_names = []; + lvars bound_tmpvars = []; + lvars bound_refs = []; + lvars token; + until pop11_try_nextreaditem( [do define] ) ->> token do + lvars name = readitem(); ;;; macro expansion not allowed. + unless name.isword do + mishap( 'Word expected', [^name] ) + endunless; + pop11_need_nextitem( "=" ) -> _; + pop11_comp_expr(); + lvars tmpvar = sysNEW_LVAR(); + sysPOP( tmpvar ); + pop11_try_nextreaditem( "," ) -> _; + tmpvar :: bound_tmpvars -> bound_tmpvars; + name :: bound_names -> bound_names; + consref( false ) :: bound_refs -> bound_refs; + enduntil; + if token == "do" then + lvars next = pop11_comp_prec_expr( 0, false ); + lvars fn_name = sysNEW_LVAR(); + sysPOP( fn_name ); + if next /== "(" then + mishap( 'Missing (', [^next] ) + endif; + pop11_comp_prec_expr( 241, false ) -> _; + sysPUSH( fn_name ); + sysCALL( "explode" ); + plant_replace_stack_values( fn_name, bound_names, bound_tmpvars, bound_refs ); + sysPUSH( fn_name ); + sysCALL( "pdpart" ); + sysCALL( "fast_apply" ); + elseif token == "define" then + compile_with_define( bound_names, bound_tmpvars ) + else + mishap( 'Unexpected end of expression', [^token] ) + endif +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/unittests/new_list_builder.test.p b/base/pop/getpoploglib/unittests/new_list_builder.test.p new file mode 100644 index 00000000..0450d963 --- /dev/null +++ b/base/pop/getpoploglib/unittests/new_list_builder.test.p @@ -0,0 +1,41 @@ + +define :unittest test_new_list_builder; + + define :unittest empty; + ;;; Arrange + lvars b = new_list_builder(); + ;;; Act + lvars L = b( termin ); + lvars M = b( termin ); + ;;; Assert + assert L == nil; + assert M == nil; + enddefine; + + define :unittest some; + ;;; Arrange + lvars b = new_list_builder(); + lvars items = [ a b c ]; + applist( items, b ); + ;;; Act + lvars L = b( termin ); + lvars M = b( termin ); + ;;; Assert + assert L = items; + assert L /== items; + assert M == nil; + enddefine; + + define :unittest is; + ;;; Arrange + lvars banana = "banana"; + lvars b = new_list_builder(); + ;;; Act + lvars banana_is = is_list_builder( banana ); + lvars b_is = is_list_builder( b ); + ;;; Assert + assert banana_is.not; + assert b_is; + enddefine; + +enddefine; diff --git a/base/pop/getpoploglib/unittests/read_variables.test.p b/base/pop/getpoploglib/unittests/read_variables.test.p new file mode 100644 index 00000000..b35aa859 --- /dev/null +++ b/base/pop/getpoploglib/unittests/read_variables.test.p @@ -0,0 +1,40 @@ +compile_mode :pop11 +strict; + +section; + +define :unittest no_variables_to_termin(); + dlocal proglist = []; + assert read_variables() == []; +enddefine; + +define :unittest no_variables_to_semi(); + dlocal proglist = [;]; + assert read_variables() == []; +enddefine; + +define :unittest no_variables_to_close_parenthesis(); + dlocal proglist = [)]; + assert read_variables() == []; +enddefine; + +define :unittest one_variables_no_comma(); + dlocal proglist = [x]; + assert read_variables() = [x]; +enddefine; + +define :unittest one_variables_with_commas(); + dlocal proglist = [,x,]; + assert read_variables() = [x]; +enddefine; + +define :unittest two_variables_with_many_commas(); + dlocal proglist = [,x,,,y]; + assert read_variables() = [x y]; +enddefine; + + + + + + +endsection; diff --git a/base/pop/getpoploglib/unittests/restack.test.p b/base/pop/getpoploglib/unittests/restack.test.p new file mode 100644 index 00000000..a9f10bab --- /dev/null +++ b/base/pop/getpoploglib/unittests/restack.test.p @@ -0,0 +1,43 @@ +compile_mode :pop11 +strict; + +section; + +define :unittest do_nothing(); + lvars zero = stacklength(); + restack -> ; + assert stacklength() == zero; +enddefine; + +define :unittest swap(); + ( "foo", "bar" ); + restack x y -> y x; + lvars z = () <> (); + assert "barfoo" == z; +enddefine; + +define :unittest duplicate(); + ( "foo", "bar" ); + restack x y -> y y; + lvars z = () <> (); + assert "barbar" == z; +enddefine; + +define :unittest shrink_stack(); + lvars n = stacklength(); + ( "foo", "bar" ); + restack x y -> y; + lvars z = (); + assert "bar" == z; + assert stacklength() == n; +enddefine; + +define :unittest grow_stack(); + lvars n = stacklength(); + ( "foo", "bar" ); + restack x y -> x y x y; + lvars z = () <> () <> () <> (); + assert "foobarfoobar" == z; + assert stacklength() == n; +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/unittests/splitstring.test.p b/base/pop/getpoploglib/unittests/splitstring.test.p new file mode 100644 index 00000000..d5a29f54 --- /dev/null +++ b/base/pop/getpoploglib/unittests/splitstring.test.p @@ -0,0 +1,72 @@ +;;; --- Anonymous tests --- + +define :unittest; + ;;; Act + lvars actual = splitstring( 'abc|def|ghi', '|' ); + ;;; Assert + assert { 'abc' 'def' 'ghi' } = actual; +enddefine; + +;;; --- with_data tests --- + +with_data + [ '' ',' {''} ] + [ '' ',' ^false ^consvector {''} ] + [ 'abc' ',' {'abc'} ] + [ ',' ',' {'' ''} ] + [ ',' `,` {'' ''} ] + [ 'abc,' ',' {'abc' ''} ] + [ 'abc--def' '--' {'abc' 'def'} ] + [ 'abc----def' '--' {'abc' '' 'def'} ] + [ 'abc----def' '--' {'abc' '' 'def'} ] + [ 'abc--def--ghi' '--' {'abc' 'def' 'ghi'} ] + [ '---abc--def--ghi' '--' {'' '-abc' 'def' 'ghi'} ] + [ 'a b c' ' ' ^false ^conslist ['a' 'b' 'c'] ] + [ 'a b c' ' ' 1 ^conslist ['a' 'b c'] ] +define :unittest( expected ); + ;;; Act + lvars actual = splitstring( /*stack*/ ); + ;;; Assert + assert actual = expected; +enddefine; + +;;; --- Named tests --- + +define :unittest test_splitstring_nested; + + define :unittest test_splitstring_regexp(); + ;;; Arrange + lvars ( _, regexp_p ) = regexp_compile( '@[,;@]' ); + ;;; Act + lvars actual = splitstring( 'abc,def;ghi', regexp_p ); + ;;; Assert + assert actual = { 'abc' 'def' 'ghi' }; + enddefine; + + define :unittest test_splitstring_regexp_conslist(); + ;;; Arrange + lvars ( _, regexp_p ) = regexp_compile( '@[,;@]' ); + ;;; Act + lvars actual = splitstring( 'abc,def;ghi', regexp_p, false, conslist ); + ;;; Assert + assert actual = [ 'abc' 'def' 'ghi' ]; + enddefine; + + define :unittest test_splitstring_regexp_conslist_max1(); + ;;; Arrange + lvars ( _, regexp_p ) = regexp_compile( '@[,;@]' ); + ;;; Act + lvars actual = splitstring( 'abc,def;ghi', regexp_p, 1, conslist ); + ;;; Assert + assert actual = [ 'abc' 'def;ghi' ]; + enddefine; + +enddefine; + + +;;; --- expect_mishap tests --- + +define :unittest; + dlocal expect_mishap = true; + splitstring( "wordsarenotstrings", `,` ) -> _; +enddefine; diff --git a/corepops/README.md b/corepops/README.md index 9154a6e6..f8c70f28 100644 --- a/corepops/README.md +++ b/corepops/README.md @@ -54,21 +54,21 @@ For example, `010-05_11_12-2021_07_07.corepop` has: | linux/x86_64/020-05_08_00-2021_06_24.corepop | fedora | 32 | :x: | 127 |
details
/corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop: error while loading shared libraries: libncurses.so.5: cannot open shared object file: No such file or directory
| | linux/x86_64/020-05_08_00-2021_06_24.corepop | centos | 8 | :x: | 127 |
details
/corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop: error while loading shared libraries: libncurses.so.5: cannot open shared object file: No such file or directory
| | linux/x86_64/020-05_08_00-2021_06_24.corepop | centos | 7 | :x: | 1 |
details
/corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop: /lib64/libtinfo.so.5: no version information available (required by /corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop)
/corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop: /lib64/libm.so.6: version `GLIBC_2.29' not found (required by /corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop)
| -| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 21.04 | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 20.04 | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 18.04 | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 16.04 | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | archlinux | latest | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | unstable-slim | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | testing-slim | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | stable-slim | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | oldstable-slim | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | oldoldstable | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 34 | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 33 | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 32 | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | centos | 8 | :heavy_check_mark: | 0 | | -| linux/x86_64/030-05_04_00-2020_08_22.corepop | centos | 7 | :heavy_check_mark: | 0 | | +| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 21.04 | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 20.04 | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 18.04 | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 16.04 | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | archlinux | latest | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | unstable-slim | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | testing-slim | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | stable-slim | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | oldstable-slim | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | oldoldstable | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 34 | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 33 | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 32 | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | centos | 8 | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| +| linux/x86_64/030-05_04_00-2020_08_22.corepop | centos | 7 | :x: | 1 |
details

<<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,
	Code = 2 >>>>>>>


;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable
;;; 	system structure?)
;;; PRINT DOING
;;; DOING    :  null nextitem
| | linux/x86_64/040-05_08_00-2021_07_30.corepop | ubuntu | 21.04 | :x: | 127 |
details
/corepops/linux/x86_64/040-05_08_00-2021_07_30.corepop: error while loading shared libraries: libXt.so.6: cannot open shared object file: No such file or directory
| | linux/x86_64/040-05_08_00-2021_07_30.corepop | ubuntu | 20.04 | :x: | 127 |
details
/corepops/linux/x86_64/040-05_08_00-2021_07_30.corepop: error while loading shared libraries: libXt.so.6: cannot open shared object file: No such file or directory
| | linux/x86_64/040-05_08_00-2021_07_30.corepop | ubuntu | 18.04 | :x: | 127 |
details
/corepops/linux/x86_64/040-05_08_00-2021_07_30.corepop: error while loading shared libraries: libXt.so.6: cannot open shared object file: No such file or directory
|