shithub: sl

Info  •  Files  •  Log  •  Branches

make string types, procedure? and top-level-bound? constants

Also display a warning if boot image tries to redefine
a symbol.

--- a/boot/flisp.boot

+++ b/boot/flisp.boot

@@ -20,7 +20,6 @@

 										 decompressed-bytes))  void? ((x))  >= ((a . rest))  rand-uint64 (nil)  help ((term))  length= ((lst

   n))  = ((a . rest))  car ((lst))  <= ((a . rest))  rand-uint32 (nil)  /= ((a . rest))  void (rest)  lz-pack ((data

   (level 0)))  rand (nil)  nan? ((x))  rand-float (nil)  cons? ((value))  vm-stats (nil)  * ((number…))  rand-double (nil)  cdr ((lst))  + ((number…))  > ((a . rest)))  *doc* #table(>= "Return #t if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)."  void? "Return #t if x is #<void> and #f otherwise."  length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates."  car "Returns the first element of a list or nil if not available."  *builtins* "VM instructions as closures."  <= "Return #t if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)."  void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though #t or nil could\nbe returned instead, in case of #<void> alone, REPL will not print\nit."  rand "Return a random non-negative fixnum on its maximum range."  nan? "Return #t if the argument is NaN, regardless of the sign."  Instructions "VM instructions mapped to their encoded byte representation."  rand-double "Return a random double on [0.0, 1.0] interval."  > "Return #t if the arguments are in strictly decreasing order (previous\none is greater than the next one)."  cdr "Returns the tail of a list or nil if not available."  + "Return sum of the numbers or 0 with no arguments."  lz-unpack "Return decompressed data previously compressed using lz-pack.\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified.  In the latter case a new\narray is allocated."  rand-uint64 "Return a random integer on [0, 2⁶⁴-1] interval."  help "Display documentation for the specified term, if available."  = "Return #t if the arguments are equal."  rand-uint32 "Return a random integer on [0, 2³²-1] interval."  /= "Return #t if not all arguments are equal. Shorthand for (not (= …))."  lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10.  With level 0 a simple LZSS\nusing hashing will be performed.  Levels between 1 and 9 offer a\ntrade-off between time/space and ratio.  Level 10 is optimal but very\nslow."  rand-float "Return a random float on [0.0, 1.0] interval."  arg-counts "VM instructions mapped to their expected arguments count."  *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"."  cons? "Returns #t if the value is a cons cell."  vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc."  * "Return product of the numbers or 1 with no arguments."  *properties* "All properties of symbols recorded with putprop are recorded in this table."))

-	    *runestring-type* (array rune) *string-type* (array byte)

 	    *syntax-environment* #table(bcode:nconst #fn("7000n1200r2e3:" #(aref))  doc-for #fn("@000\x8710002000\x881000I60O?140B;35040<;I40402086510B;35040=88II087\\3?07122862353@30O@F087\\360O@<071228624534252686e2261e22688e2e4:" #(#fn(top-level-value)

   error "docs: " ": no funvars specified" ": funvars set but isn't a function" symbol-set-doc quote))  with-input-from #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)

   with-bindings *input-stream* #fn(copy-list)))  unless #fn("<000z1200O211Pe4:" #(if begin))  time #fn("=000n1202122e1e2e123024252622e121e32728e5e3e3:" #(let

@@ -352,10 +351,10 @@

 							      #fn(write)

 							      #fn(iostream->string)) print-to-string)

 	    printable? #fn("6000n120051;IB0471051;I80422051S:" #(#fn(iostream?) void? #fn(eof-object?)) printable?)

-	    procedure? #.function? putprop

-	    #fn(";000n320711O5387360O@F02250237118853488?7^14238708253482:" #(#fn(get) *properties*

-									      #fn(table)

-									      #fn(put!)) putprop)

+	    putprop #fn(";000n320711O5387360O@F02250237118853488?7^14238708253482:" #(#fn(get)

+										      *properties*

