S" FICL_WANT_LOCALS" ENVIRONMENT? drop [if] \ ** ficl/softwords/jhlocal.fr \ ** stack comment style local syntax... \ { a b c | cleared -- d e } \ variables before the "|" are initialized in reverse order \ from the stack. Those after the "|" are zero initialized. \ Anything between "--" and "}" is treated as comment \ Uses locals... \ locstate: 0 = looking for | or -- or }} \ 1 = found | \ 2 = found -- \ 3 = found } \ 4 = end of line \ \ revised 2 June 2000 - { | a -- } now works correctly .( loading Johns-Hopkins locals ) cr hide \ What does this do? It's equivalent to "postpone 0", but faster. \ "ficlInstruction0" is the FICL instruction for "push a 0 on the data stack". \ --lch : compiled-zero ficlInstruction0 , ; S" FICL_WANT_FLOAT" ENVIRONMENT? drop [if] \ And this is the instruction for a floating-point 0 (0.0e). : compiled-float-zero ficlInstructionF0 , ; [endif] : ?-- ( c-addr u -- c-addr u flag ) 2dup s" --" compare 0= ; : ?} ( c-addr u -- c-addr u flag ) 2dup s" }" compare 0= ; : ?| ( c-addr u -- c-addr u flag ) 2dup s" |" compare 0= ; 1 constant local-is-double 2 constant local-is-float \ parse-local-prefix-flags \ \ Parses single-letter prefix flags from the name of a local, and returns \ a bitfield of all flags (local-is-float | local-is-double) appropriate \ for the local. Adjusts the "c-addr u" of the name to remove any prefix. \ \ Handled single-letter prefix flags: \ 1 single-cell \ 2 double-cell \ d double-cell \ f floating-point (use floating stack) \ i integer (use data stack) \ s single-cell \ Specify as many as you like; later flags have precidence. \ Thus, "f2:foo" and "2is2f:foo" are both double-cell floats. \ \ If you don't specify anything after the colon, like "f2:", \ there is no legal prefix, so "2f:" becomes the name of the \ (single-cell data stack) local. \ \ For convention, the "f" is preferred first. : parse-local-prefix-flags ( c-addr u -- c-addr u flags ) 0 0 0 locals| stop-loop colon-offset flags u c-addr | \ if the first character is a colon, remove the colon and return 0. c-addr c@ [char] : = if over over 0 exit endif u 0 do c-addr i + c@ case [char] 1 of flags local-is-double invert and to flags endof [char] 2 of flags local-is-double or to flags endof [char] d of flags local-is-double or to flags endof [char] f of flags local-is-float or to flags endof [char] i of flags local-is-float invert and to flags endof [char] s of flags local-is-double invert and to flags endof [char] : of i 1+ to colon-offset 1 to stop-loop endof 1 to stop-loop endcase stop-loop if leave endif loop colon-offset 0= colon-offset u = or if \ ." Returning variable name -- " c-addr u type ." -- No flags." cr c-addr u 0 exit endif c-addr colon-offset + u colon-offset - \ ." Returning variable name -- " 2dup type ." -- Flags: " flags . cr flags ; : ?delim ( c-addr u -- state | c-addr u 0 ) ?| if 2drop 1 exit endif ?-- if 2drop 2 exit endif ?} if 2drop 3 exit endif dup 0= if 2drop 4 exit endif 0 ; set-current S" FICL_WANT_FLOAT" ENVIRONMENT? drop [if] : { 0 0 0 locals| flags local-state nLocals | \ stack locals until we hit a delimiter begin parse-word ?delim dup to local-state 0= while nLocals 1+ to nLocals repeat \ now unstack the locals nLocals 0 ?do parse-local-prefix-flags to flags flags local-is-double and if flags local-is-float and if (f2local) else (2local) endif else flags local-is-float and if (flocal) else (local) endif endif loop \ ( ) \ zero locals until -- or } local-state 1 = if begin parse-word ?delim dup to local-state 0= while parse-local-prefix-flags to flags flags local-is-double and if flags local-is-float and if compiled-float-zero compiled-float-zero (f2local) else compiled-zero compiled-zero (2local) endif else flags local-is-float and if compiled-float-zero (flocal) else compiled-zero (local) endif endif repeat endif 0 0 (local) \ toss words until } \ (explicitly allow | and -- in the comment) local-state 2 = if begin parse-word ?delim dup to local-state 3 < while local-state 0= if 2drop endif repeat endif local-state 3 <> abort" syntax error in { } local line" ; immediate compile-only [else] : { 0 0 0 locals| flags local-state nLocals | \ stack locals until we hit a delimiter begin parse-word ?delim dup to local-state 0= while nLocals 1+ to nLocals repeat \ now unstack the locals nLocals 0 ?do parse-local-prefix-flags to flags flags local-is-double and if (2local) else (local) endif loop \ ( ) \ zero locals until -- or } local-state 1 = if begin parse-word ?delim dup to local-state 0= while parse-local-prefix-flags to flags flags local-is-double and if compiled-zero compiled-zero (2local) else compiled-zero (local) endif repeat endif 0 0 (local) \ toss words until } \ (explicitly allow | and -- in the comment) local-state 2 = if begin parse-word ?delim dup to local-state 3 < while local-state 0= if 2drop endif repeat endif local-state 3 <> abort" syntax error in { } local line" ; immediate compile-only [endif] previous [endif]