minor code cleanup
All checks were successful
continuous-integration/drone/push Build is passing

This commit is contained in:
hyung-hwan 2024-02-11 16:39:16 +09:00
parent cac171f4b2
commit f85dd54040
4 changed files with 45 additions and 14 deletions

View File

@ -487,8 +487,6 @@ struct hcl_ptlc_t
typedef unsigned int hcl_bitmask_t; typedef unsigned int hcl_bitmask_t;
typedef unsigned int hcl_bitmask_t;
/* ========================================================================= /* =========================================================================
* BIGINT TYPES AND MACROS * BIGINT TYPES AND MACROS
* ========================================================================= */ * ========================================================================= */

View File

@ -221,24 +221,24 @@ typedef enum hcl_option_dflval_t hcl_option_dflval_t;
enum hcl_trait_t enum hcl_trait_t
{ {
#if defined(HCL_BUILD_DEBUG) #if defined(HCL_BUILD_DEBUG)
HCL_TRAIT_DEBUG_GC = (1u << 0), HCL_TRAIT_DEBUG_GC = (((hcl_bitmask_t)1) << 0),
HCL_TRAIT_DEBUG_BIGINT = (1u << 1), HCL_TRAIT_DEBUG_BIGINT = (((hcl_bitmask_t)1) << 1),
#endif #endif
HCL_TRAIT_INTERACTIVE = (1u << 7), HCL_TRAIT_INTERACTIVE = (((hcl_bitmask_t)1) << 7),
/* perform no garbage collection when the heap is full. /* perform no garbage collection when the heap is full.
* you still can use hcl_gc() explicitly. */ * you still can use hcl_gc() explicitly. */
HCL_TRAIT_NOGC = (1u << 8), HCL_TRAIT_NOGC = (((hcl_bitmask_t)1) << 8),
/* wait for running process when exiting from the main method */ /* wait for running process when exiting from the main method */
HCL_TRAIT_AWAIT_PROCS = (1u << 9), HCL_TRAIT_AWAIT_PROCS = (((hcl_bitmask_t)1) << 9),
/* return EOL as a token */ /* TODO: make this pragma controllable */ /* return EOL as a token */ /* TODO: make this pragma controllable */
HCL_TRAIT_LANG_ENABLE_EOL = (1u << 14), HCL_TRAIT_LANG_ENABLE_EOL = (((hcl_bitmask_t)1) << 14),
/* enable block expression as mandatory argument to some expresions */ /* enable block expression as mandatory argument to some expresions */
HCL_TRAIT_LANG_ENABLE_BLOCK = (1u << 15), HCL_TRAIT_LANG_ENABLE_BLOCK = (((hcl_bitmask_t)1) << 15),
}; };
typedef enum hcl_trait_t hcl_trait_t; typedef enum hcl_trait_t hcl_trait_t;

View File

