895 lines
20 KiB
Elm
895 lines
20 KiB
Elm
module Joy exposing (JoyDict, doit, initialize)
|
|
|
|
import Bitwise
|
|
import Dict exposing (Dict, get, insert)
|
|
import Result exposing (andThen)
|
|
import String exposing (lines, replace, words)
|
|
|
|
|
|
type JoyType
|
|
= JoySymbol String
|
|
| JoyInt Int
|
|
| JoyList (List JoyType)
|
|
| JoyTrue
|
|
| JoyFalse
|
|
|
|
|
|
type alias JList =
|
|
List JoyType
|
|
|
|
|
|
type alias JoyDict =
|
|
Dict String JList
|
|
|
|
|
|
-- Joy functions take a stack and expression and return a stack and
|
|
-- expression, but something might go wrong, so they really return a
|
|
-- Result value.
|
|
|
|
type alias JoyFunction = JList -> JList -> Result String ( JList, JList )
|
|
|
|
|
|
joy : JList -> JList -> JoyDict -> Result String ( JList, JoyDict )
|
|
joy stack expression dict =
|
|
case expression of
|
|
[] ->
|
|
Ok ( stack, dict )
|
|
|
|
term :: rest_of_expression ->
|
|
case term of
|
|
JoySymbol symbol ->
|
|
case joy_eval symbol stack rest_of_expression dict of
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Ok ( s, e, dict0 ) ->
|
|
joy s e dict0
|
|
|
|
_ ->
|
|
joy (term :: stack) rest_of_expression dict
|
|
|
|
|
|
joy_eval : String -> JList -> JList -> JoyDict -> Result String ( JList, JList, JoyDict )
|
|
joy_eval symbol stack expression dict =
|
|
if symbol == "" then
|
|
Ok ( stack, expression, dict )
|
|
|
|
else if symbol == "inscribe" then
|
|
joy_inscribe stack expression dict
|
|
|
|
else
|
|
case joy_function_eval symbol stack expression of
|
|
Err msg ->
|
|
if "Unknown word." == msg then
|
|
-- Look up word in dictionary.
|
|
case get symbol dict of
|
|
Just definition ->
|
|
Ok ( stack, definition ++ expression, dict )
|
|
|
|
Nothing ->
|
|
Err ("Unknown word: " ++ symbol)
|
|
|
|
else
|
|
Err msg
|
|
|
|
Ok ( stack0, expression0 ) ->
|
|
Ok ( stack0, expression0, dict )
|
|
|
|
|
|
joy_function_eval symbol stack expression =
|
|
case symbol of
|
|
"branch" ->
|
|
joy_branch stack expression
|
|
|
|
"i" ->
|
|
joy_i stack expression
|
|
|
|
"dip" ->
|
|
joy_dip stack expression
|
|
|
|
"loop" ->
|
|
joy_loop stack expression
|
|
|
|
"+" ->
|
|
joy_binary_math_op (+) stack expression
|
|
|
|
"-" ->
|
|
joy_binary_math_op (-) stack expression
|
|
|
|
"*" ->
|
|
joy_binary_math_op (*) stack expression
|
|
|
|
"/" ->
|
|
joy_binary_math_op (//) stack expression
|
|
|
|
"%" ->
|
|
joy_binary_math_op (swap_args remainderBy) stack expression
|
|
|
|
"add" ->
|
|
joy_binary_math_op (+) stack expression
|
|
|
|
"sub" ->
|
|
joy_binary_math_op (-) stack expression
|
|
|
|
"mul" ->
|
|
joy_binary_math_op (*) stack expression
|
|
|
|
"div" ->
|
|
joy_binary_math_op (//) stack expression
|
|
|
|
"mod" ->
|
|
joy_binary_math_op (swap_args remainderBy) stack expression
|
|
|
|
"<" ->
|
|
joy_comparison_op (<) stack expression
|
|
|
|
">" ->
|
|
joy_comparison_op (>) stack expression
|
|
|
|
"<=" ->
|
|
joy_comparison_op (<=) stack expression
|
|
|
|
">=" ->
|
|
joy_comparison_op (>=) stack expression
|
|
|
|
"<>" ->
|
|
joy_comparison_op (/=) stack expression
|
|
|
|
"!=" ->
|
|
joy_comparison_op (/=) stack expression
|
|
|
|
"=" ->
|
|
joy_comparison_op (==) stack expression
|
|
|
|
"and" ->
|
|
joy_binary_math_op Bitwise.and stack expression
|
|
|
|
"or" ->
|
|
joy_binary_math_op Bitwise.or stack expression
|
|
|
|
"xor" ->
|
|
joy_binary_math_op Bitwise.xor stack expression
|
|
|
|
"lshift" ->
|
|
joy_binary_math_op (swap_args Bitwise.shiftLeftBy) stack expression
|
|
|
|
"<<" ->
|
|
joy_binary_math_op (swap_args Bitwise.shiftLeftBy) stack expression
|
|
|
|
"rshift" ->
|
|
joy_binary_math_op (swap_args Bitwise.shiftRightBy) stack expression
|
|
|
|
">>" ->
|
|
joy_binary_math_op (swap_args Bitwise.shiftRightBy) stack expression
|
|
|
|
"/\\" ->
|
|
joy_logical_op (&&) stack expression
|
|
|
|
"\\/" ->
|
|
joy_logical_op (||) stack expression
|
|
|
|
"_\\/_" ->
|
|
joy_logical_op xor stack expression
|
|
|
|
"clear" ->
|
|
Ok ( [], expression )
|
|
|
|
"concat" ->
|
|
joy_concat stack expression
|
|
|
|
"cons" ->
|
|
joy_cons stack expression
|
|
|
|
"dup" ->
|
|
joy_dup stack expression
|
|
|
|
"first" ->
|
|
joy_first stack expression
|
|
|
|
"pop" ->
|
|
joy_pop stack expression
|
|
|
|
"rest" ->
|
|
joy_rest stack expression
|
|
|
|
"stack" ->
|
|
joy_stack stack expression
|
|
|
|
"swaack" ->
|
|
joy_swaack stack expression
|
|
|
|
"swap" ->
|
|
joy_swap stack expression
|
|
|
|
"truthy" ->
|
|
joy_truthy stack expression
|
|
|
|
"bool" ->
|
|
joy_truthy stack expression
|
|
|
|
_ ->
|
|
Err "Unknown word."
|
|
|
|
|
|
joy_inscribe : JList -> JList -> JoyDict -> Result String ( JList, JList, JoyDict )
|
|
joy_inscribe stack expression dict =
|
|
case pop_list stack of
|
|
Ok ( def, s0 ) ->
|
|
case def of
|
|
[] ->
|
|
Err "Empty definition."
|
|
|
|
sym :: body ->
|
|
-- check that name is a symbol
|
|
case sym of
|
|
JoySymbol name ->
|
|
Ok ( s0, expression, insert name body dict )
|
|
|
|
_ ->
|
|
Err "Def name isn't symbol."
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_branch : JoyFunction
|
|
joy_branch stack expression =
|
|
case pop_list stack of
|
|
Ok ( true_body, s0 ) ->
|
|
case pop_list s0 of
|
|
Ok ( false_body, s1 ) ->
|
|
case pop_bool s1 of
|
|
Ok ( flag, s2 ) ->
|
|
if flag then
|
|
Ok ( s2, true_body ++ expression )
|
|
|
|
else
|
|
Ok ( s2, false_body ++ expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_i : JoyFunction
|
|
joy_i stack expression =
|
|
case pop_list stack of
|
|
Ok ( a, s0 ) ->
|
|
Ok ( s0, a ++ expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_dip : JoyFunction
|
|
joy_dip stack expression =
|
|
case pop_list stack of
|
|
Ok ( quoted_expression, s0 ) ->
|
|
case pop_any s0 of
|
|
Ok ( x, s1 ) ->
|
|
Ok ( s1, quoted_expression ++ (x :: expression) )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_loop : JoyFunction
|
|
joy_loop stack expression =
|
|
case pop_list stack of
|
|
Ok ( loop_body, s0 ) ->
|
|
case pop_bool s0 of
|
|
Ok ( flag, s1 ) ->
|
|
if flag then
|
|
Ok ( s1, loop_body ++ (JoyList loop_body :: JoySymbol "loop" :: expression) )
|
|
|
|
else
|
|
Ok ( s1, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_binary_math_op : (Int -> Int -> Int) -> JoyFunction
|
|
joy_binary_math_op op stack expression =
|
|
case pop_int stack of
|
|
Ok ( a, s0 ) ->
|
|
case pop_int s0 of
|
|
Ok ( b, s1 ) ->
|
|
Ok ( push_int (op b a) s1, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
swap_args : (Int -> Int -> Int) -> (Int -> Int -> Int)
|
|
swap_args op =
|
|
\a b -> op b a
|
|
|
|
|
|
joy_comparison_op : (Int -> Int -> Bool) -> JoyFunction
|
|
joy_comparison_op op stack expression =
|
|
case pop_int stack of
|
|
Ok ( a, s0 ) ->
|
|
case pop_int s0 of
|
|
Ok ( b, s1 ) ->
|
|
Ok ( push_bool (op b a) s1, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_logical_op : (Bool -> Bool -> Bool) -> JoyFunction
|
|
joy_logical_op op stack expression =
|
|
case pop_bool stack of
|
|
Ok ( a, s0 ) ->
|
|
case pop_bool s0 of
|
|
Ok ( b, s1 ) ->
|
|
Ok ( push_bool (op b a) s1, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_concat : JoyFunction
|
|
joy_concat stack expression =
|
|
case pop_list stack of
|
|
Ok ( a, s0 ) ->
|
|
case pop_list s0 of
|
|
Ok ( b, s1 ) ->
|
|
Ok ( push_list (b ++ a) s1, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_cons : JoyFunction
|
|
joy_cons stack expression =
|
|
case pop_list stack of
|
|
Ok ( a, s0 ) ->
|
|
case pop_any s0 of
|
|
Ok ( b, s1 ) ->
|
|
Ok ( push_list (b :: a) s1, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_dup : JoyFunction
|
|
joy_dup stack expression =
|
|
case pop_any stack of
|
|
Ok ( a, s0 ) ->
|
|
Ok ( a :: stack, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_first : JoyFunction
|
|
joy_first stack expression =
|
|
case pop_list stack of
|
|
Ok ( a, s0 ) ->
|
|
case pop_any a of
|
|
Ok ( b, _ ) ->
|
|
Ok ( push_any b s0, expression )
|
|
|
|
Err _ ->
|
|
Err "Cannot take first of empty list."
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_pop : JoyFunction
|
|
joy_pop stack expression =
|
|
case pop_any stack of
|
|
Ok ( _, s0 ) ->
|
|
Ok ( s0, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_rest : JoyFunction
|
|
joy_rest stack expression =
|
|
case pop_list stack of
|
|
Ok ( a, s0 ) ->
|
|
case pop_any a of
|
|
Ok ( _, el ) ->
|
|
Ok ( push_list el s0, expression )
|
|
|
|
Err _ ->
|
|
Err "Cannot take rest of empty list."
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_stack : JoyFunction
|
|
joy_stack stack expression =
|
|
Ok ( push_list stack stack, expression )
|
|
|
|
|
|
joy_swaack : JoyFunction
|
|
joy_swaack stack expression =
|
|
case pop_list stack of
|
|
Ok ( s, s0 ) ->
|
|
Ok ( push_list s0 s, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_swap : JoyFunction
|
|
joy_swap stack expression =
|
|
case pop_any stack of
|
|
Ok ( a, s0 ) ->
|
|
case pop_any s0 of
|
|
Ok ( b, s1 ) ->
|
|
Ok ( b :: a :: s1, expression )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
joy_truthy : JoyFunction
|
|
joy_truthy stack expression =
|
|
case pop_any stack of
|
|
Ok ( a, s0 ) ->
|
|
case a of
|
|
JoyTrue ->
|
|
Ok ( stack, expression )
|
|
|
|
JoyFalse ->
|
|
Ok ( stack, expression )
|
|
|
|
JoyInt i ->
|
|
if 0 == i then
|
|
Ok ( JoyFalse :: s0, expression )
|
|
|
|
else
|
|
Ok ( JoyTrue :: s0, expression )
|
|
|
|
JoyList el ->
|
|
if [] == el then
|
|
Ok ( JoyFalse :: s0, expression )
|
|
|
|
else
|
|
Ok ( JoyTrue :: s0, expression )
|
|
|
|
JoySymbol _ ->
|
|
Err "Cannot Boolify."
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
push_bool : Bool -> JList -> JList
|
|
push_bool flag stack =
|
|
if flag then
|
|
JoyTrue :: stack
|
|
|
|
else
|
|
JoyFalse :: stack
|
|
|
|
|
|
push_int : Int -> JList -> JList
|
|
push_int i stack =
|
|
JoyInt i :: stack
|
|
|
|
|
|
push_list : JList -> JList -> JList
|
|
push_list el stack =
|
|
JoyList el :: stack
|
|
|
|
|
|
push_any : JoyType -> JList -> JList
|
|
push_any j stack =
|
|
j :: stack
|
|
|
|
|
|
pop_int : JList -> Result String ( Int, JList )
|
|
pop_int stack =
|
|
pop_any stack |> andThen isnt_int
|
|
|
|
|
|
pop_list : JList -> Result String ( JList, JList )
|
|
pop_list stack =
|
|
pop_any stack |> andThen isnt_list
|
|
|
|
|
|
pop_bool : JList -> Result String ( Bool, JList )
|
|
pop_bool stack =
|
|
pop_any stack |> andThen isnt_bool
|
|
|
|
|
|
pop_any : JList -> Result String ( JoyType, JList )
|
|
pop_any stack =
|
|
case stack of
|
|
[] ->
|
|
Err "Not enough values on Stack"
|
|
|
|
item :: rest ->
|
|
Ok ( item, rest )
|
|
|
|
|
|
isnt_int : ( JoyType, JList ) -> Result String ( Int, JList )
|
|
isnt_int ( item, stack ) =
|
|
case item of
|
|
JoyInt i ->
|
|
Ok ( i, stack )
|
|
|
|
_ ->
|
|
Err "Not an integer."
|
|
|
|
|
|
isnt_list : ( JoyType, JList ) -> Result String ( JList, JList )
|
|
isnt_list ( item, stack ) =
|
|
case item of
|
|
JoyList el ->
|
|
Ok ( el, stack )
|
|
|
|
_ ->
|
|
Err "Not a list."
|
|
|
|
|
|
isnt_bool : ( JoyType, JList ) -> Result String ( Bool, JList )
|
|
isnt_bool ( item, stack ) =
|
|
case item of
|
|
JoyTrue ->
|
|
Ok ( True, stack )
|
|
|
|
JoyFalse ->
|
|
Ok ( False, stack )
|
|
|
|
_ ->
|
|
Err "Not a Boolean value."
|
|
|
|
|
|
|
|
-- Printer
|
|
|
|
|
|
joyTermToString : JoyType -> String
|
|
joyTermToString term =
|
|
case term of
|
|
JoySymbol name ->
|
|
name
|
|
|
|
JoyInt n ->
|
|
String.fromInt n
|
|
|
|
JoyTrue ->
|
|
"true"
|
|
|
|
JoyFalse ->
|
|
"false"
|
|
|
|
JoyList list ->
|
|
"[" ++ joyExpressionToString list ++ "]"
|
|
|
|
|
|
joyExpressionToString expr =
|
|
String.join " " (List.map joyTermToString expr)
|
|
|
|
|
|
|
|
-- Use the old S-expression lexing trick.
|
|
|
|
|
|
tokenize : String -> List String
|
|
tokenize text =
|
|
words (replace "[" " [ " (replace "]" " ] " text))
|
|
|
|
|
|
tokenator : String -> JoyType
|
|
tokenator tok =
|
|
case tok of
|
|
"true" ->
|
|
JoyTrue
|
|
|
|
"false" ->
|
|
JoyFalse
|
|
|
|
_ ->
|
|
case String.toInt tok of
|
|
Just i ->
|
|
JoyInt i
|
|
|
|
Nothing ->
|
|
JoySymbol tok
|
|
|
|
|
|
|
|
-- I don't like this because it won't reject "[" and "]"
|
|
-- instead turning them into symbols!
|
|
|
|
|
|
expect_right_bracket : List String -> JList -> Result String ( JList, List String )
|
|
expect_right_bracket tokens acc =
|
|
case tokens of
|
|
[] ->
|
|
Err "Missing closing bracket."
|
|
|
|
h :: t ->
|
|
expect_right_bracket_one_token_lookahead h t acc
|
|
|
|
|
|
expect_right_bracket_one_token_lookahead : String -> List String -> JList -> Result String ( JList, List String )
|
|
expect_right_bracket_one_token_lookahead token tokens acc =
|
|
case token of
|
|
"]" ->
|
|
Ok ( acc, tokens )
|
|
|
|
"[" ->
|
|
-- (* extract the sub-list *)
|
|
case expect_right_bracket tokens [] of
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Ok ( sub_list, rest ) ->
|
|
-- (* continue looking for the expected "]" *)
|
|
case expect_right_bracket rest acc of
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Ok ( el, rrest ) ->
|
|
Ok ( JoyList sub_list :: el, rrest )
|
|
|
|
_ ->
|
|
case expect_right_bracket tokens acc of
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Ok ( el, rest ) ->
|
|
Ok ( tokenator token :: el, rest )
|
|
|
|
|
|
|
|
---(* token -> token list -> joy_type * token list *)
|
|
|
|
|
|
one_token_lookahead : String -> List String -> Result String ( JoyType, List String )
|
|
one_token_lookahead token tokens =
|
|
case token of
|
|
"]" ->
|
|
Err "Extra closing bracket."
|
|
|
|
"[" ->
|
|
case expect_right_bracket tokens [] of
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Ok ( list_term, rest_of_tokens ) ->
|
|
Ok ( JoyList list_term, rest_of_tokens )
|
|
|
|
_ ->
|
|
Ok ( tokenator token, tokens )
|
|
|
|
|
|
parse0 : List String -> JList -> Result String JList
|
|
parse0 tokens acc =
|
|
case tokens of
|
|
[] ->
|
|
Ok acc
|
|
|
|
token :: tokens_tail ->
|
|
case one_token_lookahead token tokens_tail of
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Ok ( term, rest_of_tokens ) ->
|
|
case parse0 rest_of_tokens acc of
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Ok terms ->
|
|
Ok (term :: terms)
|
|
|
|
|
|
parse tokens =
|
|
parse0 tokens []
|
|
|
|
|
|
text_to_expression text =
|
|
parse (tokenize text)
|
|
|
|
|
|
doit : String -> JoyDict -> Result String ( String, JoyDict )
|
|
doit text dict =
|
|
case text_to_expression text of
|
|
Ok ast ->
|
|
case joy [] ast dict of
|
|
Ok ( expr, dict0 ) ->
|
|
Ok ( joyExpressionToString expr, dict0 )
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
Err msg ->
|
|
Err msg
|
|
|
|
|
|
add_def : String -> JoyDict -> JoyDict
|
|
add_def def dict =
|
|
case text_to_expression def of
|
|
Err msg ->
|
|
dict
|
|
|
|
Ok expr ->
|
|
case expr of
|
|
[] ->
|
|
dict
|
|
|
|
sym :: body ->
|
|
-- check that name is a symbol
|
|
case sym of
|
|
JoySymbol name ->
|
|
insert name body dict
|
|
|
|
_ ->
|
|
dict
|
|
|
|
|
|
initialize : JoyDict -> JoyDict
|
|
initialize dict =
|
|
List.foldl add_def dict (lines """eq [false] [true] [false] cmp
|
|
gt [true] [false] [false] cmp
|
|
lt [false] [false] [true] cmp
|
|
neq [true] [false] [true] cmp
|
|
le [false] [true] [true] cmp
|
|
ge [true] [true] [false] cmp
|
|
-- 1 -
|
|
? dup bool
|
|
and nulco [nullary [false]] dip branch
|
|
++ 1 +
|
|
or nulco [nullary] dip [true] branch
|
|
!- 0 >=
|
|
<{} [] swap
|
|
<<{} [] rollup
|
|
abs dup 0 < [] [neg] branch
|
|
anamorphism [pop []] swap [dip swons] genrec
|
|
app1 grba infrst
|
|
app2 [grba swap grba swap] dip [infrst] cons ii
|
|
app3 3 appN
|
|
appN [grabN] codi map reverse disenstacken
|
|
at drop first
|
|
average [sum] [size] cleave /
|
|
b [i] dip i
|
|
binary unary popd
|
|
ccccons ccons ccons
|
|
ccons cons cons
|
|
clear [] swaack pop
|
|
cleave fork popdd
|
|
clop cleave popdd
|
|
cmp [[>] swap] dipd [ifte] ccons [=] swons ifte
|
|
codi cons dip
|
|
codireco codi reco
|
|
dinfrirst dip infrst
|
|
dipd [dip] codi
|
|
disenstacken swaack pop
|
|
divmod [/] [%] clop
|
|
down_to_zero [0 >] [dup --] while
|
|
drop [rest] times
|
|
dupd [dup] dip
|
|
dupdd [dup] dipd
|
|
dupdip dupd dip
|
|
dupdipd dup dipd
|
|
enstacken stack [clear] dip
|
|
first uncons pop
|
|
flatten <{} [concat] step
|
|
fork [i] app2
|
|
fourth rest third
|
|
gcd true [tuck mod dup 0 >] loop pop
|
|
genrec [[genrec] ccccons] nullary swons concat ifte
|
|
grabN <{} [cons] times
|
|
grba [stack popd] dip
|
|
hypot [sqr] ii + sqrt
|
|
ifte [nullary] dipd swap branch
|
|
ii [dip] dupdip i
|
|
infra swons swaack [i] dip swaack
|
|
infrst infra first
|
|
make_generator [codireco] ccons
|
|
mod %
|
|
neg 0 swap -
|
|
not [true] [false] branch
|
|
nulco [nullary] cons
|
|
null [] concat bool not
|
|
nullary [stack] dinfrirst
|
|
of swap at
|
|
pam [i] map
|
|
pm [+] [-] clop
|
|
popd [pop] dip
|
|
popdd [pop] dipd
|
|
popop pop pop
|
|
popopop pop popop
|
|
popopd [popop] dip
|
|
popopdd [popop] dipd
|
|
product 1 swap [*] step
|
|
quoted [unit] dip
|
|
range [0 <=] [-- dup] anamorphism
|
|
range_to_zero unit [down_to_zero] infra
|
|
reco rest cons
|
|
rest uncons popd
|
|
reverse <{} shunt
|
|
roll> swap swapd
|
|
roll< swapd swap
|
|
rollup roll>
|
|
rolldown roll<
|
|
rrest rest rest
|
|
run <{} infra
|
|
second rest first
|
|
shift uncons [swons] dip
|
|
shunt [swons] step
|
|
size [pop ++] step_zero
|
|
small dup null [rest null] [pop true] branch
|
|
spiral_next [[[abs] ii <=] [[<>] [pop !-] or] and] [[!-] [[++]] [[--]] ifte dip] [[pop !-] [--] [++] ifte] ifte
|
|
split_at [drop] [take] clop
|
|
split_list [take reverse] [drop] clop
|
|
sqr dup mul
|
|
stackd [stack] dip
|
|
step_zero 0 roll> step
|
|
stuncons stack uncons
|
|
sum [+] step_zero
|
|
swapd [swap] dip
|
|
swons swap cons
|
|
swoncat swap concat
|
|
tailrec [i] genrec
|
|
take <<{} [shift] times pop
|
|
ternary binary popd
|
|
third rest second
|
|
tuck dup swapd
|
|
unary nullary popd
|
|
uncons [first] [rest] cleave
|
|
unit [] cons
|
|
unquoted [i] dip
|
|
unstack [[] swaack] dip swoncat swaack pop
|
|
unswons uncons swap
|
|
while swap nulco dupdipd concat loop
|
|
x dup i
|
|
step [_step0] x
|
|
_step0 _step1 [popopop] [_stept] branch
|
|
_step1 [?] dipd roll<
|
|
_stept [uncons] dipd [dupdipd] dip x
|
|
times [_times0] x
|
|
_times0 _times1 [popopop] [_timest] branch
|
|
_times1 [dup 0 >] dipd roll<
|
|
_timest [[--] dip dupdipd] dip x
|
|
map [_map0] cons [[] [_map?] [_mape]] dip tailrec
|
|
_map? pop bool not
|
|
_mape popd reverse
|
|
_map0 [_map1] dipd _map2
|
|
_map1 stackd shift
|
|
_map2 [infrst] cons dipd roll< swons
|
|
_\\/_ [not not] [not] branch
|
|
/\\ [not not] ii [pop false] [] branch
|
|
\\/ [not not] ii [] [pop true] branch""")
|