mirror of
https://github.com/kanaka/mal.git
synced 2024-09-20 01:57:09 +03:00
225 lines
6.4 KiB
Plaintext
225 lines
6.4 KiB
Plaintext
(module $step2_eval
|
|
|
|
(global $repl_env (mut i32) (i32.const 0))
|
|
|
|
;; READ
|
|
(func $READ (param $str i32) (result i32)
|
|
($read_str $str)
|
|
)
|
|
|
|
;; EVAL
|
|
(func $EVAL_AST (param $ast i32 $env i32) (result i32)
|
|
;; Return a list/vector/map with evaluated elements
|
|
;; of a list, vector or hashmap $ast
|
|
(LET $res 0 $val2 0 $val3 0 $type 0
|
|
$ret 0 $empty 0 $current 0)
|
|
|
|
(if (global.get $error_type) (return 0))
|
|
(local.set $type ($TYPE $ast))
|
|
|
|
;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast)
|
|
|
|
;; MAP_LOOP_START
|
|
(local.set $res ($MAP_LOOP_START $type))
|
|
;; push MAP_LOOP stack
|
|
;;; empty = current = ret = res
|
|
(local.set $ret $res)
|
|
(local.set $current $res)
|
|
(local.set $empty $res)
|
|
|
|
(loop $loop
|
|
;; check if we are done evaluating the source sequence
|
|
(if (i32.eqz ($VAL0 $ast))
|
|
(then
|
|
(return $ret)))
|
|
|
|
(if (i32.eq $type (global.get $HASHMAP_T))
|
|
(then
|
|
(local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env)))
|
|
(else
|
|
(local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env))))
|
|
(local.set $val2 $res)
|
|
|
|
;; if error, release the unattached element
|
|
(if (global.get $error_type)
|
|
(then
|
|
($RELEASE $res)
|
|
(return 0)))
|
|
|
|
;; for hash-maps, copy the key (inc ref since we are going
|
|
;; to release it below)
|
|
(if (i32.eq $type (global.get $HASHMAP_T))
|
|
(then
|
|
(local.set $val3 $val2)
|
|
(local.set $val2 ($MEM_VAL1_ptr $ast))
|
|
(drop ($INC_REF $val2))))
|
|
|
|
;; MAP_LOOP_UPDATE
|
|
(local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3))
|
|
(if (i32.le_u $current (global.get $EMPTY_HASHMAP))
|
|
;; if first element, set return to new element
|
|
(local.set $ret $res))
|
|
;; update current to point to new element
|
|
(local.set $current $res)
|
|
|
|
(local.set $ast ($MEM_VAL0_ptr $ast))
|
|
|
|
(br $loop)
|
|
)
|
|
;; MAP_LOOP_DONE
|
|
)
|
|
|
|
(type $fnT (func (param i32) (result i32)))
|
|
|
|
(table funcref
|
|
(elem
|
|
$add $subtract $multiply $divide))
|
|
|
|
(func $EVAL (param $ast i32 $env i32) (result i32)
|
|
(local $res2 i64)
|
|
(LET $res 0
|
|
$ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 $found 0)
|
|
|
|
(if (global.get $error_type) (return 0))
|
|
|
|
;;($PR_VALUE "EVAL: %s\n" $ast)
|
|
|
|
(local.set $ast_type ($TYPE $ast))
|
|
|
|
(if (i32.eq $ast_type (global.get $SYMBOL_T))
|
|
(then
|
|
(local.set $res2 ($HASHMAP_GET $env $ast))
|
|
(local.set $res (i32.wrap_i64 $res2))
|
|
(local.set $found (i32.wrap_i64 (i64.shr_u $res2
|
|
(i64.const 32))))
|
|
(if (i32.eqz $found)
|
|
($THROW_STR_1 "'%s' not found"
|
|
($to_String $ast)))
|
|
(return ($INC_REF $res))))
|
|
|
|
(if (OR (i32.eq $ast_type (global.get $VECTOR_T))
|
|
(i32.eq $ast_type (global.get $HASHMAP_T)))
|
|
(then
|
|
(return ($EVAL_AST $ast $env))))
|
|
|
|
(if (OR (i32.ne $ast_type (global.get $LIST_T))
|
|
($EMPTY_Q $ast))
|
|
(then
|
|
(return ($INC_REF $ast))))
|
|
|
|
;; APPLY_LIST
|
|
|
|
;; EVAL_INVOKE
|
|
|
|
(local.set $res ($EVAL_AST $ast $env))
|
|
(local.set $f_args $res)
|
|
|
|
;; if error, return f/args for release by caller
|
|
(if (global.get $error_type)
|
|
(return $f_args))
|
|
|
|
(local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest
|
|
(local.set $f ($MEM_VAL1_ptr $f_args)) ;; value
|
|
|
|
(local.set $ftype ($TYPE $f))
|
|
(if (i32.eq $ftype (global.get $FUNCTION_T))
|
|
(then
|
|
(local.set $res (call_indirect (type $fnT) $args ($VAL0 $f)))
|
|
($RELEASE $f_args)
|
|
(return $res))
|
|
)
|
|
|
|
($THROW_STR_1 "apply of non-function type: %d\n" $ftype)
|
|
($RELEASE $f_args)
|
|
(return 0)
|
|
)
|
|
|
|
;; PRINT
|
|
(func $PRINT (param $ast i32) (result i32)
|
|
($pr_str $ast 1)
|
|
)
|
|
|
|
;; REPL
|
|
(func $REP (param $line i32 $env i32) (result i32)
|
|
(LET $mv1 0 $mv2 0 $ms 0)
|
|
(block $done
|
|
(local.set $mv1 ($READ $line))
|
|
(br_if $done (global.get $error_type))
|
|
|
|
(local.set $mv2 ($EVAL $mv1 $env))
|
|
(br_if $done (global.get $error_type))
|
|
|
|
;; ($PR_MEMORY -1 -1)
|
|
(local.set $ms ($PRINT $mv2))
|
|
)
|
|
|
|
;; release memory from MAL_READ and EVAL
|
|
($RELEASE $mv2)
|
|
($RELEASE $mv1)
|
|
$ms
|
|
)
|
|
|
|
(func $add (param $args i32) (result i32)
|
|
($INTEGER
|
|
(i32.add ($VAL0 ($MEM_VAL1_ptr $args))
|
|
($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
|
|
(func $subtract (param $args i32) (result i32)
|
|
($INTEGER
|
|
(i32.sub ($VAL0 ($MEM_VAL1_ptr $args))
|
|
($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
|
|
(func $multiply (param $args i32) (result i32)
|
|
($INTEGER
|
|
(i32.mul ($VAL0 ($MEM_VAL1_ptr $args))
|
|
($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
|
|
(func $divide (param $args i32) (result i32)
|
|
($INTEGER
|
|
(i32.div_s ($VAL0 ($MEM_VAL1_ptr $args))
|
|
($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
|
|
|
|
(func $main (param $argc i32 $argv i32) (result i32)
|
|
(LET $line (STATIC_ARRAY 201)
|
|
$res 0 $repl_env 0)
|
|
|
|
;; DEBUG
|
|
;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase))
|
|
;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start))
|
|
;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end))
|
|
;; ($printf_1 "mem: 0x%x\n" (global.get $mem))
|
|
;; ($printf_1 "string_mem: %d\n" (global.get $string_mem))
|
|
|
|
(global.set $repl_env ($HASHMAP))
|
|
(local.set $repl_env (global.get $repl_env))
|
|
|
|
(local.set $repl_env ($ASSOC1_S $repl_env "+" ($FUNCTION 0)))
|
|
(local.set $repl_env ($ASSOC1_S $repl_env "-" ($FUNCTION 1)))
|
|
(local.set $repl_env ($ASSOC1_S $repl_env "*" ($FUNCTION 2)))
|
|
(local.set $repl_env ($ASSOC1_S $repl_env "/" ($FUNCTION 3)))
|
|
|
|
;;($PR_MEMORY -1 -1)
|
|
|
|
;; Start REPL
|
|
(block $repl_done
|
|
(loop $repl_loop
|
|
(br_if $repl_done (i32.eqz ($readline "user> " $line)))
|
|
(br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
|
|
(local.set $res ($REP $line $repl_env))
|
|
(if (global.get $error_type)
|
|
(then
|
|
($printf_1 "Error: %s\n" (global.get $error_str))
|
|
(global.set $error_type 0))
|
|
(else
|
|
($printf_1 "%s\n" ($to_String $res))))
|
|
($RELEASE $res)
|
|
;;($PR_MEMORY_SUMMARY_SMALL)
|
|
(br $repl_loop)
|
|
)
|
|
)
|
|
|
|
($print "\n")
|
|
;;($PR_MEMORY -1 -1)
|
|
0
|
|
)
|
|
|
|
)
|
|
|