Author: bernhard
Date: Sun May 13 03:41:37 2007
New Revision: 18521
Modified:
trunk/languages/lisp/cl.pir
trunk/languages/lisp/lisp.pir
trunk/languages/lisp/types.pir
Log:
#42885: Resurrect languages/lisp
'typeof' nowadays throws exception on PMCNULL, so check with 'unless_null'.
Use 4 char indention for some sub's.
Move the 'includes' to the top of lisp.pir
Modified: trunk/languages/lisp/cl.pir
==============================================================================
--- trunk/languages/lisp/cl.pir (original)
+++ trunk/languages/lisp/cl.pir Sun May 13 03:41:37 2007
@@ -16,12 +16,12 @@
store_global "PACKAGES", "COMMON-LISP", package
store_global "PACKAGES", "CL", package
- t = package._intern_symbol("T") # Create the T symbol
+ t = package._intern_symbol("T") # Create the T symbol,
T meaning true
t._set_value(t)
t._set_package(package)
t._set_special(t)
- store_global "SYMBOLS", "T", t # Quick alias to T
+ store_global "SYMBOLS", "T", t # Quick alias to T, T
meaning true
t = symbol
symbol = package._intern_symbol("NIL") # Create the T symbol
Modified: trunk/languages/lisp/lisp.pir
==============================================================================
--- trunk/languages/lisp/lisp.pir (original)
+++ trunk/languages/lisp/lisp.pir Sun May 13 03:41:37 2007
@@ -10,16 +10,33 @@
.include "include/macros.pir"
+.include "library/dumper.pir"
+
+.include "types.pir"
+.include "read.pir"
+.include "eval.pir"
+.include "system.pir"
+.include "validate.pir"
+.include "cl.pir"
+.include "internals.pir"
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
.sub _main :main
- .param pmc argv
- .local string names
- .local pmc symbol
- .local pmc stream
- .local pmc name
- .local pmc args
- .local pmc retv
- .local int argc
- .local int res
+ .param pmc argv
+
+ .local string names
+ .local pmc symbol
+ .local pmc stream
+ .local pmc name
+ .local pmc args
+ .local pmc retv
+ .local int argc
+ .local int res
load_bytecode "PGE.pbc" # Parrot Grammar engine
@@ -41,99 +58,85 @@
is_qualified = p6rule(
"^<[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789]>*::<[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789]>*"
)
set_global 'is_qualified', is_qualified
- _init_types() # Initialize all the type classes.
+ _init_types() # Initialize all the type classes.
- _init_cl() # Initialize the built-in functions in
- _init_system() # the SYSTEM and COMMON-LISP packages.
+ _init_cl() # Initialize the built-in functions in
+ _init_system() # the SYSTEM and COMMON-LISP packages.
# VALID_IN_PARROT_0_2_0 new_pad 0 # Create the
null lexical environment.
- .STRING(name, "lisp/bootstrap.l") # Load the lisp bootstrap file.
- .LIST_1(args, name)
- _load(args)
+ .STRING(name, "lisp/bootstrap.l") # Load the lisp bootstrap file.
+ .LIST_1(args, name)
+ _load(args)
- argc = argv
+ argc = argv
- if argc <= 1 goto READ_STDIN # Check if we should read STDIN
or load from file
+ if argc <= 1 goto READ_STDIN # Check if we should read STDIN
or load from file
- names = argv[1] # Get the file name
- .STRING(name, names)
+ names = argv[1] # Get the file name
+ .STRING(name, names)
- .LIST_1(args, name)
- retv = _load(args) # Load the specified file.
+ .LIST_1(args, name)
+ retv = _load(args) # Load the specified file.
- end
+ end
READ_STDIN:
- symbol = _LOOKUP_GLOBAL("COMMON-LISP", "*STANDARD-INPUT*")
- stream = symbol._get_value()
+ symbol = _LOOKUP_GLOBAL("COMMON-LISP", "*STANDARD-INPUT*")
+ stream = symbol._get_value()
- push_eh DEBUGGER # Setup error handler for debug loop.
+ push_eh DEBUGGER # Setup error handler for debug loop.
REP_LOOP:
- print "-> " # Display the top level prompt.
+ print "-> " # Display the top level prompt.
- .LIST_1(args, stream) # Read!
- retv = _read(args)
+ .LIST_1(args, stream) # Read!
+ retv = _read(args)
- .LIST_1(args, retv) # Eval!
- # VALID_IN_PARROT_0_2_0 retv = _eval(args)
+ .LIST_1(args, retv) # Eval!
+ # VALID_IN_PARROT_0_2_0 retv = _eval(args)
- # VALID_IN_PARROT_0_2_0 foldup retv
- ( retv :slurpy) = _eval(args)
+ # VALID_IN_PARROT_0_2_0 foldup retv
+ ( retv :slurpy) = _eval(args)
- .local int nretv
- nretv = retv
+ .local int nretv
+ nretv = retv
- .local pmc tmpval
- .local int i
- i = 0
+ .local pmc tmpval
+ .local int i
+ i = 0
PRINT_LOOP:
- tmpval = retv[i]
+ tmpval = retv[i]
- print tmpval
+ print tmpval
- inc i
- if i == nretv goto PRINT_DONE
+ inc i
+ if i == nretv goto PRINT_DONE
- print " ;\n"
+ print " ;\n"
- goto PRINT_LOOP
+ goto PRINT_LOOP
PRINT_DONE:
- print "\n"
+ print "\n"
- goto REP_LOOP
+ goto REP_LOOP
DEBUGGER:
- .local string message
- .local string msgtype
- .local pmc e
+ .local string message
+ .local string msgtype
+ .local pmc e
- e = P5
+ e = P5
- message = e["_message"]
+ message = e["_message"]
- print "*** ERROR: "
- print message
- print "\n"
+ print "*** ERROR: "
+ print message
+ print "\n"
- push_eh DEBUGGER
+ push_eh DEBUGGER
- goto REP_LOOP
+ goto REP_LOOP
.end
-
-.include "types.pir"
-.include "read.pir"
-.include "eval.pir"
-.include "system.pir"
-.include "validate.pir"
-.include "cl.pir"
-.include "internals.pir"
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Modified: trunk/languages/lisp/types.pir
==============================================================================
--- trunk/languages/lisp/types.pir (original)
+++ trunk/languages/lisp/types.pir Sun May 13 03:41:37 2007
@@ -377,36 +377,35 @@
.end
.sub _intern_symbol :method
- .param string name
- .local string type
- .local pmc symbol
- .local pmc status
- .local pmc stack
- .local pmc hash
- .local int top
+ .param string name
- getattribute hash, self, "LispPackage\0internal"
- stack = hash[name]
+ # the attribute internal has been set up in _init_types
+ .local pmc internal
+ getattribute internal, self, "LispPackage\0internal"
+
+ # stack for the name is not known to exist
+ .local pmc stack
+ stack = internal[name]
+ unless_null stack, RETURN_SYMBOL
+ # _dumper( self, "self" )
+ # _dumper( name, "name" )
+ # _dumper( internal, "internal" )
+ # _dumper( stack, "stack" )
+
+ .local pmc new_symbol
+ new_symbol = _SYMBOL(name)
+
+ stack = new ResizablePMCArray
+ push stack, new_symbol
+ internal[name] = stack
+
+ goto RETURN_SYMBOL
+
+RETURN_SYMBOL:
+ .local pmc symbol
+ symbol = stack[-1]
- typeof type, stack
- if type != "None" goto DONE
-
- symbol = _SYMBOL(name)
-
- stack = new ResizablePMCArray
- push stack, symbol
-
- hash[name] = stack
-
- goto DONE
-
-DONE:
- top = stack
- top = top - 1
-
- symbol = stack[top]
-
- .return(symbol)
+ .return(symbol)
.end
.sub _get_name :method