@ -9,6 +9,24 @@ unit HCL;
interface interface
type type
BitMask = longword; (* this must match hcl_bitmask_t in hcl.h *)
(*const
TRAIT_LANG_ENABLE_EOF = (BitMask(1) shl 14);
TRAIT_LANG_ENABLE_BLOCK = (BitMask(1) shl 15);*)
type
TraitBit = (
LANG_ENABLE_EOF = (BitMask(1) shl 14),
LANG_ENABLE_BLOCK = (BitMask(1) shl 15)
);
Option = (
TRAIT,
LOG_MASK,
LOG_MAXCAPA
);
Interp = class Interp = class
protected protected
handle: pointer; handle: pointer;
@ -50,13 +68,17 @@ function hcl_errnum_is_synerr(errnum: integer): boolean; cdecl; external;
function hcl_openstd(xtnsize: sizeint; errnum: pointer): pointer; cdecl; external; function hcl_openstd(xtnsize: sizeint; errnum: pointer): pointer; cdecl; external;
procedure hcl_close(handle: pointer); cdecl; external; procedure hcl_close(handle: pointer); cdecl; external;
function hcl_setoption(handle: pointer; option: Option; value: pointer): integer; cdecl; external;
function hcl_getoption(handle: pointer; option: Option; value: pointer): integer; cdecl; external;
function hcl_geterrnum(handle: pointer): integer; cdecl; external; function hcl_geterrnum(handle: pointer): integer; cdecl; external;
function hcl_geterrbmsg(handle: pointer): pansichar; cdecl; external; function hcl_geterrbmsg(handle: pointer): pansichar; cdecl; external;
function hcl_ignite(handle: pointer; heapsize: sizeint): integer; cdecl; external; function hcl_ignite(handle: pointer; heapsize: sizeint): integer; cdecl; external;
function hcl_addbuiltinprims(handle: pointer): integer; cdecl; external; function hcl_addbuiltinprims(handle: pointer): integer; cdecl; external;
function hcl_beginfeed(handle: pointer; on_cnode: pointer): integer; cdecl; external; function hcl_beginfeed(handle: pointer; on_cnode: pointer): integer; cdecl; external;
function hcl_feedbchars(handle: pointer; data: pansichar; len: sizeint): integer; cdecl; external; function hcl_feedbchars(handle: pointer; data: pansichar; len: sizeint): integer; cdecl; external;
function hcl_feeduchars(handle: pointer; data: pwidechar; len: sizeint): integer; cdecl; external; (* this is wrong in deed *) function hcl_feeduchars(handle: pointer; data: pwidechar; len: sizeint): integer; cdecl; external; (* this is wrong in deed - hcl_uchar_t may not been widechar ..*)
function hcl_endfeed(handle: pointer): integer; cdecl; external; function hcl_endfeed(handle: pointer): integer; cdecl; external;
function hcl_attachcciostdwithbcstr(handle: pointer; cci: pansichar): integer; cdecl; external; function hcl_attachcciostdwithbcstr(handle: pointer; cci: pansichar): integer; cdecl; external;
@ -80,12 +102,21 @@ var
h: pointer; h: pointer;
errnum: integer; errnum: integer;
errmsg: array[0..255] of AnsiChar; errmsg: array[0..255] of AnsiChar;
tb: BitMask;
begin begin
h := hcl_openstd(0, @errnum); h := hcl_openstd(0, @errnum);
if h = nil then begin if h = nil then begin
hcl_errnum_to_errbcstr(errnum, @errmsg, length(errmsg)); hcl_errnum_to_errbcstr(errnum, @errmsg, length(errmsg));
raise Exception.Create(errmsg); raise Exception.Create(errmsg);
end; end;
tb := BitMask(TraitBit.LANG_ENABLE_EOF) or BitMask(TraitBit.LANG_ENABLE_BLOCK);
if hcl_setoption(h, Option.TRAIT, @tb) <= -1 then begin
hcl_errnum_to_errbcstr(errnum, @errmsg, length(errmsg));
hcl_close(h);
raise Exception.Create(errmsg);
end;
self.handle := h; self.handle := h;
end; end;

View File

@ -18,7 +18,9 @@ begin
x.Compile(pwidechar('(printf "hello 동키콩\n")')); x.Compile(pwidechar('(printf "hello 동키콩\n")'));
x.Compile('(printf "hello 동키콩월드\n") '); x.Compile('(printf "hello 동키콩월드\n") ');
x.Compile('(동가리오 := 20)'); x.Compile('(동가리오 := 20)');
x.Compile('(printf "%d %d\n" 동가리오 (* 동가리오 동가리오))'); x.Compile('(printf "%d %d\n" 동가리오 (+ 동가리오 동가리오))');
x.Compile(pwidechar('(printf "%d %d\n" 동가리오 (동가리오 * 동가리오))'#10'printf "hello, world\n";;;'#10));
x.Execute(); // check if exception... x.Execute(); // check if exception...
except except