Ekdohibs/camlboot
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Names for primitives

Browse Source
This commit is contained in:
Nathanaël Courant 2021-01-11 10:20:58 +01:00
parent c80b7ee60f
commit 899bd1b913
2 changed files with 53 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
miniml/compiler/compile.scm
View File

@ -1023,15 +1023,54 @@
(define (slot-for-global) (newglob 0))
(define (bytecode-write-globals)
(bytecode-marshal (cons 0 (reverse globs))))
(define known-prims (list
(cons "%raise" "%91")
(cons "%equal" "caml_equal")
(cons "%notequal" "caml_notequal")
(cons "%lessthan" "caml_lessthan")
(cons "%greaterthan" "caml_greaterthan")
(cons "%lessequal" "caml_lessequal")
(cons "%greaterequal" "caml_greaterequal")
(cons "%compare" "caml_compare")
(cons "%eq" "%121")
(cons "%noteq" "%122")
(cons "%negint" "%109")
; (cons "%succint" "")
; (cons "%predint" "")
(cons "%addint" "%110")
(cons "%subint" "%111")
(cons "%mulint" "%112")
(cons "%divint" "%113")
(cons "%modint" "%114")
(cons "%andint" "%115")
(cons "%orint" "%116")
(cons "%xorint" "%117")
(cons "%lslint" "%118")
(cons "%lsrint" "%119")
(cons "%asrint" "%120")
(cons "%string_length" "caml_ml_bytes_length")
(cons "%bytes_length" "caml_ml_bytes_length")
; (cons "%identity" "")
; (cons "%ignore" "")
(cons "%field0" "%67")
(cons "%field1" "%68")
(cons "%setfield0" "%73")
))
(define prims #nil)
(define nprims 0)
(define (prim name)
(define (raw-prim name)
(if (equal? (string-ref name 0) #\%)
(cons 'Internal (string->number (substring name 1)))
(begin
(set! prims (cons name prims))
(set! nprims (+ 1 nprims))
(cons 'C (- nprims 1)))))
(define (prim name)
(let ((p (assoc name known-prims)))
(raw-prim (if (pair? p) (cdr p) name))
))
(define (bytecode-write-prims)
(for-each (lambda (name) (begin (bytecode-put-string name) (bytecode-put-u8 0))) (reverse prims)))

26
miniml/compiler/test/lib.ml
View File

@ -4,25 +4,25 @@ external caml_ml_output : out_channel -> string -> int -> int -> unit = "caml_ml
external caml_ml_flush : out_channel -> unit = "caml_ml_flush"
external caml_ml_bytes_length : string -> int = "caml_ml_bytes_length"
external format_int : string -> int -> string = "caml_format_int"
external ( ~- ) : int -> int = "%109"
external ( + ) : int -> int -> int = "%110"
external ( - ) : int -> int -> int = "%111"
external ( * ) : int -> int -> int = "%112"
external ( / ) : int -> int -> int = "%113"
external ( mod ) : int -> int -> int = "%114"
external ( land ) : int -> int -> int = "%115"
external ( lor ) : int -> int -> int = "%116"
external ( lxor ) : int -> int -> int = "%117"
external ( lsl ) : int -> int -> int = "%118"
external ( lsr ) : int -> int -> int = "%119"
external ( asr ) : int -> int -> int = "%120"
external ( ~- ) : int -> int = "%negint"
external ( + ) : int -> int -> int = "%addint"
external ( - ) : int -> int -> int = "%subint"
external ( * ) : int -> int -> int = "%mulint"
external ( / ) : int -> int -> int = "%divint"
external ( mod ) : int -> int -> int = "%modint"
external ( land ) : int -> int -> int = "%andint"
external ( lor ) : int -> int -> int = "%orint"
external ( lxor ) : int -> int -> int = "%xorint"
external ( lsl ) : int -> int -> int = "%lslint"
external ( lsr ) : int -> int -> int = "%lsrint"
external ( asr ) : int -> int -> int = "%asrint"
external ( = ) : 'a -> 'a -> bool = "caml_equal"
external ( <> ) : 'a -> 'a -> bool = "caml_notequal"
external ( > ) : 'a -> 'a -> bool = "caml_greaterthan"
external ( >= ) : 'a -> 'a -> bool = "caml_greaterequal"
external ( < ) : 'a -> 'a -> bool = "caml_lessthan"
external ( <= ) : 'a -> 'a -> bool = "caml_lessequal"
external raise : exn -> 'a = "%91"
external raise : exn -> 'a = "%raise"
let failwith s = raise (Failure s)
let invalid_arg s = raise (Invalid_argument s)