diff options
| author | Gabriel Dos Reis <gdr@axiomatics.org> | 2018-01-01 13:56:29 -0800 | 
|---|---|---|
| committer | Gabriel Dos Reis <gdr@axiomatics.org> | 2018-01-01 13:56:29 -0800 | 
| commit | cfaa50b1a3f9461bb96c7f871e2ac05778d25786 (patch) | |
| tree | 6a680033550d2fcf73ab3d2303ce9c9fd177f161 | |
| parent | 1612b13828475d024af2e9b565d1bbe9d937c08e (diff) | |
| download | open-axiom-cfaa50b1a3f9461bb96c7f871e2ac05778d25786.tar.gz | |
Name bracket pattern parser
and update the boot translator Lisp cache.
| -rwxr-xr-x | configure | 20 | ||||
| -rw-r--r-- | configure.ac | 4 | ||||
| -rw-r--r-- | src/boot/parser.boot | 21 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 118 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 72 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 12 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 156 | 
7 files changed, 240 insertions, 163 deletions
| @@ -1,6 +1,6 @@  #! /bin/sh  # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for OpenAxiom 1.5.0-2017-12-27. +# Generated by GNU Autoconf 2.69 for OpenAxiom 1.5.0-2018-01-01.  #  # Report bugs to <open-axiom-bugs@lists.sf.net>.  # @@ -590,8 +590,8 @@ MAKEFLAGS=  # Identity of this package.  PACKAGE_NAME='OpenAxiom'  PACKAGE_TARNAME='openaxiom' -PACKAGE_VERSION='1.5.0-2017-12-27' -PACKAGE_STRING='OpenAxiom 1.5.0-2017-12-27' +PACKAGE_VERSION='1.5.0-2018-01-01' +PACKAGE_STRING='OpenAxiom 1.5.0-2018-01-01'  PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'  PACKAGE_URL='' @@ -1421,7 +1421,7 @@ if test "$ac_init_help" = "long"; then    # Omit some internal or obsolete options to make the list less imposing.    # This message is too long to be a string in the A/UX 3.1 sh.    cat <<_ACEOF -\`configure' configures OpenAxiom 1.5.0-2017-12-27 to adapt to many kinds of systems. +\`configure' configures OpenAxiom 1.5.0-2018-01-01 to adapt to many kinds of systems.  Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1496,7 +1496,7 @@ fi  if test -n "$ac_init_help"; then    case $ac_init_help in -     short | recursive ) echo "Configuration of OpenAxiom 1.5.0-2017-12-27:";; +     short | recursive ) echo "Configuration of OpenAxiom 1.5.0-2018-01-01:";;     esac    cat <<\_ACEOF @@ -1613,7 +1613,7 @@ fi  test -n "$ac_init_help" && exit $ac_status  if $ac_init_version; then    cat <<\_ACEOF -OpenAxiom configure 1.5.0-2017-12-27 +OpenAxiom configure 1.5.0-2018-01-01  generated by GNU Autoconf 2.69  Copyright (C) 2012 Free Software Foundation, Inc. @@ -2430,7 +2430,7 @@ cat >config.log <<_ACEOF  This file contains any messages produced by compilers while  running configure, to aid debugging if configure makes a mistake. -It was created by OpenAxiom $as_me 1.5.0-2017-12-27, which was +It was created by OpenAxiom $as_me 1.5.0-2018-01-01, which was  generated by GNU Autoconf 2.69.  Invocation command line was    $ $0 $@ @@ -3449,7 +3449,7 @@ fi  # Define the identity of the package.   PACKAGE='openaxiom' - VERSION='1.5.0-2017-12-27' + VERSION='1.5.0-2018-01-01'  cat >>confdefs.h <<_ACEOF @@ -20021,7 +20021,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1  # report actual input values of CONFIG_FILES etc. instead of their  # values after options handling.  ac_log=" -This file was extended by OpenAxiom $as_me 1.5.0-2017-12-27, which was +This file was extended by OpenAxiom $as_me 1.5.0-2018-01-01, which was  generated by GNU Autoconf 2.69.  Invocation command line was    CONFIG_FILES    = $CONFIG_FILES @@ -20091,7 +20091,7 @@ _ACEOF  cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1  ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"  ac_cs_version="\\ -OpenAxiom config.status 1.5.0-2017-12-27 +OpenAxiom config.status 1.5.0-2018-01-01  configured by $0, generated by GNU Autoconf 2.69,    with options \\"\$ac_cs_config\\" diff --git a/configure.ac b/configure.ac index 8c747722..fcef5344 100644 --- a/configure.ac +++ b/configure.ac @@ -1,4 +1,4 @@ -dnl Copyright (C) 2006-2017, Gabriel Dos Reis. +dnl Copyright (C) 2006-2018, Gabriel Dos Reis.  dnl All rights reserved.  dnl  dnl Redistribution and use in source and binary forms, with or without @@ -33,7 +33,7 @@ dnl  Makefiles for building OpenAxiom interpreter, compiler, libraries, and  dnl  auxiliary tools where appropriate.  dnl -AC_INIT([OpenAxiom], [1.5.0-2017-12-27],  +AC_INIT([OpenAxiom], [1.5.0-2018-01-01],           [open-axiom-bugs@lists.sf.net])  dnl Most of the macros used in this configure.ac are defined in files diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 0b589ead..2cd2ca86 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -799,9 +799,6 @@ bpIs ps ==         bpPush(ps,bfHas(bpPop2 ps, bpPop1 ps))       true -bpBracketConstruct(ps,f)== -  bpBracket(ps,f) and bpPush(ps,bfConstruct bpPop1 ps) -   bpCompare ps ==    bpIs ps and (bpInfKey(ps,'(SHOEEQ SHOENE LT LE GT GE IN))       and bpRequire(ps,function bpIs) @@ -1122,8 +1119,13 @@ bpDConstruction ps ==  --PATTERN  bpPattern ps == -  bpBracketConstruct(ps,function bpPatternL) -    or bpChar ps or bpName ps or bpConstTok ps +  bpBracketPattern ps +    or bpChar ps +      or bpName ps +        or bpConstTok ps + +bpBracketPattern ps == +  bpBracket(ps,function bpPatternL) and bpPush(ps,bfConstruct bpPop1 ps)  bpEqual ps ==     bpEqKey(ps,"SHOEEQ") and (bpApplication ps or bpConstTok ps or @@ -1135,7 +1137,7 @@ bpRegularPatternItem ps ==        bpName ps and          ((bpEqKey(ps,"BEC") and bpRequire(ps,function bpPattern)             and bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps))) or true) -               or bpBracketConstruct(ps,function bpPatternL) +               or bpBracketPattern ps  bpRegularPatternItemL ps ==        bpRegularPatternItem ps and bpPush(ps,[bpPop1 ps]) @@ -1188,7 +1190,7 @@ bpRegularBVItem ps ==    bpBVString ps       or bpConstTok ps         or (bpName ps and (bpRegularBVItemTail ps or true)) -        or bpBracketConstruct(ps,function bpPatternL) +        or bpBracketPattern ps  bpBVString ps ==    parserTokenClass ps = "STRING" and @@ -1216,11 +1218,12 @@ bpBoundVariablelist ps ==  bpVariable ps ==      bpParenthesized(ps,function bpBoundVariablelist) and         bpPush(ps,bfTupleIf bpPop1 ps) -         or bpBracketConstruct(ps,function bpPatternL) +         or bpBracketPattern ps                  or bpName ps or bpConstTok ps  bpAssignVariable ps == -      bpBracketConstruct(ps,function bpPatternL) or bpAssignLHS ps +  bpBracketPattern ps +    or bpAssignLHS ps  bpAssignLHS ps ==    not bpName ps => false diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 4cb50b33..63c806be 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -25,122 +25,124 @@  (DEFUN |%Import| #1=(|bfVar#7|) (CONS '|%Import| (LIST . #1#))) -(DEFUN |%ImportSignature| #1=(|bfVar#8| |bfVar#9|) +(DEFUN |%LoadUnit| #1=(|bfVar#8|) (CONS '|%LoadUnit| (LIST . #1#))) + +(DEFUN |%ImportSignature| #1=(|bfVar#9| |bfVar#10| |bfVar#11|)    (CONS '|%ImportSignature| (LIST . #1#))) -(DEFUN |%Record| #1=(|bfVar#10| |bfVar#11|) (CONS '|%Record| (LIST . #1#))) +(DEFUN |%Record| #1=(|bfVar#12| |bfVar#13|) (CONS '|%Record| (LIST . #1#))) -(DEFUN |%AccessorDef| #1=(|bfVar#12| |bfVar#13|) +(DEFUN |%AccessorDef| #1=(|bfVar#14| |bfVar#15|)    (CONS '|%AccessorDef| (LIST . #1#))) -(DEFUN |%TypeAlias| #1=(|bfVar#14| |bfVar#15|) +(DEFUN |%TypeAlias| #1=(|bfVar#16| |bfVar#17|)    (CONS '|%TypeAlias| (LIST . #1#))) -(DEFUN |%Signature| #1=(|bfVar#16| |bfVar#17|) +(DEFUN |%Signature| #1=(|bfVar#18| |bfVar#19|)    (CONS '|%Signature| (LIST . #1#))) -(DEFUN |%Mapping| #1=(|bfVar#18| |bfVar#19|) (CONS '|%Mapping| (LIST . #1#))) +(DEFUN |%Mapping| #1=(|bfVar#20| |bfVar#21|) (CONS '|%Mapping| (LIST . #1#))) -(DEFUN |%Forall| #1=(|bfVar#20| |bfVar#21|) (CONS '|%Forall| (LIST . #1#))) +(DEFUN |%Forall| #1=(|bfVar#22| |bfVar#23|) (CONS '|%Forall| (LIST . #1#))) -(DEFUN |%Dynamic| #1=(|bfVar#22|) (CONS '|%Dynamic| (LIST . #1#))) +(DEFUN |%Dynamic| #1=(|bfVar#24|) (CONS '|%Dynamic| (LIST . #1#))) -(DEFUN |%SuffixDot| #1=(|bfVar#23|) (CONS '|%SuffixDot| (LIST . #1#))) +(DEFUN |%SuffixDot| #1=(|bfVar#25|) (CONS '|%SuffixDot| (LIST . #1#))) -(DEFUN |%Quote| #1=(|bfVar#24|) (CONS '|%Quote| (LIST . #1#))) +(DEFUN |%Quote| #1=(|bfVar#26|) (CONS '|%Quote| (LIST . #1#))) -(DEFUN |%EqualPattern| #1=(|bfVar#25|) (CONS '|%EqualPattern| (LIST . #1#))) +(DEFUN |%EqualPattern| #1=(|bfVar#27|) (CONS '|%EqualPattern| (LIST . #1#))) -(DEFUN |%Colon| #1=(|bfVar#26|) (CONS '|%Colon| (LIST . #1#))) +(DEFUN |%Colon| #1=(|bfVar#28|) (CONS '|%Colon| (LIST . #1#))) -(DEFUN |%QualifiedName| #1=(|bfVar#27| |bfVar#28|) +(DEFUN |%QualifiedName| #1=(|bfVar#29| |bfVar#30|)    (CONS '|%QualifiedName| (LIST . #1#))) -(DEFUN |%Restrict| #1=(|bfVar#29| |bfVar#30|) (CONS '|%Restrict| (LIST . #1#))) +(DEFUN |%Restrict| #1=(|bfVar#31| |bfVar#32|) (CONS '|%Restrict| (LIST . #1#))) -(DEFUN |%DefaultValue| #1=(|bfVar#31| |bfVar#32|) +(DEFUN |%DefaultValue| #1=(|bfVar#33| |bfVar#34|)    (CONS '|%DefaultValue| (LIST . #1#))) -(DEFUN |%Key| #1=(|bfVar#33| |bfVar#34|) (CONS '|%Key| (LIST . #1#))) +(DEFUN |%Key| #1=(|bfVar#35| |bfVar#36|) (CONS '|%Key| (LIST . #1#))) -(DEFUN |%Bracket| #1=(|bfVar#35|) (CONS '|%Bracket| (LIST . #1#))) +(DEFUN |%Bracket| #1=(|bfVar#37|) (CONS '|%Bracket| (LIST . #1#))) -(DEFUN |%UnboundedSegment| #1=(|bfVar#36|) +(DEFUN |%UnboundedSegment| #1=(|bfVar#38|)    (CONS '|%UnboundedSegment| (LIST . #1#))) -(DEFUN |%BoundedSgement| #1=(|bfVar#37| |bfVar#38|) +(DEFUN |%BoundedSgement| #1=(|bfVar#39| |bfVar#40|)    (CONS '|%BoundedSgement| (LIST . #1#))) -(DEFUN |%Tuple| #1=(|bfVar#39|) (CONS '|%Tuple| (LIST . #1#))) +(DEFUN |%Tuple| #1=(|bfVar#41|) (CONS '|%Tuple| (LIST . #1#))) -(DEFUN |%ColonAppend| #1=(|bfVar#40| |bfVar#41|) +(DEFUN |%ColonAppend| #1=(|bfVar#42| |bfVar#43|)    (CONS '|%ColonAppend| (LIST . #1#))) -(DEFUN |%Is| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Is| (LIST . #1#))) +(DEFUN |%Is| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Is| (LIST . #1#))) -(DEFUN |%Isnt| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Isnt| (LIST . #1#))) +(DEFUN |%Isnt| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Isnt| (LIST . #1#))) -(DEFUN |%Reduce| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Reduce| (LIST . #1#))) +(DEFUN |%Reduce| #1=(|bfVar#48| |bfVar#49|) (CONS '|%Reduce| (LIST . #1#))) -(DEFUN |%PrefixExpr| #1=(|bfVar#48| |bfVar#49|) +(DEFUN |%PrefixExpr| #1=(|bfVar#50| |bfVar#51|)    (CONS '|%PrefixExpr| (LIST . #1#))) -(DEFUN |%Call| #1=(|bfVar#50| |bfVar#51|) (CONS '|%Call| (LIST . #1#))) +(DEFUN |%Call| #1=(|bfVar#52| |bfVar#53|) (CONS '|%Call| (LIST . #1#))) -(DEFUN |%InfixExpr| #1=(|bfVar#52| |bfVar#53| |bfVar#54|) +(DEFUN |%InfixExpr| #1=(|bfVar#54| |bfVar#55| |bfVar#56|)    (CONS '|%InfixExpr| (LIST . #1#))) -(DEFUN |%ConstantDefinition| #1=(|bfVar#55| |bfVar#56|) +(DEFUN |%ConstantDefinition| #1=(|bfVar#57| |bfVar#58|)    (CONS '|%ConstantDefinition| (LIST . #1#))) -(DEFUN |%Definition| #1=(|bfVar#57| |bfVar#58| |bfVar#59|) +(DEFUN |%Definition| #1=(|bfVar#59| |bfVar#60| |bfVar#61|)    (CONS '|%Definition| (LIST . #1#))) -(DEFUN |%Macro| #1=(|bfVar#60| |bfVar#61| |bfVar#62|) +(DEFUN |%Macro| #1=(|bfVar#62| |bfVar#63| |bfVar#64|)    (CONS '|%Macro| (LIST . #1#))) -(DEFUN |%Lambda| #1=(|bfVar#63| |bfVar#64|) (CONS '|%Lambda| (LIST . #1#))) +(DEFUN |%Lambda| #1=(|bfVar#65| |bfVar#66|) (CONS '|%Lambda| (LIST . #1#))) -(DEFUN |%SuchThat| #1=(|bfVar#65|) (CONS '|%SuchThat| (LIST . #1#))) +(DEFUN |%SuchThat| #1=(|bfVar#67|) (CONS '|%SuchThat| (LIST . #1#))) -(DEFUN |%Assignment| #1=(|bfVar#66| |bfVar#67|) +(DEFUN |%Assignment| #1=(|bfVar#68| |bfVar#69|)    (CONS '|%Assignment| (LIST . #1#))) -(DEFUN |%While| #1=(|bfVar#68|) (CONS '|%While| (LIST . #1#))) +(DEFUN |%While| #1=(|bfVar#70|) (CONS '|%While| (LIST . #1#))) -(DEFUN |%Until| #1=(|bfVar#69|) (CONS '|%Until| (LIST . #1#))) +(DEFUN |%Until| #1=(|bfVar#71|) (CONS '|%Until| (LIST . #1#))) -(DEFUN |%For| #1=(|bfVar#70| |bfVar#71| |bfVar#72|) (CONS '|%For| (LIST . #1#))) +(DEFUN |%For| #1=(|bfVar#72| |bfVar#73| |bfVar#74|) (CONS '|%For| (LIST . #1#))) -(DEFUN |%Implies| #1=(|bfVar#73| |bfVar#74|) (CONS '|%Implies| (LIST . #1#))) +(DEFUN |%Implies| #1=(|bfVar#75| |bfVar#76|) (CONS '|%Implies| (LIST . #1#))) -(DEFUN |%Iterators| #1=(|bfVar#75|) (CONS '|%Iterators| (LIST . #1#))) +(DEFUN |%Iterators| #1=(|bfVar#77|) (CONS '|%Iterators| (LIST . #1#))) -(DEFUN |%Cross| #1=(|bfVar#76|) (CONS '|%Cross| (LIST . #1#))) +(DEFUN |%Cross| #1=(|bfVar#78|) (CONS '|%Cross| (LIST . #1#))) -(DEFUN |%Repeat| #1=(|bfVar#77| |bfVar#78|) (CONS '|%Repeat| (LIST . #1#))) +(DEFUN |%Repeat| #1=(|bfVar#79| |bfVar#80|) (CONS '|%Repeat| (LIST . #1#))) -(DEFUN |%Pile| #1=(|bfVar#79|) (CONS '|%Pile| (LIST . #1#))) +(DEFUN |%Pile| #1=(|bfVar#81|) (CONS '|%Pile| (LIST . #1#))) -(DEFUN |%Append| #1=(|bfVar#80|) (CONS '|%Append| (LIST . #1#))) +(DEFUN |%Append| #1=(|bfVar#82|) (CONS '|%Append| (LIST . #1#))) -(DEFUN |%Case| #1=(|bfVar#81| |bfVar#82|) (CONS '|%Case| (LIST . #1#))) +(DEFUN |%Case| #1=(|bfVar#83| |bfVar#84|) (CONS '|%Case| (LIST . #1#))) -(DEFUN |%Return| #1=(|bfVar#83|) (CONS '|%Return| (LIST . #1#))) +(DEFUN |%Return| #1=(|bfVar#85|) (CONS '|%Return| (LIST . #1#))) -(DEFUN |%Leave| #1=(|bfVar#84|) (CONS '|%Leave| (LIST . #1#))) +(DEFUN |%Leave| #1=(|bfVar#86|) (CONS '|%Leave| (LIST . #1#))) -(DEFUN |%Throw| #1=(|bfVar#85|) (CONS '|%Throw| (LIST . #1#))) +(DEFUN |%Throw| #1=(|bfVar#87|) (CONS '|%Throw| (LIST . #1#))) -(DEFUN |%Catch| #1=(|bfVar#86| |bfVar#87|) (CONS '|%Catch| (LIST . #1#))) +(DEFUN |%Catch| #1=(|bfVar#88| |bfVar#89|) (CONS '|%Catch| (LIST . #1#))) -(DEFUN |%Finally| #1=(|bfVar#88|) (CONS '|%Finally| (LIST . #1#))) +(DEFUN |%Finally| #1=(|bfVar#90|) (CONS '|%Finally| (LIST . #1#))) -(DEFUN |%Try| #1=(|bfVar#89| |bfVar#90|) (CONS '|%Try| (LIST . #1#))) +(DEFUN |%Try| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Try| (LIST . #1#))) -(DEFUN |%Where| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Where| (LIST . #1#))) +(DEFUN |%Where| #1=(|bfVar#93| |bfVar#94|) (CONS '|%Where| (LIST . #1#))) -(DEFUN |%Structure| #1=(|bfVar#93| |bfVar#94|) +(DEFUN |%Structure| #1=(|bfVar#95| |bfVar#96|)    (CONS '|%Structure| (LIST . #1#)))  (DEFSTRUCT (|%LoadUnit| (:COPIER |copy%LoadUnit|)) @@ -3824,9 +3826,9 @@  (DEFPARAMETER |$ffs| NIL) -(DEFUN |genImportDeclaration| (|op| |sig|) -  (LET* (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|) -    (DECLARE (SPECIAL |$ffs|)) +(DEFUN |genImportDeclaration| (|op| |sig| |dom|) +  (LET* (|lib| |s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|) +    (DECLARE (SPECIAL |$foreignLoadUnits| |$ffs|))      (COND       ((NOT         (AND (CONSP |sig|) (EQ (CAR |sig|) '|%Signature|) @@ -3853,6 +3855,14 @@       (T (COND ((AND |s| (SYMBOLP |s|)) (SETQ |s| (LIST |s|))))        (SETQ |$ffs| (CONS |op| |$ffs|))        (COND +       ((AND (CONSP |dom|) (EQ (CAR |dom|) '|%LoadUnit|) +             (PROGN +              (SETQ |ISTMP#1| (CDR |dom|)) +              (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) +                   (PROGN (SETQ |lib| (CAR |ISTMP#1|)) T))) +             (NOT (|symbolMember?| |lib| |$foreignLoadUnits|))) +        (SETQ |$foreignLoadUnits| (CONS |lib| |$foreignLoadUnits|)))) +      (COND         ((|%hasFeature| :GCL) (|genGCLnativeTranslation| |op| |s| |t| |op'|))         ((|%hasFeature| :SBCL) (|genSBCLnativeTranslation| |op| |s| |t| |op'|))         ((|%hasFeature| :CLISP) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 50a1b076..7bf31b92 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -387,7 +387,7 @@        (COND (|done| (RETURN NIL))              (T               (SETQ |found| -                     (LET ((#1=#:G392 +                     (LET ((#1=#:G393                              (CATCH :OPEN-AXIOM-CATCH-POINT (FUNCALL |f| |ps|))))                         (COND                          ((AND (CONSP #1#) @@ -534,6 +534,42 @@                (|%Module| (|bpPop3| |ps|) (|bpPop2| |ps|) (|bpPop1| |ps|))))     (T NIL))) +(DEFUN |bpProvenance| (|ps|) +  (LET* (|lib| |ISTMP#6| |ISTMP#5| |ISTMP#4| |ISTMP#3| |ISTMP#2| |ISTMP#1| |x|) +    (BLOCK NIL +      (COND +       ((|bpEqKey| |ps| 'IN) +        (OR (|bpApplication| |ps|) (RETURN (|bpTrap| |ps|))) +        (SETQ |x| (|bpPop1| |ps|)) +        (COND +         ((NOT +           (AND (CONSP |x|) +                (PROGN +                 (SETQ |ISTMP#1| (CAR |x|)) +                 (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'ELT) +                      (PROGN +                       (SETQ |ISTMP#2| (CDR |ISTMP#1|)) +                       (AND (CONSP |ISTMP#2|) (EQ (CAR |ISTMP#2|) '|System|) +                            (PROGN +                             (SETQ |ISTMP#3| (CDR |ISTMP#2|)) +                             (AND (CONSP |ISTMP#3|) (NULL (CDR |ISTMP#3|)) +                                  (EQ (CAR |ISTMP#3|) '|LoadUnit|))))))) +                (PROGN +                 (SETQ |ISTMP#4| (CDR |x|)) +                 (AND (CONSP |ISTMP#4|) (NULL (CDR |ISTMP#4|)) +                      (PROGN +                       (SETQ |ISTMP#5| (CAR |ISTMP#4|)) +                       (AND (CONSP |ISTMP#5|) (EQ (CAR |ISTMP#5|) 'QUOTE) +                            (PROGN +                             (SETQ |ISTMP#6| (CDR |ISTMP#5|)) +                             (AND (CONSP |ISTMP#6|) (NULL (CDR |ISTMP#6|)) +                                  (PROGN +                                   (SETQ |lib| (CAR |ISTMP#6|)) +                                   T))))))))) +          (|bpGeneralErrorHere| |ps|)) +         (T (|bpPush| |ps| (|%LoadUnit| |lib|))))) +       (T (|bpPush| |ps| NIL)))))) +  (DEFUN |bpImport| (|ps|)    (LET* (|a|)      (COND @@ -547,12 +583,12 @@         (T (SETQ |a| (|bpState| |ps|)) (|bpRequire| |ps| #'|bpName|)          (COND           ((|bpEqPeek| |ps| 'COLON) (|bpRestore| |ps| |a|) -          (AND (|bpRequire| |ps| #'|bpSignature|) -               (OR (|bpEqKey| |ps| 'FOR) (|bpTrap| |ps|)) -               (|bpRequire| |ps| #'|bpName|) -               (|bpPush| |ps| -                         (|%ImportSignature| (|bpPop1| |ps|) -                                             (|bpPop1| |ps|))))) +          (|bpRequire| |ps| #'|bpSignature|) (|bpProvenance| |ps|) +          (OR (|bpEqKey| |ps| 'FOR) (|bpTrap| |ps|)) +          (|bpRequire| |ps| #'|bpName|) +          (|bpPush| |ps| +                    (|%ImportSignature| (|bpPop1| |ps|) (|bpPop2| |ps|) +                                        (|bpPop1| |ps|))))           (T (|bpPush| |ps| (|%Import| (|bpPop1| |ps|))))))))       (T NIL)))) @@ -819,9 +855,6 @@           (|bpPush| |ps| (|bfHas| (|bpPop2| |ps|) (|bpPop1| |ps|))))          (T T)))) -(DEFUN |bpBracketConstruct| (|ps| |f|) -  (AND (|bpBracket| |ps| |f|) (|bpPush| |ps| (|bfConstruct| (|bpPop1| |ps|))))) -  (DEFUN |bpCompare| (|ps|)    (OR     (AND (|bpIs| |ps|) @@ -1143,8 +1176,12 @@          (|bpPush| |ps| (|bfDTuple| (|bpPop1| |ps|))))))  (DEFUN |bpPattern| (|ps|) -  (OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpChar| |ps|) -      (|bpName| |ps|) (|bpConstTok| |ps|))) +  (OR (|bpBracketPattern| |ps|) (|bpChar| |ps|) (|bpName| |ps|) +      (|bpConstTok| |ps|))) + +(DEFUN |bpBracketPattern| (|ps|) +  (AND (|bpBracket| |ps| #'|bpPatternL|) +       (|bpPush| |ps| (|bfConstruct| (|bpPop1| |ps|)))))  (DEFUN |bpEqual| (|ps|)    (AND (|bpEqKey| |ps| 'SHOEEQ) @@ -1160,7 +1197,7 @@                             (|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)                                         (|bpPop1| |ps|))))              T)) -      (|bpBracketConstruct| |ps| #'|bpPatternL|))) +      (|bpBracketPattern| |ps|)))  (DEFUN |bpRegularPatternItemL| (|ps|)    (AND (|bpRegularPatternItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|))))) @@ -1218,7 +1255,7 @@  (DEFUN |bpRegularBVItem| (|ps|)    (OR (|bpBVString| |ps|) (|bpConstTok| |ps|)        (AND (|bpName| |ps|) (OR (|bpRegularBVItemTail| |ps|) T)) -      (|bpBracketConstruct| |ps| #'|bpPatternL|))) +      (|bpBracketPattern| |ps|)))  (DEFUN |bpBVString| (|ps|)    (AND (EQ (|parserTokenClass| |ps|) 'STRING) @@ -1259,11 +1296,10 @@    (OR     (AND (|bpParenthesized| |ps| #'|bpBoundVariablelist|)          (|bpPush| |ps| (|bfTupleIf| (|bpPop1| |ps|)))) -   (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpName| |ps|) -   (|bpConstTok| |ps|))) +   (|bpBracketPattern| |ps|) (|bpName| |ps|) (|bpConstTok| |ps|)))  (DEFUN |bpAssignVariable| (|ps|) -  (OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpAssignLHS| |ps|))) +  (OR (|bpBracketPattern| |ps|) (|bpAssignLHS| |ps|)))  (DEFUN |bpAssignLHS| (|ps|)    (COND ((NOT (|bpName| |ps|)) NIL) ((|bpSignatureTail| |ps|) T) @@ -1375,7 +1411,7 @@       (SETQ |op| (|enclosingFunction| (|parserLoadUnit| |ps|)))       (SETQ |varno| (|parserGensymSequenceNumber| |ps|))       (UNWIND-PROTECT -         (LET ((#1=#:G393 +         (LET ((#1=#:G394                  (CATCH :OPEN-AXIOM-CATCH-POINT                    (PROGN                     (SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) NIL) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index aede083d..7aae98ae 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -84,10 +84,10 @@    (LET* (|s|)      (COND       ((SETQ |s| -              (WITH-HASH-TABLE-ITERATOR (#1=#:G391 |shoeKeyTable|) +              (WITH-HASH-TABLE-ITERATOR (#1=#:G392 |shoeKeyTable|)                  (LET ((|bfVar#1| NIL))                    (LOOP -                   (MULTIPLE-VALUE-BIND (#2=#:G392 |k| |v|) +                   (MULTIPLE-VALUE-BIND (#2=#:G393 |k| |v|)                         (#1#)                       (COND ((NOT #2#) (RETURN |bfVar#1|))                             (T @@ -138,9 +138,9 @@                   (COND ((> |i| 255) (RETURN NIL)) (T (SETF (ELT |a| |i|) |b|)))                   (SETQ |i| (+ |i| 1))))                |a|)) -     (WITH-HASH-TABLE-ITERATOR (#1=#:G393 |shoeKeyTable|) +     (WITH-HASH-TABLE-ITERATOR (#1=#:G394 |shoeKeyTable|)         (LOOP -        (MULTIPLE-VALUE-BIND (#2=#:G394 |s| #:G395) +        (MULTIPLE-VALUE-BIND (#2=#:G395 |s| #:G396)              (#1#)            (COND ((NOT #2#) (RETURN NIL)) (T (|shoeInsert| |s| |d|))))))       |d|))) @@ -154,9 +154,9 @@       (LET ((|i| 0))         (LOOP (COND ((> |i| 255) (RETURN NIL)) (T (SETF (SBIT |a| |i|) 0)))               (SETQ |i| (+ |i| 1)))) -     (WITH-HASH-TABLE-ITERATOR (#1=#:G396 |shoeKeyTable|) +     (WITH-HASH-TABLE-ITERATOR (#1=#:G397 |shoeKeyTable|)         (LOOP -        (MULTIPLE-VALUE-BIND (#2=#:G397 |k| #:G398) +        (MULTIPLE-VALUE-BIND (#2=#:G398 |k| #:G399)              (#1#)            (COND ((NOT #2#) (RETURN NIL)) ((|shoeStartsId| (SCHAR |k| 0)) NIL)                  (T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1)))))) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 8e7ab21c..df59ddc4 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -16,56 +16,83 @@  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)    (EXPORT     '(|evalBootFile| |loadNativeModule| |loadSystemRuntimeCore| -                    |string2BootTree| |genImportDeclaration| |retainFile?|))) +                    |compileBootHandler| |string2BootTree| +                    |genImportDeclaration| |retainFile?|)))  (DEFPARAMETER |$currentModuleName| NIL) +(DEFPARAMETER |$foreignLoadUnits| NIL) +  (DEFPARAMETER |$foreignsDefsForCLisp| NIL)  (DEFUN |reallyPrettyPrint| (|x| &OPTIONAL (|st| *STANDARD-OUTPUT*))    (PROGN (|prettyPrint| |x| |st|) (TERPRI |st|)))  (DEFUN |genModuleFinalization| (|stream|) -  (LET* (|init| |setFFS|) -    (DECLARE (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName| |$ffs|)) -    (COND ((NULL |$ffs|) NIL) -          ((NULL |$currentModuleName|) -           (|coreError| "current module has no name")) -          (T -           (SETQ |setFFS| -                   (LIST 'SETQ '|$dynamicForeignFunctions| -                         (LIST '|append!| (|quote| |$ffs|) -                               '|$dynamicForeignFunctions|))) -           (|reallyPrettyPrint| (|atLoadOrExecutionTime| |setFFS|) |stream|) -           (COND -            ((|%hasFeature| :CLISP) -             (COND ((NULL |$foreignsDefsForCLisp|) NIL) -                   (T -                    (SETQ |init| -                            (CONS 'PROGN -                                  (LET ((|bfVar#2| NIL) -                                        (|bfVar#3| NIL) -                                        (|bfVar#1| |$foreignsDefsForCLisp|) -                                        (|d| NIL)) -                                    (LOOP -                                     (COND -                                      ((OR (NOT (CONSP |bfVar#1|)) -                                           (PROGN -                                            (SETQ |d| (CAR |bfVar#1|)) -                                            NIL)) -                                       (RETURN |bfVar#2|)) -                                      ((NULL |bfVar#2|) -                                       (SETQ |bfVar#2| -                                               #1=(CONS -                                                   (LIST 'EVAL (|quote| |d|)) -                                                   NIL)) -                                       (SETQ |bfVar#3| |bfVar#2|)) -                                      (T (RPLACD |bfVar#3| #1#) -                                       (SETQ |bfVar#3| (CDR |bfVar#3|)))) -                                     (SETQ |bfVar#1| (CDR |bfVar#1|)))))) -                    (|reallyPrettyPrint| (|atLoadOrExecutionTime| |init|) -                                         |stream|)))) -            (T NIL)))))) +  (LET* (|init| |setFFS| |loadUnitsForm| |loadUnits|) +    (DECLARE +     (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName| |$ffs| +      |$foreignLoadUnits|)) +    (PROGN +     (SETQ |loadUnits| +             (LET ((|bfVar#2| NIL) +                   (|bfVar#3| NIL) +                   (|bfVar#1| |$foreignLoadUnits|) +                   (|x| NIL)) +               (LOOP +                (COND +                 ((OR (NOT (CONSP |bfVar#1|)) +                      (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) +                  (RETURN |bfVar#2|)) +                 ((NULL |bfVar#2|) +                  (SETQ |bfVar#2| #1=(CONS (SYMBOL-NAME |x|) NIL)) +                  (SETQ |bfVar#3| |bfVar#2|)) +                 (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) +                (SETQ |bfVar#1| (CDR |bfVar#1|))))) +     (COND +      (|loadUnits| +       (SETQ |loadUnitsForm| +               (LIST 'MAP (|quote| '|loadNativeModule|) (|quote| |loadUnits|))) +       (|reallyPrettyPrint| (|atLoadOrExecutionTime| |loadUnitsForm|) +                            |stream|))) +     (COND ((NULL |$ffs|) NIL) +           ((NULL |$currentModuleName|) +            (|coreError| "current module has no name")) +           (T +            (SETQ |setFFS| +                    (LIST 'SETQ '|$dynamicForeignFunctions| +                          (LIST '|append!| (|quote| |$ffs|) +                                '|$dynamicForeignFunctions|))) +            (|reallyPrettyPrint| (|atLoadOrExecutionTime| |setFFS|) |stream|) +            (COND +             ((|%hasFeature| :CLISP) +              (COND ((NULL |$foreignsDefsForCLisp|) NIL) +                    (T +                     (SETQ |init| +                             (CONS 'PROGN +                                   (LET ((|bfVar#5| NIL) +                                         (|bfVar#6| NIL) +                                         (|bfVar#4| |$foreignsDefsForCLisp|) +                                         (|d| NIL)) +                                     (LOOP +                                      (COND +                                       ((OR (NOT (CONSP |bfVar#4|)) +                                            (PROGN +                                             (SETQ |d| (CAR |bfVar#4|)) +                                             NIL)) +                                        (RETURN |bfVar#5|)) +                                       ((NULL |bfVar#5|) +                                        (SETQ |bfVar#5| +                                                #2=(CONS +                                                    (LIST 'EVAL (|quote| |d|)) +                                                    NIL)) +                                        (SETQ |bfVar#6| |bfVar#5|)) +                                       (T (RPLACD |bfVar#6| #2#) +                                        (SETQ |bfVar#6| (CDR |bfVar#6|)))) +                                      (SETQ |bfVar#4| (CDR |bfVar#4|)))))) +                     (|reallyPrettyPrint| (|atLoadOrExecutionTime| |init|) +                                          |stream|)))) +             (T NIL)))))))  (DEFUN |genOptimizeOptions| (|stream|)    (|reallyPrettyPrint| @@ -416,7 +443,7 @@       (SETQ |ps| (|makeParserState| |toks|))       (|bpFirstTok| |ps|)       (SETQ |found| -             (LET ((#1=#:G401 +             (LET ((#1=#:G402                      (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|))))                 (COND                  ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT)) @@ -632,8 +659,8 @@                      (|bootImport| (SYMBOL-NAME |m|))))                    (LIST (LIST 'IMPORT-MODULE (SYMBOL-NAME |m|)))))))               (|%ImportSignature| -              (LET ((|x| (CADR |b|)) (|sig| (CADDR |b|))) -                (|genImportDeclaration| |x| |sig|))) +              (LET ((|x| (CADR |b|)) (|sig| (CADDR |b|)) (|dom| (CADDDR |b|))) +                (|genImportDeclaration| |x| |sig| |dom|)))               (|%TypeAlias|                (LET ((|lhs| (CADR |b|)) (|rhs| (CADDR |b|)))                  (LIST (|genTypeAlias| |lhs| |rhs|)))) @@ -865,13 +892,14 @@  (DEFUN |getIntermediateLispFile| (|file| |options|)    (LET* (|out|) -    (PROGN -     (SETQ |out| (NAMESTRING (|getOutputPathname| |options|))) -     (COND -      (|out| -       (CONCAT (|shoeRemoveStringIfNec| (CONCAT "." |$faslType|) |out|) -               ".clisp")) -      (T (|defaultBootToLispFile| |file|)))))) +    (BLOCK NIL +      (PROGN +       (SETQ |out| +               (OR (|getOutputPathname| |options|) +                   (RETURN (|defaultBootToLispFile| |file|)))) +       (CONCAT +        (|shoeRemoveStringIfNec| (CONCAT "." |$faslType|) (NAMESTRING |out|)) +        ".clisp")))))  (DEFUN |translateBootFile| (|progname| |options| |file|)    (LET* (|outFile|) @@ -909,20 +937,20 @@                                  #'|compileBootHandler|)  (DEFUN |loadNativeModule| (|m|) -  (COND -   ((|%hasFeature| :SBCL) -    (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m| :DONT-SAVE T)) -   ((|%hasFeature| :CLISP) -    (EVAL (LIST (|bfColonColon| 'FFI 'DEFAULT-FOREIGN-LIBRARY) |m|))) -   ((|%hasFeature| :ECL) -    (EVAL (LIST (|bfColonColon| 'FFI 'LOAD-FOREIGN-LIBRARY) |m|))) -   ((|%hasFeature| :CLOZURE) -    (EVAL (LIST (|bfColonColon| 'CCL 'OPEN-SHARED-LIBRARY) |m|))) -   (T (|coreError| "don't know how to load a dynamically linked module")))) +  (PROGN +   (SETQ |m| (CONCAT |$NativeModulePrefix| |m| |$NativeModuleExt|)) +   (COND +    ((|%hasFeature| :SBCL) +     (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m| :DONT-SAVE T)) +    ((|%hasFeature| :CLISP) +     (EVAL (LIST (|bfColonColon| 'FFI 'DEFAULT-FOREIGN-LIBRARY) |m|))) +    ((|%hasFeature| :ECL) +     (EVAL (LIST (|bfColonColon| 'FFI 'LOAD-FOREIGN-LIBRARY) |m|))) +    ((|%hasFeature| :CLOZURE) +     (EVAL (LIST (|bfColonColon| 'CCL 'OPEN-SHARED-LIBRARY) |m|))) +    (T (|coreError| "don't know how to load a dynamically linked module")))))  (DEFUN |loadSystemRuntimeCore| ()    (COND ((OR (|%hasFeature| :ECL) (|%hasFeature| :GCL)) NIL) -        (T -         (|loadNativeModule| -          (CONCAT "libopen-axiom-core" |$NativeModuleExt|))))) +        (T (|loadNativeModule| "open-axiom-core")))) | 