+										      #fn(table)

+										      #fn(put!)) putprop)

 	    quote-value #fn("6000n1700513400:210e2:" #(self-evaluating? quote) quote-value) quoted?

 	    #fn("6000n10<20Q:" #(quote) quoted?) random #fn("7000n1200513<0712250062:23500i2:" #(#fn(integer?)

   mod #fn(rand) #fn(rand-double)) random)

@@ -421,12 +420,10 @@

 	    table-values #fn("8000n12021q063:" #(#fn(table-foldl)

 						 #fn("6000n3182P:" #())) table-values)

 	    to-proper #fn("7000n10J400:0H3600e1:0<700=51P:" #(to-proper) to-proper)

-	    top-level-bound? #.bound? top-level-exception-handler

-	    #fn("9000n17071w042285>1230>12486>1{86504:" #(*output-stream* *stderr* #fn("5000n0Aw0:" #(*output-stream*))

-							  #fn("6000n070A51471225061:" #(print-exception

-											print-stack-trace

-											#fn(stacktrace)))

-							  #fn("6000n1A50420061:" #(#fn(raise)))) top-level-exception-handler)

+	    top-level-exception-handler #fn("9000n17071w042285>1230>12486>1{86504:" #(*output-stream*

+										      *stderr* #fn("5000n0Aw0:" #(*output-stream*))

+										      #fn("6000n070A51471225061:" #(print-exception

+  print-stack-trace #fn(stacktrace))) #fn("6000n1A50420061:" #(#fn(raise)))) top-level-exception-handler)

 	    trace #fn("@000n120051718551Ig0220732425262728290e225e3e22:e12;2985e225e3e4e35152@30O^147<60:" #(#fn(top-level-value)

   traced? #fn(set-top-level-value!) eval λ #:g356 begin write cons quote newline apply void) trace)

 	    traced? #fn("7000n170051;3?042105121A<51d:" #(closure? #fn(function:code)) #((#fn("9000z020210P51472504230}2:" #(#fn(write)

binary files a/boot/flisp.boot.builtin b/boot/flisp.boot.builtin differ

--- a/src/cvalues.c

+++ b/src/cvalues.c

@@ -1351,10 +1351,10 @@

 	ctor_cv_intern(array, NONNUMERIC, int);

 	FL_stringtypesym = symbol("*string-type*", false);

-	set(FL_stringtypesym, fl_list2(FL_arraysym, FL_bytesym));

+	setc(FL_stringtypesym, fl_list2(FL_arraysym, FL_bytesym));

 	FL_runestringtypesym = symbol("*runestring-type*", false);

-	set(FL_runestringtypesym, fl_list2(FL_arraysym, FL_runesym));

+	setc(FL_runestringtypesym, fl_list2(FL_arraysym, FL_runesym));

 	mk_primtype(int8, int8_t);

 	mk_primtype(uint8, uint8_t);

--- a/src/flisp.c

+++ b/src/flisp.c

@@ -1373,8 +1373,8 @@

 		if(builtins[i].name)

 			set(symbol(builtins[i].name, false), builtin(i));

 	}

-	set(symbol("procedure?", false), builtin(OP_FUNCTIONP));

-	set(symbol("top-level-bound?", false), builtin(OP_BOUNDP));

+	setc(symbol("procedure?", false), builtin(OP_FUNCTIONP));

+	setc(symbol("top-level-bound?", false), builtin(OP_BOUNDP));

 	FL(the_empty_vector) = tagptr(alloc_words(1), TAG_VECTOR);

 	vector_setsize(FL(the_empty_vector), 0);

@@ -1428,7 +1428,8 @@

 				while(iscons(e)){

 					sym = tosymbol(car_(e));

 					e = cdr_(e);

-					(void)tocons(e);

+					if(sym->binding != UNBOUND)

+						ios_printf(ios_stderr, "%s redefined on boot\n", sym->name);

 					sym->binding = car_(e);

 					e = cdr_(e);

 				}